SmallInteger.st
author Claus Gittinger <cg@exept.de>
Fri, 06 Jun 1997 16:48:20 +0200
changeset 2678 37eec0043bdb
parent 2672 dc3662188b2c
child 2693 8ffe0f4374d6
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
Integer subclass:#SmallInteger
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    14
	instanceVariableNames:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    15
	classVariableNames:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    16
	poolDictionaries:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    17
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    20
!SmallInteger class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    22
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    23
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    24
 COPYRIGHT (c) 1988 by Claus Gittinger
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
    25
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    26
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    27
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    28
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    36
documentation
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    37
"
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
    SmallIntegers are Integers in the range of at least +/- 2^30 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
    (i.e. 31 bits, which is not guaranteed; it could be more on 64 bit cpus).
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    41
    These are no real objects - they have no instances (not even storage !!)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    42
    and cannot be subclassed.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    43
    The reason is to save both storage and runtime by not collecting
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    44
    SmallIntegers in the system. SmallInts are marked by having the TAG_INT 
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
    bit set, in contrast to all other objects which do not. 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
    Since this knowledge is hardwired into the system (and there is no 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    47
    class-field stored with SmallIntegers) there can be no subclass of 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
    SmallInteger (sorry).
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    49
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
    If you really need this kind of thing, create a subclass of Integer,
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
    with an instance variable holding the value.
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    52
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    53
    [author:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    54
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    55
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    56
    [see also:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    57
	Number
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    58
	Float Fraction FixedPoint
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    59
	LargeInteger
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    60
"
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    61
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    62
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    63
!SmallInteger class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    64
a27a279701f8 Initial revision
claus
parents:
diff changeset
    65
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
    66
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
basicNew:size
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    79
!SmallInteger class methodsFor:'bit mask constants'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    80
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    81
bitMaskFor:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    82
    "return a bitmask for the index's bit (index starts at 1)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    83
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    84
    (index between:1 and:SmallInteger maxBits) ifFalse:[
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    85
	^ self error:'index out of bounds'
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    86
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    87
    ^ 1 bitShift:(index - 1)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    88
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    89
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    90
!SmallInteger class methodsFor:'constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    91
a27a279701f8 Initial revision
claus
parents:
diff changeset
    92
maxBits
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    93
    "return the number of bits in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    94
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    95
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
%{  /* NOCONTEXT */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
    97
    RETURN ( __MKSMALLINT(N_INT_BITS) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    98
%}
2
claus
parents: 1
diff changeset
    99
claus
parents: 1
diff changeset
   100
    "SmallInteger maxBits"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   101
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
maxBytes
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   104
    "return the number of bytes in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   105
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
%{  /* NOCONTEXT */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   108
    RETURN ( __MKSMALLINT(N_INT_BITS / 8 + 1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   109
%}
2
claus
parents: 1
diff changeset
   110
claus
parents: 1
diff changeset
   111
    "SmallInteger maxBytes"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   112
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
maxVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   115
    "return the largest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   116
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
%{  /* NOCONTEXT */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   119
    RETURN ( __MKSMALLINT(_MAX_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
%}
2
claus
parents: 1
diff changeset
   121
claus
parents: 1
diff changeset
   122
    "SmallInteger maxVal"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   123
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   124
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   125
minVal
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   126
    "return the smallest Integer representable as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   127
     For very special uses only - not constant across implementations"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   128
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   129
%{  /* NOCONTEXT */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   130
    RETURN ( __MKSMALLINT(_MIN_INT) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   131
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   132
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   133
    "SmallInteger minVal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   134
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   135
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   136
!SmallInteger class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   137
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   138
canBeSubclassed
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   139
    "return true, if its allowed to create subclasses of the receiver.
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   140
     Return nil here - since it is NOT possible for SmallInteger"
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   141
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   142
    ^ false
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   143
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
2672
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   145
hasImmediateInstances
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   146
    "return true if this class has immediate instances.
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   147
     Redefined from Behavior"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   148
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   149
    ^ true
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   150
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   151
    "Created: 3.6.1997 / 12:01:26 / cg"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   152
!
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   153
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   154
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   155
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   156
     Here, true is returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    ^ true
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   159
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   160
    "Modified: 23.4.1996 / 16:00:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   161
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   162
a27a279701f8 Initial revision
claus
parents:
diff changeset
   163
!SmallInteger methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   164
a27a279701f8 Initial revision
claus
parents:
diff changeset
   165
* aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
    "return the product of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   167
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   170
    INT myValue, otherValue;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   171
    unsigned INT productLow, productHi;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   172
    int negative;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   173
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   174
#   define low16Bits(foo)  ((foo) & 0xFFFF)
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   175
#   define hi16Bits(foo)   ((foo) >> 16)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   176
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   177
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   178
     * can we use long long arithmetic ?
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   179
     */
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   180
#if defined(__GNUC__) && (__GNUC__ >= 2)
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   181
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   182
     * commented, since long-long arithmetic seems to
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   183
     * be buggy in some implementations (sparc) ...
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   184
     * (took me a while to find this out :-(
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   185
     */
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   186
# ifdef NOTDEF
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   187
#   define _LONGLONG
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   188
# endif
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   189
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
252
   191
    if (__isSmallInteger(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   192
	myValue = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   193
	otherValue = __intVal(aNumber);
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   194
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   195
#if defined(_LONGLONG)
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   196
	{
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   197
	    long long product;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   198
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   199
	    product = (long long)myValue * (long long)otherValue;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   200
	    if ((product >= (long long)_MIN_INT) 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   201
	     && (product <= (long long)_MAX_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   202
		RETURN ( __MKSMALLINT((int)product) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   203
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   204
	    if (product < 0) {
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   205
		negative = -1;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   206
		product = -product;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   207
	    } else {
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   208
		negative = 1;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   209
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   210
	    productHi = product >> 32;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   211
	    productLow = product & 0xFFFFFFFF;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   212
	}
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   213
#else
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   214
	negative = 1;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   215
	if (myValue < 0) {
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   216
	    negative = -1;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   217
	    myValue = -myValue;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   218
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   219
	if (otherValue < 0) {
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   220
	    negative = -negative;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   221
	    otherValue = -otherValue;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   222
	}
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   223
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   224
# if defined(__GNUC__) && defined(mc68k)
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   225
	asm ("mulu%.l %3,%1:%0"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   226
		: "=d"  ((unsigned long)(productLow)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   227
		  "=d"  ((unsigned long)(productHi))
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   228
		: "%0"  ((unsigned long)(myValue)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   229
		  "dmi" ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   230
# else
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   231
#  if defined (__GNUC__) && defined(i386)
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   232
	asm ("mull %3"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   233
		: "=a"  ((unsigned long)(productLow)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   234
		  "=d"  ((unsigned long)(productHi))
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   235
		: "%0"  ((unsigned long)(myValue)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   236
		  "rm"  ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   237
#  else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   238
	{
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   239
	    unsigned INT pHH, pHL, pLH, pLL;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   240
	    unsigned INT low1, low2, hi1, hi2;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   241
	    unsigned INT t;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   242
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   243
	    /* unsigned multiply myValue * otherValue -> productHi, productLow
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   244
	     *
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   245
	     * this is too slow:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   246
	     * since most machines can do 32*32 to 64 bit multiply,
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   247
	     * (or at least 32*32 with Overflow check)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   248
	     * - need more assembler (inline) functions here 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   249
	     */
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   250
	    low1 = low16Bits(myValue);
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   251
	    hi1 = hi16Bits(myValue);
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   252
	    low2 = low16Bits(otherValue);
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   253
	    hi2 = hi16Bits(otherValue);
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   254
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   255
	    pLH = low1 * hi2;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   256
	    pHL = hi1 * low2;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   257
	    pLL = low1 * low2;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   258
        
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   259
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   260
	     * the common case ...
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   261
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   262
	    if ((pHL == 0)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   263
	     && (pLH == 0)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   264
	     && ((pLL & 0xC0000000) == 0)) {
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   265
		if (negative < 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   266
		    RETURN ( __MKSMALLINT(- ((INT)pLL)) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   267
		}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   268
		RETURN ( __MKSMALLINT((INT)pLL) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   269
	    }
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   270
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   271
	    pHH = hi1 * hi2;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   272
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   273
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   274
	     *   pHH |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   275
	     *   pLH          |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   276
	     *   pHL          |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   277
	     *   pLL                   |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   278
	     */
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   279
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   280
	    t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   281
	    productLow = (t << 16) + low16Bits(pLL);
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   282
	    productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   283
	}
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   284
#  endif
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   285
# endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   286
	if (productHi == 0) {
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   287
	    if (negative < 0) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   288
		if (productLow <= -(_MIN_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   289
		    RETURN ( __MKSMALLINT(-((INT)productLow)) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   290
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   291
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   292
		if (productLow <= _MAX_INT) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   293
		    RETURN ( __MKSMALLINT(productLow) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   294
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   295
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   296
	}
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   297
#endif
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   298
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   299
	{
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   300
	    extern OBJ __MKLARGEINT64();
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   301
2470
44b8dddd5842 avoid an extra compare when multiplying into a largeInteger.
Claus Gittinger <cg@exept.de>
parents: 2431
diff changeset
   302
	    RETURN (__MKLARGEINT64(negative, productLow, productHi));
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   303
	}
283
a897d331b4c1 *** empty log message ***
claus
parents: 282
diff changeset
   304
    } else if (__isFloatLike(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   305
	OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   306
	double val = (double)__intVal(self) * __floatVal(aNumber);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   307
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
   308
	__qMKFLOAT(newFloat, val);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   309
	RETURN ( newFloat );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   310
    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
   311
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   312
    ^ aNumber productFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   313
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   314
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   315
+ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   316
    "return the sum of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   317
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   318
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   319
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   320
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   321
#ifdef _ADD_IO_IO
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   322
	RETURN ( _ADD_IO_IO(self, aNumber) );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   323
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   324
	REGISTER INT sum;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   325
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   326
	sum =  __intVal(self) + __intVal(aNumber);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   327
	if ((sum >= _MIN_INT) && (sum <= _MAX_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   328
	    RETURN ( __MKSMALLINT(sum) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   329
	}
829
fc386319f41c removed external function defs (soon no longer allowed)
Claus Gittinger <cg@exept.de>
parents: 817
diff changeset
   330
	RETURN ( __MKLARGEINT(sum) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   331
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   332
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   333
    if (__isFloatLike(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   334
	OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   335
	double val = (double)__intVal(self) + __floatVal(aNumber);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   336
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
   337
	__qMKFLOAT(newFloat, val);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   338
	RETURN ( newFloat );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   339
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   340
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   341
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   342
    ^ aNumber sumFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   343
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   344
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   345
- aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   346
    "return the difference of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   347
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   348
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   349
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   350
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   351
#ifdef _SUB_IO_IO
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   352
	RETURN ( _SUB_IO_IO(self, aNumber) );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   353
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   354
	REGISTER INT diff;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   355
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   356
	diff =  __intVal(self) - __intVal(aNumber);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   357
	if ((diff >= _MIN_INT) && (diff <= _MAX_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   358
	    RETURN ( __MKSMALLINT(diff) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   359
	}
829
fc386319f41c removed external function defs (soon no longer allowed)
Claus Gittinger <cg@exept.de>
parents: 817
diff changeset
   360
	RETURN ( __MKLARGEINT(diff) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   361
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   362
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   363
    if (__isFloatLike(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   364
	OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   365
	double val = (double)__intVal(self) - __floatVal(aNumber);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   366
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
   367
	__qMKFLOAT(newFloat, val);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   368
	RETURN ( newFloat );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   369
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   370
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   371
    ^ aNumber differenceFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   372
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   373
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
/ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   375
    "return the quotient of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   376
a27a279701f8 Initial revision
claus
parents:
diff changeset
   377
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   378
a27a279701f8 Initial revision
claus
parents:
diff changeset
   379
    INT me, t, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   380
    double dval;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   381
252
   382
    if (__isSmallInteger(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   383
	val = __intVal(aNumber);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   384
	if (val != 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   385
	    me = __intVal(self);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   386
	    t = me / val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   387
#ifdef GOOD_OPTIMIZER
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   388
	    if (me % val) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   389
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   390
	    /* this is stupid - all I want is to look for a remainder ... 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   391
	       but most compilers are too stupid and generate an extra modulu
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   392
	       instruction for "if (me % val)".
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   393
	       Even if most divide instructions already leave the remainder in
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   394
	       some register.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   395
	       Therefore I use a multiplication which is faster than a modulu
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   396
	       on most machines. Hint to GNU people :-)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   397
	    */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   398
	    if ((t * val) == me) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   399
#endif
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   400
		RETURN ( __MKSMALLINT(t) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   401
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   402
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   403
    } else {
283
a897d331b4c1 *** empty log message ***
claus
parents: 282
diff changeset
   404
	if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   405
	    dval = __floatVal(aNumber);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   406
	    if (dval != 0.0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   407
		OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   408
		double val = (double)__intVal(self) / dval;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   409
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
   410
		__qMKFLOAT(newFloat, val);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   411
		RETURN ( newFloat );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   412
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   413
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   414
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   415
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   416
    aNumber isInteger ifTrue:[
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   417
	aNumber == 0 ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   418
	    ^ DivisionByZeroSignal raise.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   419
	].
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   420
	^ Fraction numerator:self denominator:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   421
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   422
    ^ aNumber quotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   423
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   424
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   425
     8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   426
     9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   427
     9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   428
     9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   429
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   430
     -8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   431
     -9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   432
     -9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   433
     -9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   434
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   435
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   436
2
claus
parents: 1
diff changeset
   437
// aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   438
    "return the integer part of the quotient of the receivers value
1884
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   439
     and the arguments value. The result is truncated toward negative infinity
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   440
     and negative, if the operands signs differ.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   441
     Be careful with negative results: 9 // 4 = 2, 
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   442
     while -9 // 4 = -3. 
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   443
     See #quo: which returns -2 in the latter."
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   444
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   445
%{  /* NOCONTEXT */
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   446
    INT val, rslt;
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   447
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   448
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   449
	val = __intVal(aNumber);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   450
	if (val != 0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   451
	    rslt = __intVal(self) / val;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   452
	    if (rslt < 0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   453
		if (__intVal(self) % val)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   454
		    rslt--;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   455
	    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   456
	    RETURN ( __MKSMALLINT(rslt) );
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   457
	}
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   458
    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   459
	if (__isFraction(aNumber)) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   460
	    OBJ t;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   461
	    INT num, den;
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   462
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   463
	    t = __FractionInstPtr(aNumber)->f_numerator;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   464
	    if (__isSmallInteger(t)) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   465
		num = __intVal(t);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   466
		t = __FractionInstPtr(aNumber)->f_denominator;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   467
		if (__isSmallInteger(t)) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   468
		    den = __intVal(t);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   469
		    RETURN ( __MKSMALLINT(__intVal(self) * den / num ));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   470
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   471
	    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   472
	}
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   473
    }
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   474
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   475
    (aNumber = 0) ifTrue:[
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   476
	^ DivisionByZeroSignal raise.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   477
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   478
    ^ self retry:#// coercing:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   479
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   480
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   481
     9 // 4    => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   482
     -9 // 4   => -3
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   483
     9 // -4   => -3
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   484
     -9 // -4  => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   485
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   486
     9 quo:4   => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   487
     -9 quo:4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   488
     9 quo:-4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   489
     -9 quo:-4 => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   490
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   491
!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   492
2
claus
parents: 1
diff changeset
   493
\\ aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   494
    "return the integer rest of the receivers value
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   495
     divided by the arguments value.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   496
     This is not always the same as the result as obtained from #rem:"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   497
a27a279701f8 Initial revision
claus
parents:
diff changeset
   498
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   499
    INT mySelf, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   500
252
   501
    if (__isSmallInteger(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   502
	mySelf = __intVal(self);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   503
	if (mySelf < 0) mySelf = -mySelf;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   504
	val = __intVal(aNumber);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   505
	if (val != 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   506
	    if (val < 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   507
		RETURN ( __MKSMALLINT(-(mySelf % -val)) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   508
	    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   509
	    RETURN ( __MKSMALLINT(mySelf % val) );
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   510
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   511
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   512
%}.
2
claus
parents: 1
diff changeset
   513
    (aNumber = 0) ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   514
	^ DivisionByZeroSignal raise.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   515
    ].
2
claus
parents: 1
diff changeset
   516
    ^ self retry:#\\ coercing:aNumber
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   517
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   518
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   519
     9 \\ 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   520
     -9 \\ 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   521
     9 rem:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   522
     -9 rem:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   523
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   524
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   525
a27a279701f8 Initial revision
claus
parents:
diff changeset
   526
abs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   527
    "return the absolute value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   528
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   529
a27a279701f8 Initial revision
claus
parents:
diff changeset
   530
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   531
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   532
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   533
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   534
    if (val >= 0) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   535
	RETURN (self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   536
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   537
    if (val != _MIN_INT) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   538
	RETURN ( __MKSMALLINT(-val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   539
    }
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   540
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   541
    "only reached for minVal"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   542
    ^ self negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   543
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   544
a27a279701f8 Initial revision
claus
parents:
diff changeset
   545
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   546
    "return the negative value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   547
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   548
a27a279701f8 Initial revision
claus
parents:
diff changeset
   549
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   550
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   551
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   552
a27a279701f8 Initial revision
claus
parents:
diff changeset
   553
    if (val != _MIN_INT) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   554
	RETURN ( __MKSMALLINT(- val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   555
    }
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   556
%}.
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   557
    "only reached for minVal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   558
    ^ (LargeInteger value:(SmallInteger maxVal)) + 1
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   559
!
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   560
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   561
quo:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   562
    "return the integer part of the quotient of the receivers value
1884
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   563
     and the arguments value. The result is truncated towards zero
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   564
     and negative, if the operands signs differ.. 
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   565
     For positive results, this is the same as #//,
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   566
     for negative results, the remainder is ignored.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   567
     I.e.: '9 // 4 = 2' and '-9 // 4 = -3'
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   568
     in contrast: '9 quo: 4 = 2' and '-9 quo: 4 = -2'"
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   569
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   570
%{  /* NOCONTEXT */
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   571
    INT val;
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   572
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   573
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   574
	val = __intVal(aNumber);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   575
	if (val != 0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   576
	    RETURN ( __MKSMALLINT(__intVal(self) / val) );
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   577
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   578
    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   579
	if (__isFraction(aNumber)) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   580
	    OBJ t;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   581
	    INT num, den;
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   582
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   583
	    t = __FractionInstPtr(aNumber)->f_numerator;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   584
	    if (__isSmallInteger(t)) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   585
		num = __intVal(t);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   586
		t = __FractionInstPtr(aNumber)->f_denominator;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   587
		if (__isSmallInteger(t)) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   588
		    den = __intVal(t);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   589
		    RETURN ( __MKSMALLINT(__intVal(self) * den / num ));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   590
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   591
	    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   592
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   593
    }
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   594
%}.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   595
    (aNumber = 0) ifTrue:[
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   596
	^ DivisionByZeroSignal raise.
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   597
    ].
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   598
    ^ self retry:#quo: coercing:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   599
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   600
    "
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   601
     9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   602
     -9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   603
     9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   604
     -9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   605
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   606
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   607
a27a279701f8 Initial revision
claus
parents:
diff changeset
   608
!SmallInteger methodsFor:'bit operators'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   609
a27a279701f8 Initial revision
claus
parents:
diff changeset
   610
allMask:anInteger
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   611
    "return true if all 1-bits in anInteger are also 1 in the receiver"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   612
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   613
    ^ (self bitAnd:anInteger) == anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   614
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   615
    "2r00001111 allMask:2r00000001"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   616
    "2r00001111 allMask:2r00011110"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   617
    "2r00001111 allMask:2r00000000"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   618
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   619
a27a279701f8 Initial revision
claus
parents:
diff changeset
   620
anyMask:anInteger
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   621
    "return true if any 1-bits in anInteger is also 1 in the receiver.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   622
     (somewhat incorrect, if the mask is zero)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   623
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   624
    ^ (self bitAnd:anInteger) ~~ 0
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   625
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   626
    "2r00001111 anyMask:2r00000001"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   627
    "2r00001111 anyMask:2r11110000"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   628
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   629
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   630
bitAnd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   631
    "return the bitwise-and of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   632
a27a279701f8 Initial revision
claus
parents:
diff changeset
   633
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   634
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   635
    /* anding the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   636
    if (__isSmallInteger(anInteger)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   637
	RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   638
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   639
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   640
    ^ self retry:#bitAnd: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   641
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   642
    "(2r001010100 bitAnd:2r00001111) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   643
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   644
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   645
bitAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   646
    "return the value of the index's bit (index starts at 1).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   647
     Notice: the result of bitAt: on negative receivers is not 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   648
	     defined in the language standard (since the implementation
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   649
	     is free to choose any internal representation for integers)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   650
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   651
    |mask|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   652
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   653
    (index between:1 and:SmallInteger maxBits) ifFalse:[
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   654
	^ self error:'index out of bounds'
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   655
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   656
    mask := 1 bitShift:(index - 1).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   657
    ((self bitAnd:mask) == 0) ifTrue:[^ 0].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   658
    ^ 1
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   659
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   660
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   661
bitInvert
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   662
    "return the value of the receiver with all bits inverted"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   663
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   664
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   665
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   666
    /* invert anything except tag bits */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   667
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   668
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   669
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   670
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   671
bitOr:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   672
    "return the bitwise-or of the receiver and the argument, anInteger"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   673
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   674
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   675
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   676
    /* oring the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   677
    if (__isSmallInteger(anInteger)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   678
	RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   679
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   680
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   681
    ^ self retry:#bitOr: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   682
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   683
    "(2r000000100 bitOr:2r00000011) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   684
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   685
1506
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   686
bitShift32:shiftCount
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   687
    "return the value of the receiver shifted by shiftCount bits,
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   688
     but only within 32 bits, shifting into/out-of the sign bit.
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   689
     May be useful for communication interfaces, to create ST-numbers
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   690
     from a signed 32bit int value given as individual bytes."
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   691
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   692
%{  /* NOCONTEXT */
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   693
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   694
    INT bits, count;
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   695
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   696
    if (__isSmallInteger(shiftCount)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   697
	count = __intVal(shiftCount);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   698
	bits = __intVal(self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   699
	if (count > 0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   700
	    bits = bits << count;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   701
	} else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   702
	    bits = bits >> (-count);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   703
	}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   704
	RETURN (__MKINT(bits));
1506
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   705
    }
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   706
%}.
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   707
    ^ self primitiveFailed
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   708
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   709
    "
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   710
     128 bitShift:24    
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   711
     128 bitShift32:24  
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   712
    "
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   713
!
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   714
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   715
bitShift:shiftCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
   716
    "return the value of the receiver shifted by shiftCount bits;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   717
     leftShift if shiftCount > 0; rightShift otherwise.
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   718
     Notice: the result of bitShift: on negative receivers is not 
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   719
	     defined in the language standard (since the implementation
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   720
	     is free to choose any internal representation for integers)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   721
a27a279701f8 Initial revision
claus
parents:
diff changeset
   722
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   723
a27a279701f8 Initial revision
claus
parents:
diff changeset
   724
    INT bits, count;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   725
252
   726
    if (__isSmallInteger(shiftCount)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   727
	count = __intVal(shiftCount);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   728
	bits = __intVal(self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   729
	if (bits == 0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   730
	    RETURN (self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   731
	}
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   732
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   733
	if (count > 0) {
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   734
#if defined(_LONGLONG)
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   735
	    unsigned long long result;
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   736
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   737
	    result = bits;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   738
	    if (count <= N_INT_BITS) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   739
		result <<= count;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   740
		if (result <= _MAX_INT) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   741
		    RETURN ( __MKSMALLINT(result) );
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   742
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   743
		{
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   744
		    extern OBJ __MKLARGEINT64();
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   745
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   746
		    RETURN (__MKLARGEINT64(1, (int)(result >> 32), (int)(result & 0xFFFFFFFF)));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   747
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   748
	    }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   749
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   750
	    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   751
	     * check for overflow
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   752
	     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   753
	    if (count < (N_INT_BITS-1)) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   754
		if (! (bits >> (N_INT_BITS - 1 - count))) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   755
		    RETURN ( __MKSMALLINT(bits << count) );
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   756
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   757
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   758
		 * so, there is an overflow ...
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   759
		 * handle it as largeInteger
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   760
		 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   761
		/* FALL THROUGH */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   762
	    }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   763
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   764
	} else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   765
	    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   766
	     * right shifts cannot overflow
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   767
	     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   768
	    if (count < 0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   769
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   770
		 * some machines ignore shifts bigger than
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   771
		 * the number of bits in an int ...
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   772
		 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   773
		if (count < (-N_INT_BITS-1))
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   774
		    RETURN (__MKSMALLINT(0));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   775
		RETURN ( __MKSMALLINT(bits >> -count) );
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   776
	    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   777
	    RETURN (self );
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   778
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   779
    }
85
claus
parents: 77
diff changeset
   780
%}.
claus
parents: 77
diff changeset
   781
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
   782
	^ (LargeInteger value:self) bitShift:shiftCount
85
claus
parents: 77
diff changeset
   783
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   784
    ^ self bitShift:(shiftCount coerce:1)
a27a279701f8 Initial revision
claus
parents:
diff changeset
   785
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   786
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   787
bitTest:aMask
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   788
    "return true, if any bit from aMask is set in the receiver"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   789
a27a279701f8 Initial revision
claus
parents:
diff changeset
   790
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   791
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   792
    /* and all bits except tag */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   793
    if (__isSmallInteger(aMask)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   794
	RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   795
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   796
%}.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   797
    ^ self retry:#bitTest: coercing:aMask
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   798
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   799
a27a279701f8 Initial revision
claus
parents:
diff changeset
   800
bitXor:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   801
    "return the bitwise-exclusive-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   802
a27a279701f8 Initial revision
claus
parents:
diff changeset
   803
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   804
a27a279701f8 Initial revision
claus
parents:
diff changeset
   805
    /* xoring the tags turns it off - or it in again */
252
   806
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   807
	RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   808
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   809
%}.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   810
    ^ self retry:#bitXor: coercing:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   811
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   812
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   813
highBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   814
    "return the bitIndex of the highest bit set. The returned bitIndex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   815
     starts at 1 for the least significant bit. Returns -1 if no bit is set."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   816
a27a279701f8 Initial revision
claus
parents:
diff changeset
   817
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   818
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   819
    INT mask, index, bits;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   820
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   821
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   822
    if (bits == 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   823
	RETURN ( __MKSMALLINT(-1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   824
    }
2653
6d9354cf956d prep for alpha
Claus Gittinger <cg@exept.de>
parents: 2650
diff changeset
   825
#ifdef alpha64
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   826
    mask = 0x2000000000000000;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   827
    index = 62;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   828
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   829
    mask = 0x20000000;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   830
    index = 30;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   831
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   832
    while (index) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   833
	if (bits & mask) break;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   834
	mask = mask >> 1;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   835
	index--;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   836
    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   837
    RETURN ( __MKSMALLINT(index) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   838
%}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   839
    "2r000100 highBit"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   840
    "2r010100 highBit"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   841
    "2r000001 highBit"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   842
    "0 highBit"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   843
    "SmallInteger maxVal highBit"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   844
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   845
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   846
lowBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   847
    "return the bitIndex of the lowest bit set. The returned bitIndex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   848
     starts at 1 for the least significant bit. Returns -1 if no bit is set."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   849
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   850
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   851
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   852
    INT mask, index, bits;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   853
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   854
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   855
    if (bits == 0) {
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   856
        RETURN ( __MKSMALLINT(-1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   857
    }
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   858
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   859
    if ((bits & 0xFFFFFF) == 0) {
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   860
        mask = 0x1000000;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   861
        index = 25;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   862
    } else {
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   863
        if ((bits & 0xFFFF) == 0) {
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   864
            mask = 0x10000;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   865
            index = 17;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   866
        } else {
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   867
            if ((bits & 0xFF) == 0) {
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   868
                mask = 0x100;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   869
                index = 9;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   870
            } else {
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   871
                mask = 1;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   872
                index = 1;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   873
            }
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   874
        }
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   875
    }
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   876
2653
6d9354cf956d prep for alpha
Claus Gittinger <cg@exept.de>
parents: 2650
diff changeset
   877
#ifdef alpha64
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   878
    while (index != 63) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   879
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   880
    while (index != 31) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   881
#endif
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   882
        if (bits & mask) {
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   883
            RETURN ( __MKSMALLINT(index) );
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   884
        }
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   885
        mask = mask << 1;
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   886
        index++;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   887
    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   888
    RETURN ( __MKSMALLINT(-1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   889
%}
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   890
    "
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   891
     2r000100 lowBit
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   892
     2r010010 lowBit
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   893
     2r100001 lowBit
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   894
     16r1000 lowBit 
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   895
     16r1000000 lowBit 
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   896
     0 lowBit 
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
   897
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   898
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   899
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   900
noMask:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   901
    "return true if no 1-bit in anInteger is 1 in the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   902
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   903
    ^ (self bitAnd:anInteger) == 0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   904
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   905
    "2r00001111 noMask:2r00000001"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   906
    "2r00001111 noMask:2r11110000"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   907
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   908
a27a279701f8 Initial revision
claus
parents:
diff changeset
   909
!SmallInteger methodsFor:'byte access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   910
a27a279701f8 Initial revision
claus
parents:
diff changeset
   911
digitAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   912
    "return 8 bits of value, starting at byte index"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   913
a27a279701f8 Initial revision
claus
parents:
diff changeset
   914
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   915
357
claus
parents: 329
diff changeset
   916
    REGISTER INT val;
claus
parents: 329
diff changeset
   917
    INT idx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   918
252
   919
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   920
	val = __intVal(self);
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   921
	if (val < 0)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   922
	    val = -val;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   923
	switch (idx = __intVal(index)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   924
	    case 1:
357
claus
parents: 329
diff changeset
   925
		break;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   926
	    case 2:
357
claus
parents: 329
diff changeset
   927
		val = (val >> 8);
claus
parents: 329
diff changeset
   928
		break;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   929
	    case 3:
357
claus
parents: 329
diff changeset
   930
		val = (val >> 16);
claus
parents: 329
diff changeset
   931
		break;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   932
	    case 4:
357
claus
parents: 329
diff changeset
   933
		val = (val >> 24);
claus
parents: 329
diff changeset
   934
		break;
2653
6d9354cf956d prep for alpha
Claus Gittinger <cg@exept.de>
parents: 2650
diff changeset
   935
#ifdef alpha64
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   936
	    case 5:
357
claus
parents: 329
diff changeset
   937
		val = (val >> 32);
claus
parents: 329
diff changeset
   938
		break;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   939
	    case 6:
357
claus
parents: 329
diff changeset
   940
		val = (val >> 40);
claus
parents: 329
diff changeset
   941
		break;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   942
	    case 7:
357
claus
parents: 329
diff changeset
   943
		val = (val >> 48);
claus
parents: 329
diff changeset
   944
		break;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   945
	    case 8:
357
claus
parents: 329
diff changeset
   946
		val = (val >> 56);
claus
parents: 329
diff changeset
   947
		break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   948
#endif
357
claus
parents: 329
diff changeset
   949
	    default:
claus
parents: 329
diff changeset
   950
		if (idx < 1)
claus
parents: 329
diff changeset
   951
		    goto bad;   /* sorry */
claus
parents: 329
diff changeset
   952
		val = 0;
claus
parents: 329
diff changeset
   953
		break;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   954
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   955
	RETURN ( __MKSMALLINT( val & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   956
    }
357
claus
parents: 329
diff changeset
   957
  bad: ;
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   958
%}.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   959
    index > 0 ifFalse:[
357
claus
parents: 329
diff changeset
   960
	"
claus
parents: 329
diff changeset
   961
	 index less than 1 - not allowed
claus
parents: 329
diff changeset
   962
	"
claus
parents: 329
diff changeset
   963
	^ self primitiveFailed
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   964
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   965
    ^ 0
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   966
357
claus
parents: 329
diff changeset
   967
    "
claus
parents: 329
diff changeset
   968
     (16r12345678 digitAt:1) printStringRadix:16
claus
parents: 329
diff changeset
   969
     (16r12345678 digitAt:3) printStringRadix:16
claus
parents: 329
diff changeset
   970
     (16r12345678 digitAt:15) printStringRadix:16
claus
parents: 329
diff changeset
   971
     (16r12345678 digitAt:0) printStringRadix:16
claus
parents: 329
diff changeset
   972
     (16r12345678 digitAt:-10) printStringRadix:16
claus
parents: 329
diff changeset
   973
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   974
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   975
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   976
digitLength
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   977
    "return the number bytes used by this Integer"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   978
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   979
    ^ self abs highBit - 1 // 8 + 1
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   980
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   981
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   982
!SmallInteger methodsFor:'catching messages'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   983
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   984
basicAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   985
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   986
     defined here since basicAt: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   987
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   988
    self notIndexed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   989
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   990
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   991
basicAt:index put:anObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   992
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   993
     defined here since basicAt:put: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   994
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   995
    self notIndexed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   996
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   997
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   998
basicSize
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   999
    "return the number of indexed instvars - SmallIntegers have none.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1000
     Defined here since basicSize in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1001
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1002
    ^ 0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1003
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1004
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1005
size
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1006
    "return the number of indexed instvars - SmallIntegers have none."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1007
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1008
    ^ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1009
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1010
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1011
!SmallInteger methodsFor:'coercing and converting'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1012
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1013
asCharacter
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1014
    "Return a character with the receiver as ascii value"
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1015
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1016
    ^ Character value:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1017
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1018
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1019
asFloat
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1020
    "return a Float with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1021
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1022
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1023
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1024
    OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1025
    double dVal = (double)__intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1026
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1027
    __qMKFLOAT(newFloat, dVal);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1028
    RETURN ( newFloat );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1029
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1030
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1031
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1032
asLargeInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1033
    "return a LargeInteger with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1034
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1035
    ^ LargeInteger value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1036
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1037
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1038
asShortFloat
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1039
    "return a ShortFloat with same value as receiver"
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1040
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1041
%{  /* NOCONTEXT */
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1042
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1043
    OBJ dummy = @global(ShortFloat);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1044
    OBJ newFloat;
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1045
    float fVal = (float)__intVal(self);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1046
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1047
    __qMKSFLOAT(newFloat, fVal);
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1048
    RETURN ( newFloat );
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1049
%}
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1050
!
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1051
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1052
coerce:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1053
    "return aNumber converted into receivers type"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1054
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1055
    ^ aNumber asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1056
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1057
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1058
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1059
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1060
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1061
    ^ 20
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1062
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1063
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1064
signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1065
    "return a smallInteger from sign-extending the 8'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1066
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1067
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1068
%{  /* NOCONTEXT */
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1069
    int i = __intVal(self);
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1070
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1071
    if (i & 0x80) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1072
	i = i | 0x7FFFFF00;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1073
    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1074
	i = i & 0x7F;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1075
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1076
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1077
    RETURN (__MKSMALLINT(i));
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1078
%}
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1079
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1080
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1081
     16rFF signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1082
     16r7F signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1083
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1084
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1085
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1086
signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1087
    "return a smallInteger from sign-extending the 16'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1088
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1089
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1090
%{  /* NOCONTEXT */
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1091
    int i = __intVal(self);
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1092
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1093
    if (i & 0x8000) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1094
	i = i | 0x7FFF0000;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1095
    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1096
	i = i & 0x7FFF;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1097
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1098
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1099
    RETURN (__MKSMALLINT(i));
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1100
%}
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1101
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1102
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1103
     16rFFFF signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1104
     16r7FFF signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1105
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1106
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1107
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1108
!SmallInteger methodsFor:'comparing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1109
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1110
< aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1111
    "return true, if the argument is greater than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1112
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1113
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1114
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1115
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1116
#ifdef POSITIVE_ADDRESSES
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1117
	RETURN ( (__intVal(self) < __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1118
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1119
	/* tag bit does not change ordering */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1120
	RETURN ( ((INT)self < (INT)aNumber) ? true : false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1121
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1122
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1123
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1124
	RETURN ( ((double)__intVal(self) < __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1125
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1126
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1127
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1128
    ^ aNumber lessFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1129
    "^ self retry:#< coercing:aNumber"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1130
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1131
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1132
<= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1133
    "return true, if the argument is greater or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1134
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1135
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1136
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1137
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1138
#ifdef POSITIVE_ADDRESSES
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1139
	RETURN ( (__intVal(self) <= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1140
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1141
	/* tag bit does not change ordering */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1142
	RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1143
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1144
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1145
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1146
	RETURN ( ((double)__intVal(self) <= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1147
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1148
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1149
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1150
    ^ self retry:#<= coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1151
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1152
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1153
= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1154
    "return true, if the arguments value is equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1155
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1156
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1157
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1158
    if (aNumber == self) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1159
	RETURN ( true );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1160
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1161
    if (! __isNonNilObject(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1162
	/* a smallint or nil */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1163
	RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1164
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1165
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1166
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1167
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1168
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1169
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1170
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1171
    aNumber respondsToArithmetic ifFalse:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1172
    ^ self retry:#= coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1173
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1174
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1175
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1176
    "return true, if the argument is less than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1177
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1178
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1179
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1180
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1181
#ifdef POSITIVE_ADDRESSES
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1182
	RETURN ( (__intVal(self) > __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1183
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1184
	/* tag bit does not change ordering */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1185
	RETURN ( ((INT)self > (INT)aNumber) ? true : false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1186
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1187
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1188
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1189
	RETURN ( ((double)__intVal(self) > __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1190
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1191
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1192
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1193
    ^ self retry:#> coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1194
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1195
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1196
>= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1197
    "return true, if the argument is less or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1198
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1199
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1200
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1201
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1202
#ifdef POSITIVE_ADDRESSES
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1203
	RETURN ( (__intVal(self) >= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1204
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1205
	/* tag bit does not change ordering */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1206
	RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1207
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1208
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1209
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1210
	RETURN ( ((double)__intVal(self) >= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1211
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1212
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1213
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1214
    ^ self retry:#>= coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1215
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1216
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1217
hash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1218
    "return an integer useful for hashing on value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1219
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1220
    self >= 0 ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1221
    ^ self negated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1222
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1223
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1224
identityHash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1225
    "return an integer useful for hashing on identity"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1226
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  1227
     self >= 0 ifTrue:[^ self].
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  1228
     ^ self negated
1963
ea26c7b9ca1d experimental: new hash value for smallInts
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1229
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  1230
    "Modified: 11.11.1996 / 18:42:14 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1231
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1232
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1233
max:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1234
    "return the receiver or the argument, whichever is greater"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1235
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1236
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1237
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1238
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1239
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1240
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1241
	if ((INT)(self) > (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1242
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1243
	if (__intVal(self) > __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1244
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1245
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1246
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1247
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1248
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1249
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1250
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1251
	if ( (double)__intVal(self) > __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1252
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1253
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1254
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1255
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1256
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1257
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1258
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1259
    (self > aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1260
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1261
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1262
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1263
min:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1264
    "return the receiver or the argument, whichever is smaller"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1265
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1266
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1267
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1268
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1269
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1270
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1271
	if ((INT)(self) < (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1272
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1273
	if (__intVal(self) < __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1274
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1275
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1276
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1277
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1278
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1279
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1280
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1281
	if ( (double)__intVal(self) < __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1282
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1283
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1284
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1285
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1286
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1287
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1288
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1289
    (self < aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1290
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1291
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1292
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1293
~= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1294
    "return true, if the arguments value is not equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1295
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1296
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1297
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1298
    if (aNumber == self) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1299
	RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1300
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1301
    if (! __isNonNilObject(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1302
	/* a smallint or nil */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1303
	RETURN ( true );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1304
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1305
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1306
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1307
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? false : true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1308
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1309
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1310
    aNumber respondsToArithmetic ifFalse:[^ true].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1311
    ^ self retry:#~= coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1312
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1313
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1314
!SmallInteger methodsFor:'copying'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1315
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1316
deepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1317
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1318
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1319
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1320
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1321
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1322
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1323
deepCopyUsing:aDictionary
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1324
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1325
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1326
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1327
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1328
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1329
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1330
shallowCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1331
    "return a shallow copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1332
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1333
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1334
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1335
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1336
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1337
simpleDeepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1338
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1339
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1340
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1341
    ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1342
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1343
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1344
!SmallInteger methodsFor:'iteration'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1345
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1346
timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  1347
    "evaluate the argument, aBlock self times.
claus
parents: 329
diff changeset
  1348
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1349
357
claus
parents: 329
diff changeset
  1350
%{
claus
parents: 329
diff changeset
  1351
    REGISTER INT tmp;
claus
parents: 329
diff changeset
  1352
    static struct inlineCache blockVal = __ILC0(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1353
357
claus
parents: 329
diff changeset
  1354
    tmp = __intVal(self);
claus
parents: 329
diff changeset
  1355
    if (tmp > 0) {
claus
parents: 329
diff changeset
  1356
	if (__isBlockLike(aBlock)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1357
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(0))) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1358
	    {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1359
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1360
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1361
		/*
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1362
		 * specially tuned version for compiled blocks, 
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1363
		 * (the most common case)
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1364
		 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1365
                if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1366
#ifdef PARANOIA
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1367
                 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1368
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1369
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1370
357
claus
parents: 329
diff changeset
  1371
#ifdef NEW_BLOCK_CALL
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1372
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1373
#                   define BLOCK_ARG  aBlock
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1374
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1375
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1376
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1377
#                   define BLOCK_ARG  rHome
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1378
		    REGISTER OBJ rHome;
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1379
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1380
		    /*
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1381
		     * home on stack - no need to refetch
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1382
		     */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1383
		    rHome = __BlockInstPtr(aBlock)->b_home;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1384
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1385
#endif
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1386
		    {
2604
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  1387
#ifdef WIN32
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  1388
# undef UNROLL_LOOPS
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  1389
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1390
#ifdef UNROLL_LOOPS
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1391
			if (0) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1392
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1393
			    interrupted0:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1394
						__interruptL(@line); goto continue0;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1395
			    interrupted1:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1396
						__interruptL(@line); goto continue1;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1397
			    interrupted2:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1398
						__interruptL(@line); goto continue2;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1399
			    interrupted3:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1400
						__interruptL(@line); goto continue3;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1401
			    interrupted4:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1402
						__interruptL(@line); goto continue4;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1403
			    interrupted5:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1404
						__interruptL(@line); goto continue5;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1405
			    interrupted6:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1406
						__interruptL(@line); goto continue6;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1407
			    interrupted7:
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1408
						__interruptL(@line); goto continue7;
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1409
			}
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1410
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1411
			/*
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1412
			 * you are not supposed to program like this - I know what I do
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1413
			 */
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1414
			while (tmp > 8) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1415
			    if (InterruptPending != nil) goto interrupted0;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1416
	continue0:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1417
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1418
			    if (InterruptPending != nil) goto interrupted1;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1419
	continue1:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1420
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1421
			    if (InterruptPending != nil) goto interrupted2;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1422
	continue2:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1423
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1424
			    if (InterruptPending != nil) goto interrupted3;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1425
	continue3:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1426
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1427
			    if (InterruptPending != nil) goto interrupted4;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1428
	continue4:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1429
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1430
			    if (InterruptPending != nil) goto interrupted5;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1431
	continue5:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1432
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1433
			    if (InterruptPending != nil) goto interrupted6;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1434
	continue6:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1435
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1436
			    if (InterruptPending != nil) goto interrupted7;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1437
	continue7:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1438
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1439
			    tmp -= 8;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1440
			}
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1441
#endif /* UNROLL_LOOPS */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1442
			do {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1443
			    if (InterruptPending != nil) __interruptL(@line);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1444
			    (*codeVal)(BLOCK_ARG);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1445
			} while(--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1446
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1447
			RETURN (self);
394
claus
parents: 389
diff changeset
  1448
		    }
530
07d0bce293c9 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 400
diff changeset
  1449
		}
394
claus
parents: 389
diff changeset
  1450
	    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1451
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1452
#           undef BLOCK_ARG
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1453
400
claus
parents: 394
diff changeset
  1454
#ifdef NEW_BLOCK_CALL
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1455
#           define BLOCK_ARG  aBlock
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1456
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  1457
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1458
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1459
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  1460
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1461
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1462
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1463
	     * sorry - must check for the blocks code within the loops;
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1464
	     * it could be recompiled or flushed (in the interrupt)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1465
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1466
	    do {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1467
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1468
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1469
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1470
		    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1471
		     * arg is a compiled block with code -
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1472
		     * directly call it without going through Block>>value
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1473
		     * however, if there is an interrupt, refetch the code pointer.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1474
		     */
2649
eeff6ccf6356 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2641
diff changeset
  1475
		    /* stay here, while no interrupts are pending ... */
eeff6ccf6356 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2641
diff changeset
  1476
		    do {
eeff6ccf6356 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2641
diff changeset
  1477
		        (*codeVal)(BLOCK_ARG);
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1478
			if (InterruptPending != nil) goto outerLoop;
2649
eeff6ccf6356 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2641
diff changeset
  1479
		    } while (--tmp);
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1480
	            RETURN (self);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1481
		} else {
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1482
		    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1483
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1484
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1485
			/*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1486
			 * arg is a compiled block with bytecode -
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1487
			 * directly call interpreter without going through Block>>value
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1488
			 */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1489
			__interpret(aBlock, 0, nil, IBLOCK_ARG, nil, nil);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1490
		    } else {
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1491
			/*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1492
			 * arg is something else - call it with #value
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1493
			 */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1494
			(*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1495
		    }
400
claus
parents: 394
diff changeset
  1496
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1497
    outerLoop: ;
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1498
	    } while (--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1499
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1500
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1501
#           undef IBLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1502
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1503
	    RETURN (self);
357
claus
parents: 329
diff changeset
  1504
	}
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1505
394
claus
parents: 389
diff changeset
  1506
	/*
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1507
	 * not a block-like thingy - call it with #value
394
claus
parents: 389
diff changeset
  1508
	 */
claus
parents: 389
diff changeset
  1509
	do {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1510
	    if (InterruptPending != nil) __interruptL(@line);
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  1511
	    (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
394
claus
parents: 389
diff changeset
  1512
	} while(--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1513
	RETURN (self);
357
claus
parents: 329
diff changeset
  1514
    }
claus
parents: 329
diff changeset
  1515
%}
claus
parents: 329
diff changeset
  1516
claus
parents: 329
diff changeset
  1517
"/    |count "{ Class: SmallInteger }" |
claus
parents: 329
diff changeset
  1518
"/
claus
parents: 329
diff changeset
  1519
"/    count := self.
claus
parents: 329
diff changeset
  1520
"/    [count > 0] whileTrue:[
claus
parents: 329
diff changeset
  1521
"/        aBlock value.
claus
parents: 329
diff changeset
  1522
"/        count := count - 1
claus
parents: 329
diff changeset
  1523
"/    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1524
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1525
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1526
to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1527
    "reimplemented as primitive for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1528
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1529
%{
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1530
    REGISTER INT tmp, step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1531
    REGISTER INT final;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1532
    static struct inlineCache blockVal = __ILC1(0);
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1533
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1534
    if (__bothSmallInteger(incr, stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1535
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1536
	final = __intVal(stop);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1537
	step = __intVal(incr);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1538
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1539
	if (__isBlockLike(aBlock)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1540
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1541
	    {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1542
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1543
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1544
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1545
		 * specially tuned version for static compiled blocks, called with
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1546
		 * home on the stack (the most common case)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1547
		 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1548
                if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1549
#ifdef PARANOIA
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1550
                 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1551
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1552
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1553
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1554
#ifdef NEW_BLOCK_CALL
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1555
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1556
#                   define BLOCK_ARG  aBlock
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1557
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1558
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1559
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1560
#                   define BLOCK_ARG  rHome
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1561
		    REGISTER OBJ rHome;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1562
		    rHome = __BlockInstPtr(aBlock)->b_home;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1563
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1564
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1565
#endif
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1566
		    {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1567
			if (step < 0) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1568
			    if (step == -1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1569
				while (tmp >= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1570
				    if (InterruptPending != nil) __interruptL(@line);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1571
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1572
				    tmp--;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1573
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1574
			    } else {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1575
				while (tmp >= final) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1576
				    if (InterruptPending != nil) __interruptL(@line);
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1577
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1578
				    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1579
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1580
			    }
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1581
			} else {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1582
			    if (step == 1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1583
				while (tmp <= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1584
				    if (InterruptPending != nil) __interruptL(@line);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1585
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1586
				    tmp++;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1587
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1588
			    } else {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1589
			        while (tmp <= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1590
				    if (InterruptPending != nil) __interruptL(@line);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1591
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1592
				    tmp += step;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1593
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1594
			    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1595
			}
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1596
			RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1597
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1598
		}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1599
	    }
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1600
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1601
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1602
	     * sorry - must check for the blocks code within the loops;
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1603
	     * it could be recompiled or flushed (in the interrupt)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1604
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1605
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1606
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1607
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1608
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1609
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1610
#           define IBLOCK_ARG nil
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1611
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1612
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1613
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1614
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1615
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1616
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1617
		while (tmp >= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1618
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1619
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1620
		    if (InterruptPending != nil) __interruptL(@line);
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1621
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1622
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1623
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1624
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1625
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1626
			 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1627
			(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1628
		    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1629
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1630
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1631
			     * arg is a compiled block with bytecode -
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1632
			     * directly call interpreter without going through Block>>value
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1633
			     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1634
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1635
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1636
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1637
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1638
				idx = __MKSMALLINT(tmp);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1639
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1640
			    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1641
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1642
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1643
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1644
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1645
			} else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1646
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1647
			     * arg is something else - call it with #value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1648
			     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1649
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1650
			}
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1651
		    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1652
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1653
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1654
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1655
		while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1656
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1657
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1658
		    if (InterruptPending != nil) __interruptL(@line);
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1659
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1660
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1661
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1662
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1663
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1664
			 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1665
			(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1666
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1667
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1668
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1669
			     * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1670
			     * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1671
			     */
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1672
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1673
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1674
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1675
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1676
				idx = __MKSMALLINT(tmp);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1677
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1678
			    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1679
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1680
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1681
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1682
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1683
			} else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1684
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1685
			     * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1686
			     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1687
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1688
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1689
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1690
		    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1691
		}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1692
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1693
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1694
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1695
#           undef IBLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1696
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1697
	} else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1698
	    /*
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1699
	     * arg is something else - call it with #value:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1700
	     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1701
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1702
		while (tmp >= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1703
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1704
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1705
		    (*blockVal.ilc_func)(aBlock, 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1706
					 @symbol(value:), 
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  1707
					 nil, &blockVal,
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1708
					 __MKSMALLINT(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1709
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1710
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1711
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1712
		while (tmp <= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1713
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1714
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1715
		    (*blockVal.ilc_func)(aBlock, 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1716
					 @symbol(value:), 
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  1717
					 nil, &blockVal,
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1718
					 __MKSMALLINT(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1719
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1720
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1721
	    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1722
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1723
	RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1724
    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1725
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1726
    "/
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1727
    "/ arrive here if stop is not a smallInteger
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1728
    "/ pass on to super ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1729
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1730
    ^ super to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1731
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1732
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1733
     1 to:10 by:3 do:[:i | i printNewline]
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1734
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1735
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1736
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1737
to:stop do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1738
    "evaluate aBlock for every integer between (and including) the receiver
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1739
     and the argument, stop.
357
claus
parents: 329
diff changeset
  1740
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1741
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1742
%{
2604
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  1743
#ifndef WIN32
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1744
    REGISTER INT tmp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1745
    INT final;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1746
    static struct inlineCache blockVal = __ILC1(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1747
252
  1748
    if (__isSmallInteger(stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1749
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1750
	final = __intVal(stop);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1751
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1752
	if (__isBlockLike(aBlock)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1753
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1754
	    {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1755
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1756
		 * specially tuned version for the most common case,
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1757
		 * where called with home on the stack
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1758
		 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1759
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1760
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1761
                if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1762
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1763
#ifdef NEW_BLOCK_CALL
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1764
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1765
#                   define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1766
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1767
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1768
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1769
#                   define BLOCK_ARG  rHome
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1770
		    REGISTER OBJ rHome;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1771
		    rHome = __BlockInstPtr(aBlock)->b_home;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1772
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1773
#endif
400
claus
parents: 394
diff changeset
  1774
		    {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1775
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1776
#ifdef PARANOIA
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1777
			if (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC))) 
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1778
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  1779
			{
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1780
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1781
			     * static compiled blocks ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1782
			     */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1783
#ifdef UNROLL_LOOPS
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1784
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1785
			     * you are not supposed to program like this - I know what I do
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1786
			     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1787
			    int t8 = tmp+8;
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1788
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1789
			    for (;;) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1790
				if (0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1791
				    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1792
				     * no discussion about those gotos ...
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1793
				     * ... its better for your CPU's pipelines
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1794
				     * (if you dont understand why, just dont argue).
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1795
				     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1796
				    interrupted7:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1797
						    __interruptL(@line); goto continue7;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1798
				    interrupted6:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1799
						    __interruptL(@line); goto continue6;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1800
				    interrupted5:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1801
						    __interruptL(@line); goto continue5;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1802
				    interrupted4:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1803
						    __interruptL(@line); goto continue4;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1804
				    interrupted3:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1805
						    __interruptL(@line); goto continue3;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1806
				    interrupted2:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1807
						    __interruptL(@line); goto continue2;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1808
				    interrupted1:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1809
						    __interruptL(@line); goto continue1;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1810
				    interrupted0:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1811
						    __interruptL(@line); goto continue0;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1812
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1813
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1814
				while (t8 <= final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1815
				    t8 += 8;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1816
				    if (InterruptPending != nil) goto interrupted0;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1817
	continue0:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1818
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1819
				    if (InterruptPending != nil) goto interrupted1;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1820
	continue1:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1821
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+1));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1822
				    if (InterruptPending != nil) goto interrupted2;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1823
	continue2:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1824
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+2));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1825
				    if (InterruptPending != nil) goto interrupted3;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1826
	continue3:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1827
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+3));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1828
				    if (InterruptPending != nil) goto interrupted4;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1829
	continue4:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1830
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+4));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1831
				    if (InterruptPending != nil) goto interrupted5;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1832
	continue5:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1833
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+5));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1834
				    if (InterruptPending != nil) goto interrupted6;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1835
	continue6:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1836
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+6));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1837
				    if (InterruptPending != nil) goto interrupted7;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1838
	continue7:
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1839
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+7));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1840
				    tmp += 8;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1841
				}
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1842
			        while (tmp <= final) {
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1843
				    if (InterruptPending != nil) __interruptL(@line);
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1844
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1845
				    tmp ++;
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1846
			        }
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1847
			        RETURN (self);
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  1848
			    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1849
#else
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  1850
			    while (tmp <= final) {
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  1851
				if (InterruptPending != nil) __interruptL(@line);
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  1852
				(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  1853
				tmp ++;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1854
			    }
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  1855
			    RETURN (self);
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  1856
#endif /* UNROLL_LOOPS */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1857
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1858
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1859
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1860
			 * mhmh - seems to be a block with dynamic code
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1861
			 * must refetch, to allow dynamic recompilation or code flush.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1862
			 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1863
			while (tmp <= final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1864
			    if (InterruptPending != nil) __interruptL(@line);
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1865
			    if ((codeVal = __BlockInstPtr(aBlock)->b_code) == (OBJFUNC)nil) break;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1866
			    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1867
			    tmp ++;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1868
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1869
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1870
			if (tmp > final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1871
			    RETURN (self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1872
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1873
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1874
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1875
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1876
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1877
#           undef BLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1878
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1879
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1880
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1881
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  1882
#else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1883
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1884
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  1885
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1886
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1887
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1888
	     * sorry - must check for the blocks code within the loops;
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1889
	     * it could be recompiled or flushed (in the interrupt)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1890
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1891
	    while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1892
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1893
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  1894
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1895
		    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1896
		     * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1897
		     * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1898
		     */
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1899
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1900
                    /* stay here, while no interrupts are pending ... */
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1901
                    do {
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1902
                        (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1903
                        if (InterruptPending != nil) goto outerLoop;
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1904
			tmp++;
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1905
                    } while (tmp <= final);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1906
		    RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1907
		} else {
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1908
		    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1909
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1910
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1911
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1912
			 * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1913
			 * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1914
			 */
400
claus
parents: 394
diff changeset
  1915
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1916
			{
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1917
			    OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1918
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1919
			    idx = __MKSMALLINT(tmp);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1920
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1921
			}
400
claus
parents: 394
diff changeset
  1922
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1923
			__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
400
claus
parents: 394
diff changeset
  1924
#endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1925
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1926
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1927
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1928
			 * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1929
			 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1930
			(*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1931
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1932
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1933
	    outerLoop: ;
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1934
		tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1935
	    }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1936
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1937
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1938
#           undef IBLOCK_ARG
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1939
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1940
	    RETURN (self);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1941
	}
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1942
	/*
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1943
	 * arg is something else - call it with #value:
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1944
	 */
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1945
	while (tmp <= final) {
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1946
	    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1947
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1948
	    (*blockVal.ilc_func)(aBlock, 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1949
					 @symbol(value:), 
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1950
					 nil, &blockVal,
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1951
					 __MKSMALLINT(tmp));
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  1952
	    tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1953
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1954
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1955
    }
2604
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  1956
#endif /* WIN32 */
400
claus
parents: 394
diff changeset
  1957
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1958
400
claus
parents: 394
diff changeset
  1959
    "/
claus
parents: 394
diff changeset
  1960
    "/ arrive here if stop is not a smallInteger
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1961
    "/ pass on to super ...
400
claus
parents: 394
diff changeset
  1962
    "/
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1963
    ^ super to:stop do:aBlock
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1964
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1965
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1966
     1 to:10 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1967
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1968
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1969
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1970
!SmallInteger methodsFor:'misc math'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1971
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1972
divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1973
    "return an array filled with self // aNumber and
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1974
     self \\ aNumber.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1975
     The result is only defined for positive receiver and
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1976
     argument."
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1977
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1978
%{  /* NOCONTEXT */
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1979
    INT val, div, mod, mySelf;
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1980
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1981
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1982
	val = __intVal(aNumber);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1983
	if (val != 0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1984
	    mySelf = __intVal(self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1985
	    div = mySelf / val;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1986
	    mod = mySelf % val;
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1987
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1988
	    RETURN (__ARRAY_WITH2( __MKSMALLINT(div),
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1989
				   __MKSMALLINT(mod)));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  1990
	}
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1991
    }
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1992
%}.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1993
    ^ super divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1994
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1995
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1996
     10 // 3 
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1997
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1998
     10 \\ 3  
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  1999
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2000
     10 divMod:3 
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2001
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2002
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2003
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2004
gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2005
    "return the greatest common divisor (Euclid's algorithm).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2006
     This has been redefined here for more speed since due to the
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2007
     use of gcd in Fraction code, it has become time-critical for
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2008
     some code. (thanx to MessageTally)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2009
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2010
%{  /* NOCONTEXT */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2011
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2012
    if (__isSmallInteger(anInteger)) {
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2013
        INT orgArg, ttt, selfInt, temp;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2014
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2015
        ttt = orgArg = __intVal(anInteger);
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2016
        if (ttt) {
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2017
            selfInt = __intVal(self);
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2018
            while (ttt != 0) {
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2019
                temp = selfInt % ttt;
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2020
                selfInt = ttt;
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2021
                ttt = temp;
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2022
            }
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2023
            /*
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2024
             * since its not defined in C, what the sign of
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2025
             * a modulu result is when the arg is negative,
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2026
             * change it explicitely here ...
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2027
             */
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2028
            if (orgArg < 0) {
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2029
                /* result should be negative */
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2030
                if (selfInt > 0) selfInt = -selfInt;
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2031
            } else {
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2032
                /* result should be positive */
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2033
                if (selfInt < 0) selfInt = -selfInt;
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2034
            }
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2035
            RETURN ( __MKSMALLINT(selfInt) );
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2036
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2037
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2038
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2039
.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2040
    ^ super gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2041
!
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2042
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2043
gcd_helper:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2044
    "same as gcd - see knuth & Integer>>gcd:"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2045
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2046
    ^ self gcd:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2047
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2048
    "Created: 1.3.1997 / 16:58:01 / cg"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2049
!
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2050
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2051
intlog10
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2052
    "return the truncation of log10 of the receiver -
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2053
     stupid implementation; used to find out the number of digits needed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2054
     to print a number/and for conversion to a LargeInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2055
     Implemented that way, to allow for tiny systems without a Float class
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2056
     (i.e. without log)."
2
claus
parents: 1
diff changeset
  2057
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2058
    self <= 0 ifTrue:[
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2059
	self error:'logarithm of negative integer'
2
claus
parents: 1
diff changeset
  2060
    ].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2061
    self < 10 ifTrue:[^ 1].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2062
    self < 100 ifTrue:[^ 2].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2063
    self < 1000 ifTrue:[^ 3].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2064
    self < 10000 ifTrue:[^ 4].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2065
    self < 100000 ifTrue:[^ 5].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2066
    self < 1000000 ifTrue:[^ 6].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2067
    self < 10000000 ifTrue:[^ 7].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2068
    self < 100000000 ifTrue:[^ 8].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2069
    self < 1000000000 ifTrue:[^ 9].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2070
    ^ 10
2
claus
parents: 1
diff changeset
  2071
! !
claus
parents: 1
diff changeset
  2072
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2073
!SmallInteger methodsFor:'modulu arithmetic'!
2
claus
parents: 1
diff changeset
  2074
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2075
plus:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2076
    "return the sum of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2077
     The argument must be another SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2078
     If the result overflows the smallInteger range, the value modulu the 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2079
     smallInteger range is returned (i.e. the low bits of the sum).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2080
     This is of course not always correct, but some code does a modulu anyway
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2081
     and can therefore speed things up by not going through LargeIntegers."
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  2082
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2083
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2084
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2085
    if (__isSmallInteger(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2086
	RETURN ( __MKSMALLINT((__intVal(self) + __intVal(aNumber)) & 0x7FFFFFFF) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2087
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2088
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2089
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2090
    self primitiveFailed
2
claus
parents: 1
diff changeset
  2091
!
claus
parents: 1
diff changeset
  2092
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2093
subtract:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2094
    "return the difference of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2095
     The argument must be another SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2096
     If the result overflows the smallInteger range, the value modulu the 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2097
     smallInteger range is returned (i.e. the low bits of the sum).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2098
     This is of course not always correct, but some code does a modulu anyway
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2099
     and can therefore speed things up by not going through LargeIntegers."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2100
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2101
%{  /* NOCONTEXT */
2
claus
parents: 1
diff changeset
  2102
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2103
    if (__isSmallInteger(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2104
	RETURN ( __MKSMALLINT((__intVal(self) - __intVal(aNumber)) & 0x7FFFFFFF) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2105
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2106
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2107
    self primitiveFailed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2108
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2109
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2110
times:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2111
    "return the product of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2112
     The argument must be another SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2113
     If the result overflows the smallInteger range, the value modulu the 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2114
     smallInteger range is returned (i.e. the low bits of the product).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2115
     This is of course not always correct, but some code does a modulu anyway
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2116
     and can therefore speed things up by not going through LargeIntegers."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2117
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2118
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2119
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2120
    if (__isSmallInteger(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2121
	RETURN ( __MKSMALLINT((__intVal(self) * __intVal(aNumber)) & 0x7FFFFFFF) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2122
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2123
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2124
    self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2125
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2126
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2127
!SmallInteger methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2128
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2129
printOn:aStream
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  2130
    "append my printstring (base 10) to aStream."
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2131
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2132
    aStream nextPutAll:(self printString)
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2133
!
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2134
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2135
printOn:aStream base:radix
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2136
    "append my printstring in any number base to aStream.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2137
     The radix argument should be between 2 and 36."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2138
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2139
    aStream nextPutAll:(self printStringRadix:radix)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2140
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2141
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2142
printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2143
    "return my printstring (base 10)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2144
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  2145
    "since printf knows pretty good how to do this,
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  2146
     here is an exception to the rule of basing printString
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  2147
     upon the printOn: method."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  2148
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2149
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2150
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2151
    char buffer[30];
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2152
    OBJ newString;
369
claus
parents: 357
diff changeset
  2153
    /*
claus
parents: 357
diff changeset
  2154
     * actually only needed on sparc: since thisContext is
claus
parents: 357
diff changeset
  2155
     * in a global register, which gets destroyed by printf,
claus
parents: 357
diff changeset
  2156
     * manually save it here - very stupid ...
claus
parents: 357
diff changeset
  2157
     */
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2158
    __BEGIN_PROTECT_REGISTERS__
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2159
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2160
    sprintf(buffer, "%d", __intVal(self));
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2161
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2162
    __END_PROTECT_REGISTERS__
369
claus
parents: 357
diff changeset
  2163
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2164
    newString = __MKSTRING(buffer COMMA_SND);
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  2165
    if (newString != nil) {
305
26b092c71935 *** empty log message ***
claus
parents: 283
diff changeset
  2166
	RETURN (newString);
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  2167
    }
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  2168
%}.
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  2169
    ^ super printString
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2170
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2171
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2172
printStringRadix:radix
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2173
    "return my printstring (optimized for bases 16, 10 and 8)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2174
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2175
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2176
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2177
    char *format = (char *)0;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2178
    char buffer[30];
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2179
    OBJ newString;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2180
252
  2181
    if (__isSmallInteger(radix)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2182
	switch (__intVal(radix)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2183
	    case 10:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2184
		format = "%d";
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2185
		break;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2186
	    case 16:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2187
		format = "%x";
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2188
		break;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2189
	    case 8:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2190
		format = "%o";
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2191
		break;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2192
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2193
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2194
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2195
    if (format) {
379
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2196
	/*
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2197
	 * actually only needed on sparc: since thisContext is
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2198
	 * in a global register, which gets destroyed by printf,
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2199
	 * manually save it here - very stupid ...
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2200
	 */
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2201
	__BEGIN_PROTECT_REGISTERS__
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2202
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2203
	sprintf(buffer, format, __intVal(self));
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2204
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2205
	__END_PROTECT_REGISTERS__
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2206
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2207
	newString = __MKSTRING(buffer COMMA_SND);
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2208
	if (newString != nil) {
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  2209
	    RETURN (newString);
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
  2210
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2211
    }
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2212
%}.
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2213
    "
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2214
     fall back for seldom used bases
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2215
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2216
    ^ super printStringRadix:radix
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2217
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2218
    "123 printStringRadix:16"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2219
    "123 printStringRadix:8"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2220
    "123 printStringRadix:2"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2221
    "123 printStringRadix:3"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2222
    "123 printStringRadix:1"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2223
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2224
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2225
printfPrintString:formatString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2226
    "non-portable, but sometimes useful.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2227
     return a printed representation of the receiver
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2228
     as specified by formatString, which is defined by the C-
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2229
     function 'printf'.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2230
     No checking for string overrun - the resulting string 
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2231
     must be shorter than 256 chars or else ...
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2232
     This method is NONSTANDARD and may be removed without notice."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2233
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2234
%{  /* STACK: 400 */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2235
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2236
    char buffer[256];
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2237
    OBJ s;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2238
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2239
    if (__isString(formatString)) {
379
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2240
	/*
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2241
	 * actually only needed on sparc: since thisContext is
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2242
	 * in a global register, which gets destroyed by printf,
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2243
	 * manually save it here - very stupid ...
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  2244
	 */
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2245
	__BEGIN_PROTECT_REGISTERS__
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2246
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2247
	sprintf(buffer, __stringVal(formatString), __intVal(self));
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2248
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2249
	__END_PROTECT_REGISTERS__
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2250
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2251
	s = __MKSTRING(buffer COMMA_SND);
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2252
	if (s != nil) {
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2253
	    RETURN (s);
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2254
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2255
    }
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  2256
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2257
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2258
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2259
    "123 printfPrintString:'%%d -> %d'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2260
    "123 printfPrintString:'%%6d -> %6d'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2261
    "123 printfPrintString:'%%x -> %x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2262
    "123 printfPrintString:'%%4x -> %4x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2263
    "123 printfPrintString:'%%04x -> %04x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2264
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2265
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2266
!SmallInteger methodsFor:'private'!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2267
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2268
sign:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2269
    "private: for protocol completeness with LargeIntegers"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2270
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2271
    |absVal|
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2272
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2273
    absVal := self abs.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2274
    aNumber < 0 ifTrue:[
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2275
	^ absVal negated
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2276
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2277
    aNumber == 0 ifTrue:[^ 0].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2278
    ^ absVal
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2279
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2280
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2281
     -4 sign:-1   
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2282
     -4 sign:0    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2283
     -4 sign:1    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2284
     -4 sign:-1   
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2285
     -4 sign:0    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2286
     -4 sign:1    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2287
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2288
! !
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  2289
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2290
!SmallInteger methodsFor:'testing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2291
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2292
between:min and:max
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2293
    "return true if the receiver is less than or equal to the argument max
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2294
     and greater than or equal to the argument min.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2295
     - reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2296
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2297
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2298
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2299
    if (__bothSmallInteger(min, max)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2300
	REGISTER INT selfVal;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2301
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2302
	selfVal = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2303
	if (selfVal < __intVal(min)) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2304
	     RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2305
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2306
	if (selfVal > __intVal(max)) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2307
	     RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2308
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2309
	RETURN ( true );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2310
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2311
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2312
    (self < min) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2313
    (self > max) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2314
    ^ true
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2315
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2316
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2317
even
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2318
    "return true, if the receiver is even"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2319
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2320
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2321
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2322
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2323
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2324
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2325
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2326
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2327
    "return true, if the receiver is less than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2328
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2329
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2330
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2331
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2332
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2333
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2334
    RETURN ( ((INT)(self) < 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2335
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2336
    RETURN ( (__intVal(self) < 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2337
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2338
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2339
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2340
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2341
odd
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2342
    "return true, if the receiver is odd"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2343
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2344
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2345
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2346
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2347
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2348
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2349
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2350
positive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2351
    "return true, if the receiver is not negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2352
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2353
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2354
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2355
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2356
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2357
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2358
    RETURN ( ((INT)(self) >= 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2359
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2360
    RETURN ( (__intVal(self) >= 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2361
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2362
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2363
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2364
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2365
sign
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2366
    "return the sign of the receiver
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2367
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2368
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2369
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2370
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2371
    INT val = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2372
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2373
    if (val < 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2374
	RETURN ( __MKSMALLINT(-1) ); 
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2375
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2376
    if (val > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2377
	RETURN ( __MKSMALLINT(1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2378
    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2379
    RETURN ( __MKSMALLINT(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2380
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2381
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2382
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2383
strictlyPositive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2384
    "return true, if the receiver is greater than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2385
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2386
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2387
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2388
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2389
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2390
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2391
    RETURN ( ((INT)(self) > 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2392
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2393
    RETURN ( (__intVal(self) > 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2394
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2395
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2396
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2397
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2398
!SmallInteger class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2399
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2400
version
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2401
    ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.78 1997-06-06 14:48:20 cg Exp $'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2402
! !