SmallInteger.st
author claus
Wed, 15 Feb 1995 11:25:20 +0100
changeset 252 cf6eef7703ad
parent 232 25fd94365f92
child 282 94f5c3a6230d
permissions -rw-r--r--
(none)
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
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    15
       classVariableNames:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    16
       poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    17
       category:'Magnitude-Numbers'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
SmallInteger comment:'
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
    21
COPYRIGHT (c) 1988 by Claus Gittinger
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
    22
	      All Rights Reserved
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
    23
252
    24
$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.21 1995-02-15 10:24:58 claus Exp $
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    25
'!
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    26
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    27
!SmallInteger class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    28
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
 COPYRIGHT (c) 1988 by Claus Gittinger
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
    32
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
version
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
"
252
    45
$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.21 1995-02-15 10:24:58 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    47
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    49
documentation
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    50
"
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
    SmallIntegers are Integers in the range of at least +/- 2^30 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    52
    (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
    53
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    54
    These are no real objects - they have no instances (not even storage !!)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    55
    and cannot be subclassed.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    56
    The reason is to save both storage and runtime by not collecting
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    57
    SmallIntegers in the system. SmallInts are marked by having the TAG_INT 
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    58
    bit set, in contrast to all other objects which do not. 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    59
    Since this knowledge is hardwired into the system (and there is no 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    60
    class-field stored with SmallIntegers) there can be no subclass of 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    61
    SmallInteger (sorry).
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    62
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    63
    If you really need this kind of thing, create a subclass of Integer,
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    64
    with an instance variable holding the value.
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    65
"
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    66
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
!SmallInteger class methodsFor:'instance creation'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
basicNew:size
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    82
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
!SmallInteger class methodsFor:'constants'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
maxBits
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    87
    "return the number of bits in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    88
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
a27a279701f8 Initial revision
claus
parents:
diff changeset
    90
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
    91
    RETURN ( _MKSMALLINT(N_INT_BITS) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
    92
%}
2
claus
parents: 1
diff changeset
    93
claus
parents: 1
diff changeset
    94
    "SmallInteger maxBits"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    95
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
a27a279701f8 Initial revision
claus
parents:
diff changeset
    97
maxBytes
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    98
    "return the number of bytes in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    99
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   100
a27a279701f8 Initial revision
claus
parents:
diff changeset
   101
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
    RETURN ( _MKSMALLINT(N_INT_BITS / 8 + 1) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
%}
2
claus
parents: 1
diff changeset
   104
claus
parents: 1
diff changeset
   105
    "SmallInteger maxBytes"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
a27a279701f8 Initial revision
claus
parents:
diff changeset
   108
minVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   109
    "return the smallest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   110
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   111
a27a279701f8 Initial revision
claus
parents:
diff changeset
   112
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
    RETURN ( _MKSMALLINT(_MIN_INT) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
%}
2
claus
parents: 1
diff changeset
   115
claus
parents: 1
diff changeset
   116
    "SmallInteger minVal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
maxVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   120
    "return the largest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   121
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   122
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
    RETURN ( _MKSMALLINT(_MAX_INT) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
%}
2
claus
parents: 1
diff changeset
   126
claus
parents: 1
diff changeset
   127
    "SmallInteger maxVal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   128
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   129
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   130
!SmallInteger class methodsFor:'queries'!
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   131
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   132
isBuiltInClass
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   133
    "this class is known by the run-time-system"
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   134
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   135
    ^ true
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   136
!
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   137
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
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   143
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   144
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   145
!SmallInteger methodsFor:'catching messages'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   146
a27a279701f8 Initial revision
claus
parents:
diff changeset
   147
basicAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   148
    "catch indexed access - report an error
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   149
     defined here since basicAt: in Object ommits the SmallInteger check."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   150
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
    self notIndexed
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
a27a279701f8 Initial revision
claus
parents:
diff changeset
   154
basicAt:index put:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   155
    "catch indexed access - report an error
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   156
     defined here since basicAt:put: in Object ommits the SmallInteger check."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    self notIndexed
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
a27a279701f8 Initial revision
claus
parents:
diff changeset
   161
size
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   162
    "return the number of indexed instvars - SmallIntegers have none."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   163
a27a279701f8 Initial revision
claus
parents:
diff changeset
   164
    ^ 0
a27a279701f8 Initial revision
claus
parents:
diff changeset
   165
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
a27a279701f8 Initial revision
claus
parents:
diff changeset
   167
basicSize
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   168
    "return the number of indexed instvars - SmallIntegers have none.
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   169
     Defined here since basicSize in Object ommits the SmallInteger check."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
a27a279701f8 Initial revision
claus
parents:
diff changeset
   171
    ^ 0
a27a279701f8 Initial revision
claus
parents:
diff changeset
   172
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
a27a279701f8 Initial revision
claus
parents:
diff changeset
   174
!SmallInteger methodsFor:'copying'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
a27a279701f8 Initial revision
claus
parents:
diff changeset
   176
shallowCopy
a27a279701f8 Initial revision
claus
parents:
diff changeset
   177
    "return a shallow copy of myself
2
claus
parents: 1
diff changeset
   178
     - reimplemented here since smallintegers are unique"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   179
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   182
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   183
simpleDeepCopy
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   184
    "return a deep copy of myself
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   185
     - reimplemented here since smallintegers are unique"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   186
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   187
    ^ self
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   188
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   189
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   190
deepCopyUsing:aDictionary
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   191
    "return a deep copy of myself
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   192
     - reimplemented here since smallintegers are unique"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   193
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   194
    ^ self
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   195
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   196
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   197
deepCopy
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
    "return a deep copy of myself
2
claus
parents: 1
diff changeset
   199
     - reimplemented here since smallintegers are unique"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   202
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   203
a27a279701f8 Initial revision
claus
parents:
diff changeset
   204
!SmallInteger methodsFor:'comparing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   205
a27a279701f8 Initial revision
claus
parents:
diff changeset
   206
= aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   207
    "return true, if the arguments value is equal to mine"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   208
a27a279701f8 Initial revision
claus
parents:
diff changeset
   209
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   210
a27a279701f8 Initial revision
claus
parents:
diff changeset
   211
    if (aNumber == self) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   212
	RETURN ( true );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   213
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   214
    if (! _isNonNilObject(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   215
	/* a smallint or nil */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   216
	RETURN ( false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   217
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   218
a27a279701f8 Initial revision
claus
parents:
diff changeset
   219
    if (_qClass(aNumber) == Float) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   220
	RETURN ( ((double)_intVal(self) == _floatVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   221
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   222
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   223
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   224
    aNumber respondsToArithmetic ifFalse:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   225
    ^ self retry:#= coercing:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   226
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   227
a27a279701f8 Initial revision
claus
parents:
diff changeset
   228
~= aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   229
    "return true, if the arguments value is not equal to mine"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   230
a27a279701f8 Initial revision
claus
parents:
diff changeset
   231
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   232
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
    if (aNumber == self) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   234
	RETURN ( false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   235
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   236
    if (! _isNonNilObject(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   237
	/* a smallint or nil */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   238
	RETURN ( true );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   239
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   240
a27a279701f8 Initial revision
claus
parents:
diff changeset
   241
    if (_qClass(aNumber) == Float) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   242
	RETURN ( ((double)_intVal(self) == _floatVal(aNumber)) ? false : true );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   243
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   244
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   245
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   246
    aNumber respondsToArithmetic ifFalse:[^ true].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   247
    ^ self retry:#~= coercing:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   248
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   249
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
< aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   251
    "return true, if the argument is greater than the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   252
a27a279701f8 Initial revision
claus
parents:
diff changeset
   253
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   254
252
   255
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   256
#ifdef POSITIVE_ADDRESSES
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   257
	RETURN ( (_intVal(self) < _intVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   258
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   259
	/* tag bit does not change ordering */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   260
	RETURN ( ((INT)self < (INT)aNumber) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   261
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   262
    }
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   263
    if (__isFloat(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   264
	RETURN ( ((double)_intVal(self) < _floatVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   265
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   266
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   267
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   268
    ^ aNumber lessFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   269
    "^ self retry:#< coercing:aNumber"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   270
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   271
a27a279701f8 Initial revision
claus
parents:
diff changeset
   272
> aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   273
    "return true, if the argument is less than the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   274
a27a279701f8 Initial revision
claus
parents:
diff changeset
   275
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   276
252
   277
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   278
#ifdef POSITIVE_ADDRESSES
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   279
	RETURN ( (_intVal(self) > _intVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   280
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   281
	/* tag bit does not change ordering */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   282
	RETURN ( ((INT)self > (INT)aNumber) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   283
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   284
    }
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   285
    if (__isFloat(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   286
	RETURN ( ((double)_intVal(self) > _floatVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   287
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   288
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   289
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   290
    ^ self retry:#> coercing:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   291
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
a27a279701f8 Initial revision
claus
parents:
diff changeset
   293
>= aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   294
    "return true, if the argument is less or equal"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   295
a27a279701f8 Initial revision
claus
parents:
diff changeset
   296
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   297
252
   298
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   299
#ifdef POSITIVE_ADDRESSES
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   300
	RETURN ( (_intVal(self) >= _intVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   301
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   302
	/* tag bit does not change ordering */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   303
	RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   304
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   305
    }
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   306
    if (__isFloat(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   307
	RETURN ( ((double)_intVal(self) >= _floatVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   308
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   309
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   310
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   311
    ^ self retry:#>= coercing:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   312
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   313
a27a279701f8 Initial revision
claus
parents:
diff changeset
   314
<= aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   315
    "return true, if the argument is greater or equal"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   316
a27a279701f8 Initial revision
claus
parents:
diff changeset
   317
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   318
252
   319
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   320
#ifdef POSITIVE_ADDRESSES
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   321
	RETURN ( (_intVal(self) <= _intVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   322
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   323
	/* tag bit does not change ordering */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   324
	RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   325
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   326
    }
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   327
    if (__isFloat(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   328
	RETURN ( ((double)_intVal(self) <= _floatVal(aNumber)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   329
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   330
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   331
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   332
    ^ self retry:#<= coercing:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   333
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   334
a27a279701f8 Initial revision
claus
parents:
diff changeset
   335
identityHash
a27a279701f8 Initial revision
claus
parents:
diff changeset
   336
    "return an integer useful for hashing on identity"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   337
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   338
    self >= 0 ifTrue:[^ self].
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   339
    ^ self negated
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   340
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   341
a27a279701f8 Initial revision
claus
parents:
diff changeset
   342
min:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   343
    "return the receiver or the argument, whichever is smaller"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   344
a27a279701f8 Initial revision
claus
parents:
diff changeset
   345
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   346
252
   347
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   348
#ifdef POSITIVE_ADDRESSES
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   349
	if (_intVal(self) < _intVal(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   350
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   351
	/* tag bit does not change ordering */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   352
	if ((INT)(self) < (INT)(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   353
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   354
	    RETURN ( self );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   355
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   356
	RETURN ( aNumber );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   357
    }
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   358
    if (__isFloat(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   359
	if ( (double)_intVal(self) < _floatVal(aNumber) ) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   360
	    RETURN ( self );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   361
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   362
	RETURN ( aNumber );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   363
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   364
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   365
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   366
    (self < aNumber) ifTrue:[^ self].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   367
    ^ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   368
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   369
a27a279701f8 Initial revision
claus
parents:
diff changeset
   370
max:aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   371
    "return the receiver or the argument, whichever is greater"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   372
a27a279701f8 Initial revision
claus
parents:
diff changeset
   373
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
252
   375
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   376
#ifdef POSITIVE_ADDRESSES
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   377
	if (_intVal(self) > _intVal(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   378
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   379
	/* tag bit does not change ordering */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   380
	if ((INT)(self) > (INT)(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   381
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   382
	    RETURN ( self );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   383
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   384
	RETURN ( aNumber );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   385
    }
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   386
    if (__isFloat(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   387
	if ( (double)_intVal(self) > _floatVal(aNumber) ) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   388
	    RETURN ( self );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   389
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   390
	RETURN ( aNumber );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   391
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   392
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   393
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   394
    (self > aNumber) ifTrue:[^ self].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   395
    ^ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   396
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   397
a27a279701f8 Initial revision
claus
parents:
diff changeset
   398
!SmallInteger methodsFor:'testing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   399
a27a279701f8 Initial revision
claus
parents:
diff changeset
   400
negative
a27a279701f8 Initial revision
claus
parents:
diff changeset
   401
    "return true, if the receiver is less than zero
a27a279701f8 Initial revision
claus
parents:
diff changeset
   402
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   403
a27a279701f8 Initial revision
claus
parents:
diff changeset
   404
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   405
a27a279701f8 Initial revision
claus
parents:
diff changeset
   406
#ifdef POSITIVE_ADDRESSES
a27a279701f8 Initial revision
claus
parents:
diff changeset
   407
    RETURN ( (_intVal(self) < 0) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   408
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
   409
    /* tag bit does not change sign */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   410
    RETURN ( ((INT)(self) < 0) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   411
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   412
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   413
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   414
a27a279701f8 Initial revision
claus
parents:
diff changeset
   415
positive
a27a279701f8 Initial revision
claus
parents:
diff changeset
   416
    "return true, if the receiver is not negative
a27a279701f8 Initial revision
claus
parents:
diff changeset
   417
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   418
a27a279701f8 Initial revision
claus
parents:
diff changeset
   419
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   420
a27a279701f8 Initial revision
claus
parents:
diff changeset
   421
#ifdef POSITIVE_ADDRESSES
a27a279701f8 Initial revision
claus
parents:
diff changeset
   422
    RETURN ( (_intVal(self) >= 0) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   423
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
   424
    /* tag bit does not change sign */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   425
    RETURN ( ((INT)(self) >= 0) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   426
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   427
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   428
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   429
a27a279701f8 Initial revision
claus
parents:
diff changeset
   430
strictlyPositive
a27a279701f8 Initial revision
claus
parents:
diff changeset
   431
    "return true, if the receiver is greater than zero
a27a279701f8 Initial revision
claus
parents:
diff changeset
   432
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   433
a27a279701f8 Initial revision
claus
parents:
diff changeset
   434
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   435
a27a279701f8 Initial revision
claus
parents:
diff changeset
   436
#ifdef POSITIVE_ADDRESSES
a27a279701f8 Initial revision
claus
parents:
diff changeset
   437
    RETURN ( (_intVal(self) > 0) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   438
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
   439
    /* tag bit does not change sign */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   440
    RETURN ( ((INT)(self) > 0) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   441
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   442
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   443
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   444
a27a279701f8 Initial revision
claus
parents:
diff changeset
   445
sign
a27a279701f8 Initial revision
claus
parents:
diff changeset
   446
    "return the sign of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   447
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   448
a27a279701f8 Initial revision
claus
parents:
diff changeset
   449
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   450
a27a279701f8 Initial revision
claus
parents:
diff changeset
   451
    INT val = _intVal(self);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   452
a27a279701f8 Initial revision
claus
parents:
diff changeset
   453
    if (val < 0) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   454
	RETURN ( _MKSMALLINT(-1) ); 
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   455
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   456
    if (val > 0) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   457
	RETURN ( _MKSMALLINT(1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   458
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   459
    RETURN ( _MKSMALLINT(0) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   460
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   461
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   462
a27a279701f8 Initial revision
claus
parents:
diff changeset
   463
between:min and:max
a27a279701f8 Initial revision
claus
parents:
diff changeset
   464
    "return true if the receiver is less than or equal to the argument max
a27a279701f8 Initial revision
claus
parents:
diff changeset
   465
     and greater than or equal to the argument min.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   466
     - reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   467
a27a279701f8 Initial revision
claus
parents:
diff changeset
   468
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   469
252
   470
    if (__bothSmallInteger(min, max)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   471
	REGISTER INT selfVal;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   472
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   473
	selfVal = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   474
	if (selfVal < _intVal(min)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   475
	     RETURN ( false );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   476
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   477
	if (selfVal > _intVal(max)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   478
	     RETURN ( false );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   479
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   480
	RETURN ( true );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   481
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   482
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   483
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   484
    (self < min) ifTrue:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   485
    (self > max) ifTrue:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   486
    ^ true
a27a279701f8 Initial revision
claus
parents:
diff changeset
   487
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   488
a27a279701f8 Initial revision
claus
parents:
diff changeset
   489
even
a27a279701f8 Initial revision
claus
parents:
diff changeset
   490
    "return true, if the receiver is even"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   491
a27a279701f8 Initial revision
claus
parents:
diff changeset
   492
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   493
a27a279701f8 Initial revision
claus
parents:
diff changeset
   494
#ifdef POSITIVE_ADDRESSES
a27a279701f8 Initial revision
claus
parents:
diff changeset
   495
    RETURN ( ((INT)self & 1) ? false : true );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   496
#else    
a27a279701f8 Initial revision
claus
parents:
diff changeset
   497
    RETURN ( ((INT)self & ((INT)_MKSMALLINT(1) & ~TAG_INT)) ? false : true );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   498
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   499
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   500
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   501
a27a279701f8 Initial revision
claus
parents:
diff changeset
   502
odd
a27a279701f8 Initial revision
claus
parents:
diff changeset
   503
    "return true, if the receiver is odd"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   504
a27a279701f8 Initial revision
claus
parents:
diff changeset
   505
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   506
a27a279701f8 Initial revision
claus
parents:
diff changeset
   507
#ifdef POSITIVE_ADDRESSES
a27a279701f8 Initial revision
claus
parents:
diff changeset
   508
    RETURN ( ((INT)self & 1) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   509
#else    
a27a279701f8 Initial revision
claus
parents:
diff changeset
   510
    RETURN ( ((INT)self & ((INT)_MKSMALLINT(1) & ~TAG_INT)) ? true : false );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   511
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   512
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   513
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   514
a27a279701f8 Initial revision
claus
parents:
diff changeset
   515
!SmallInteger methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   516
a27a279701f8 Initial revision
claus
parents:
diff changeset
   517
+ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   518
    "return the sum of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   519
a27a279701f8 Initial revision
claus
parents:
diff changeset
   520
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   521
252
   522
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   523
#ifdef _ADD_IO_IO
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   524
	RETURN ( _ADD_IO_IO(self, aNumber) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   525
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   526
	REGISTER INT sum;
232
25fd94365f92 makeLarge rename
claus
parents: 216
diff changeset
   527
	extern OBJ _MKLARGEINT();
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   528
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   529
	sum =  _intVal(self) + _intVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   530
	if ((sum >= _MIN_INT) && (sum <= _MAX_INT)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   531
	    RETURN ( _MKSMALLINT(sum) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   532
	}
232
25fd94365f92 makeLarge rename
claus
parents: 216
diff changeset
   533
	RETURN ( _MKLARGEINT(sum) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   534
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   535
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   536
    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   537
	OBJ newFloat;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   538
	double val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   539
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   540
	val = _floatVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   541
	_qMKFLOAT(newFloat, (double)(_intVal(self)) + val, SENDER);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   542
	RETURN ( newFloat );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   543
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   544
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   545
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   546
    ^ aNumber sumFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   547
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   548
a27a279701f8 Initial revision
claus
parents:
diff changeset
   549
- aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   550
    "return the difference of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   551
a27a279701f8 Initial revision
claus
parents:
diff changeset
   552
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   553
252
   554
    if (__isSmallInteger(aNumber)) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   555
#ifdef _SUB_IO_IO
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   556
	RETURN ( _SUB_IO_IO(self, aNumber) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   557
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   558
	REGISTER INT diff;
232
25fd94365f92 makeLarge rename
claus
parents: 216
diff changeset
   559
	extern OBJ _MKLARGEINT();
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   560
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   561
	diff =  _intVal(self) - _intVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   562
	if ((diff >= _MIN_INT) && (diff <= _MAX_INT)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   563
	    RETURN ( _MKSMALLINT(diff) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   564
	}
232
25fd94365f92 makeLarge rename
claus
parents: 216
diff changeset
   565
	RETURN ( _MKLARGEINT(diff) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   566
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
   567
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   568
    if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   569
	OBJ newFloat;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   570
	double val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   571
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   572
	val = _floatVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   573
	_qMKFLOAT(newFloat, (double)(_intVal(self)) - val, SENDER);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   574
	RETURN ( newFloat );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   575
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   576
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   577
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   578
    ^ aNumber differenceFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   579
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   580
a27a279701f8 Initial revision
claus
parents:
diff changeset
   581
* aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   582
    "return the product of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   583
a27a279701f8 Initial revision
claus
parents:
diff changeset
   584
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   585
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   586
    INT myValue, otherValue;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   587
    unsigned INT productLow, productHi;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   588
    int negative;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   589
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   590
#   define lowBits(foo)  ((foo) & 0xFFFF)
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   591
#   define hiBits(foo)   ((foo) >> 16)
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   592
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   593
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   594
     * can we use long long arithmetic ?
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   595
     */
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   596
#if defined(__GNUC__) && (__GNUC__ >= 2)
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   597
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   598
     * commented, since long-long arithmetic seems to
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   599
     * be buggy in some implementations (sparc) ...
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   600
     * (took me a while to find this out :-(
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   601
     */
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   602
# ifdef NOTDEF
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   603
#   define _LONGLONG
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   604
# endif
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   605
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   606
252
   607
    if (__isSmallInteger(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   608
	myValue = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   609
	otherValue = _intVal(aNumber);
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   610
#if defined(_LONGLONG)
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   611
	{
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   612
	    long long product;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   613
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   614
	    product = (long long)myValue * (long long)otherValue;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   615
	    if ((product >= (long long)_MIN_INT) 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   616
	     && (product <= (long long)_MAX_INT)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   617
		RETURN ( _MKSMALLINT((int)product) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   618
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   619
	    if (product < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   620
		negative = 1;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   621
		product = -product;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   622
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   623
		negative = 0;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   624
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   625
	    productHi = product >> 32;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   626
	    productLow = product & 0xFFFFFFFF;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   627
	}
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   628
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   629
	negative = 0;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   630
	if (myValue < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   631
	    negative = 1;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   632
	    myValue = -myValue;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   633
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   634
	if (otherValue < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   635
	    negative = (1 - negative);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   636
	    otherValue = -otherValue;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   637
	}
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   638
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   639
# if defined(__GNUC__) && defined(mc68k)
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   640
	asm ("mulu%.l %3,%1:%0"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   641
		: "=d"  ((unsigned long)(productLow)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   642
		  "=d"  ((unsigned long)(productHi))
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   643
		: "%0"  ((unsigned long)(myValue)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   644
		  "dmi" ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   645
# else
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   646
#  if defined (__GNUC__) && defined(i386)
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   647
	asm ("mull %3"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   648
		: "=a"  ((unsigned long)(productLow)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   649
		  "=d"  ((unsigned long)(productHi))
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   650
		: "%0"  ((unsigned long)(myValue)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   651
		  "rm"  ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   652
#  else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   653
	{
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   654
	    unsigned INT pHH, pHL, pLH, pLL;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   655
	    unsigned INT low1, low2, hi1, hi2;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   656
	    unsigned INT t;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   657
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   658
	    /* unsigned multiply myValue * otherValue -> productHi, productLow
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   659
	     *
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   660
	     * this is too slow:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   661
	     * since most machines can do 32*32 to 64 bit multiply,
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   662
	     * (or at least 32*32 with Overflow check)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   663
	     * - need more assembler (inline) functions here 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   664
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   665
	    low1 = lowBits(myValue);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   666
	    hi1 = hiBits(myValue);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   667
	    low2 = lowBits(otherValue);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   668
	    hi2 = hiBits(otherValue);
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   669
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   670
	    pLH = low1 * hi2;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   671
	    pHL = hi1 * low2;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   672
	    pLL = low1 * low2;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   673
        
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   674
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   675
	     * the common case ...
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   676
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   677
	    if ((pHL == 0)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   678
	     && (pLH == 0)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   679
	     && ((pLL & 0xC0000000) == 0)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   680
		if (negative) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   681
		    RETURN ( _MKSMALLINT(- ((INT)pLL)) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   682
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   683
		RETURN ( _MKSMALLINT((INT)pLL) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   684
	    }
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   685
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   686
	    pHH = hi1 * hi2;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   687
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   688
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   689
	     *   pHH |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   690
	     *   pLH          |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   691
	     *   pHL          |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   692
	     *   pLL                   |--------|--------|
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   693
	     */
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   694
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   695
	    t = lowBits(pLH) + lowBits(pHL) + hiBits(pLL);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   696
	    productLow = (t << 16) + lowBits(pLL);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   697
	    productHi = pHH + hiBits(t) + hiBits(pHL) + hiBits(pLH);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   698
	}
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   699
#  endif
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   700
# endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   701
	if (productHi == 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   702
	    if (negative) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   703
		if (productLow <= -(_MIN_INT)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   704
		    RETURN ( _MKSMALLINT(-((INT)productLow)) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   705
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   706
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   707
		if (productLow <= _MAX_INT) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   708
		    RETURN ( _MKSMALLINT(productLow) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   709
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   710
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   711
	}
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   712
#endif
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   713
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   714
	{
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   715
	    extern OBJ LargeInteger;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   716
	    static struct inlineCache val = _ILC5;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   717
	    OBJ aLarge;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   718
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   719
	    aLarge = (*val.ilc_func)(LargeInteger, 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   720
				     @symbol(sign:value16:value16:value16:value16:),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   721
				     CON_COMMA nil, &val, 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   722
				     negative ? _MKSMALLINT(-1) : _MKSMALLINT(1),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   723
				     _MKSMALLINT(lowBits(productLow)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   724
				     _MKSMALLINT(hiBits(productLow)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   725
				     _MKSMALLINT(lowBits(productHi)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   726
				     _MKSMALLINT(hiBits(productHi)) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   727
	    RETURN(aLarge);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   728
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   729
    } else if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   730
	OBJ newFloat;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   731
	double val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   732
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   733
	val = _floatVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   734
	_qMKFLOAT(newFloat, (double)(_intVal(self)) * val, SENDER);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   735
	RETURN ( newFloat );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   736
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   737
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   738
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   739
    ^ aNumber productFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   740
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   741
a27a279701f8 Initial revision
claus
parents:
diff changeset
   742
/ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   743
    "return the quotient of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   744
a27a279701f8 Initial revision
claus
parents:
diff changeset
   745
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   746
a27a279701f8 Initial revision
claus
parents:
diff changeset
   747
    INT me, t, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   748
    double dval;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   749
252
   750
    if (__isSmallInteger(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   751
	val = _intVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   752
	if (val != 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   753
	    me = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   754
	    t = me / val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   755
#ifdef GOOD_OPTIMIZER
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   756
	    if (me % val) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   757
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   758
	    /* this is stupid - all I want is to look for a remainder ... 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   759
	       but most compilers are too stupid and generate an extra modulu
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   760
	       instruction for "if (me % val)".
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   761
	       Even if most divide instructions already leave the remainder in
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   762
	       some register.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   763
	       Therefore I use a multiplication which is faster than a modulu
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   764
	       on most machines. Hint to GNU people :-)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   765
	    */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   766
	    if ((t * val) == me) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   767
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   768
		RETURN ( _MKSMALLINT(t) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   769
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   770
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   771
    } else {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   772
	if (__isFloat(aNumber)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   773
	    dval = _floatVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   774
	    if (dval != 0.0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   775
		OBJ newFloat;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   776
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   777
		me = _intVal(self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   778
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   779
		_qMKFLOAT(newFloat, (double)me / dval, SENDER);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   780
		RETURN ( newFloat );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   781
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   782
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   783
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   784
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   785
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   786
    aNumber isInteger ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   787
	aNumber = 0 ifTrue:[
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   788
	    ^ DivisionByZeroSignal raise.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   789
	].
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   790
	^ Fraction numerator:self denominator:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   791
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   792
    ^ aNumber quotientFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   793
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   794
2
claus
parents: 1
diff changeset
   795
// aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   796
    "return the integer part of the quotient of the receivers value
a27a279701f8 Initial revision
claus
parents:
diff changeset
   797
     and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   798
a27a279701f8 Initial revision
claus
parents:
diff changeset
   799
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   800
    INT val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   801
252
   802
    if (__isSmallInteger(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   803
	val = _intVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   804
	if (val != 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   805
	    RETURN ( _MKSMALLINT(_intVal(self) / val) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   806
	}
2
claus
parents: 1
diff changeset
   807
    } else {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   808
	if (__isFraction(aNumber)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   809
	    OBJ t;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   810
	    INT num, den;
2
claus
parents: 1
diff changeset
   811
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   812
	    t = _FractionInstPtr(aNumber)->f_numerator;
252
   813
	    if (__isSmallInteger(t)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   814
		num = _intVal(t);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   815
		t = _FractionInstPtr(aNumber)->f_denominator;
252
   816
		if (__isSmallInteger(t)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   817
		    den = _intVal(t);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   818
		    RETURN ( _MKSMALLINT(_intVal(self) * den / num ));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   819
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   820
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   821
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   822
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   823
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   824
.
2
claus
parents: 1
diff changeset
   825
    (aNumber = 0) ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   826
	^ DivisionByZeroSignal raise.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   827
    ].
2
claus
parents: 1
diff changeset
   828
    ^ self retry:#// coercing:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   829
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   830
2
claus
parents: 1
diff changeset
   831
\\ aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   832
    "return the integer rest of the receivers value
a27a279701f8 Initial revision
claus
parents:
diff changeset
   833
     divided by the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   834
a27a279701f8 Initial revision
claus
parents:
diff changeset
   835
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   836
    INT mySelf, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   837
252
   838
    if (__isSmallInteger(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   839
	mySelf = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   840
	if (mySelf < 0) mySelf = -mySelf;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   841
	val = _intVal(aNumber);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   842
	if (val != 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   843
	    if (val < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   844
		RETURN ( _MKSMALLINT(-(mySelf % -val)) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   845
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   846
	    RETURN ( _MKSMALLINT(mySelf % val) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   847
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   848
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   849
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   850
.
2
claus
parents: 1
diff changeset
   851
    (aNumber = 0) ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   852
	^ DivisionByZeroSignal raise.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   853
    ].
2
claus
parents: 1
diff changeset
   854
    ^ self retry:#\\ coercing:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   855
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   856
a27a279701f8 Initial revision
claus
parents:
diff changeset
   857
abs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   858
    "return the absolute value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   859
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   860
a27a279701f8 Initial revision
claus
parents:
diff changeset
   861
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   862
a27a279701f8 Initial revision
claus
parents:
diff changeset
   863
    INT val = _intVal(self);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   864
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   865
    if (val >= 0) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   866
	RETURN (self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   867
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   868
    if (val != _MIN_INT) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   869
	RETURN ( _MKSMALLINT(-val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   870
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   871
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   872
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   873
    "only reached for minVal"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   874
    ^ self negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   875
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   876
a27a279701f8 Initial revision
claus
parents:
diff changeset
   877
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   878
    "return the negative value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   879
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   880
a27a279701f8 Initial revision
claus
parents:
diff changeset
   881
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   882
a27a279701f8 Initial revision
claus
parents:
diff changeset
   883
    INT val = _intVal(self);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   884
a27a279701f8 Initial revision
claus
parents:
diff changeset
   885
    if (val != _MIN_INT) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   886
	RETURN ( _MKSMALLINT(- val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   887
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   888
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   889
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   890
    ^ (LargeInteger value:(SmallInteger maxVal)) + 1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   891
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   892
a27a279701f8 Initial revision
claus
parents:
diff changeset
   893
!SmallInteger methodsFor:'modulu arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   894
a27a279701f8 Initial revision
claus
parents:
diff changeset
   895
times:aNumber
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   896
    "return the product of the receiver and the argument, as SmallInteger.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   897
     The argument must be another SmallInteger.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   898
     If the result overflows the smallInteger range, the value modulu the 
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   899
     smallInteger range is returned (i.e. the low bits of the product).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   900
     This is of course not always correct, but some code does a modulu anyway
a27a279701f8 Initial revision
claus
parents:
diff changeset
   901
     and can therefore speed things up by not going through LargeIntegers."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   902
a27a279701f8 Initial revision
claus
parents:
diff changeset
   903
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   904
252
   905
    if (__isSmallInteger(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   906
	RETURN ( _MKSMALLINT((_intVal(self) * _intVal(aNumber)) & 0x7FFFFFFF) );
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
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   910
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
   911
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   912
a27a279701f8 Initial revision
claus
parents:
diff changeset
   913
plus:aNumber
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   914
    "return the sum of the receiver and the argument, as SmallInteger.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   915
     The argument must be another SmallInteger.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   916
     If the result overflows the smallInteger range, the value modulu the 
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   917
     smallInteger range is returned (i.e. the low bits of the sum).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   918
     This is of course not always correct, but some code does a modulu anyway
a27a279701f8 Initial revision
claus
parents:
diff changeset
   919
     and can therefore speed things up by not going through LargeIntegers."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   920
a27a279701f8 Initial revision
claus
parents:
diff changeset
   921
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   922
252
   923
    if (__isSmallInteger(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   924
	RETURN ( _MKSMALLINT((_intVal(self) + _intVal(aNumber)) & 0x7FFFFFFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   925
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   926
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   927
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   928
    self primitiveFailed
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   929
! 
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   930
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   931
subtract:aNumber
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   932
    "return the difference of the receiver and the argument, as SmallInteger.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   933
     The argument must be another SmallInteger.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   934
     If the result overflows the smallInteger range, the value modulu the 
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   935
     smallInteger range is returned (i.e. the low bits of the sum).
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   936
     This is of course not always correct, but some code does a modulu anyway
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   937
     and can therefore speed things up by not going through LargeIntegers."
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   938
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   939
%{  /* NOCONTEXT */
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   940
252
   941
    if (__isSmallInteger(aNumber)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   942
	RETURN ( _MKSMALLINT((_intVal(self) - _intVal(aNumber)) & 0x7FFFFFFF) );
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   943
    }
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   944
%}
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   945
.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   946
    self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   947
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   948
a27a279701f8 Initial revision
claus
parents:
diff changeset
   949
!SmallInteger class methodsFor:'bit mask constants'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   950
a27a279701f8 Initial revision
claus
parents:
diff changeset
   951
bitMaskFor:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   952
    "return a bitmask for the index's bit (index starts at 1)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   953
a27a279701f8 Initial revision
claus
parents:
diff changeset
   954
    (index between:1 and:SmallInteger maxBits) ifFalse:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   955
	^ self error:'index out of bounds'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   956
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   957
    ^ 1 bitShift:(index - 1)
a27a279701f8 Initial revision
claus
parents:
diff changeset
   958
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   959
a27a279701f8 Initial revision
claus
parents:
diff changeset
   960
!SmallInteger methodsFor:'bit operators'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   961
a27a279701f8 Initial revision
claus
parents:
diff changeset
   962
bitAt:index
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   963
    "return the value of the index's bit (index starts at 1).
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   964
     Notice: the result of bitAt: on negative receivers is not 
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   965
	     defined in the language standard (since the implementation
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   966
	     is free to choose any internal representation for integers)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   967
a27a279701f8 Initial revision
claus
parents:
diff changeset
   968
    |mask|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   969
a27a279701f8 Initial revision
claus
parents:
diff changeset
   970
    (index between:1 and:SmallInteger maxBits) ifFalse:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
   971
	^ self error:'index out of bounds'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   972
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   973
    mask := 1 bitShift:(index - 1).
a27a279701f8 Initial revision
claus
parents:
diff changeset
   974
    ((self bitAnd:mask) == 0) ifTrue:[^ 0].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   975
    ^ 1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   976
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   977
a27a279701f8 Initial revision
claus
parents:
diff changeset
   978
allMask:anInteger
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   979
    "return true if all 1-bits in anInteger are also 1 in the receiver"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   980
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   981
    ^ (self bitAnd:anInteger) == anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   982
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   983
    "2r00001111 allMask:2r00000001"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   984
    "2r00001111 allMask:2r00011110"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   985
    "2r00001111 allMask:2r00000000"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   986
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   987
a27a279701f8 Initial revision
claus
parents:
diff changeset
   988
anyMask:anInteger
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   989
    "return true if any 1-bits in anInteger is also 1 in the receiver.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   990
     (somewhat incorrect, if the mask is zero)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   991
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   992
    ^ (self bitAnd:anInteger) ~~ 0
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   993
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   994
    "2r00001111 anyMask:2r00000001"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   995
    "2r00001111 anyMask:2r11110000"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   996
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   997
a27a279701f8 Initial revision
claus
parents:
diff changeset
   998
noMask:anInteger
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   999
    "return true if no 1-bit in anInteger is 1 in the receiver"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1000
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1001
    ^ (self bitAnd:anInteger) == 0
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1002
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1003
    "2r00001111 noMask:2r00000001"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1004
    "2r00001111 noMask:2r11110000"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1005
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1006
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1007
highBit
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1008
    "return the bitIndex of the highest bit set. The returned bitIndex
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1009
     starts at 1 for the least significant bit. Returns -1 if no bit is set."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1010
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1011
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1012
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1013
    INT mask, index, bits;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1014
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1015
    bits = _intVal(self);
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1016
    if (bits == 0) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1017
	RETURN ( _MKSMALLINT(-1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1018
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1019
#ifdef alpha
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1020
    mask = 0x2000000000000000;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1021
    index = 62;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1022
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1023
    mask = 0x20000000;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1024
    index = 30;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1025
#endif
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1026
    while (index) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1027
	if (bits & mask) break;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1028
	mask = mask >> 1;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1029
	index--;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1030
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1031
    RETURN ( _MKSMALLINT(index) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1032
%}
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1033
    "2r000100 highBit"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1034
    "2r010100 highBit"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1035
    "2r000001 highBit"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1036
    "0 highBit"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1037
    "SmallInteger maxVal highBit"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1038
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1039
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1040
lowBit
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1041
    "return the bitIndex of the lowest bit set. The returned bitIndex
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1042
     starts at 1 for the least significant bit. Returns -1 if no bit is set."
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1043
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1044
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1045
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1046
    INT mask, index, bits;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1047
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1048
    bits = _intVal(self);
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1049
    if (bits == 0) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1050
	RETURN ( _MKSMALLINT(-1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1051
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1052
    mask = 1;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1053
    index = 1;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1054
#ifdef alpha
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1055
    while (index != 63) {
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1056
#else
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1057
    while (index != 31) {
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1058
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1059
	if (bits & mask) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1060
	    RETURN ( _MKSMALLINT(index) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1061
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1062
	mask = mask << 1;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1063
	index++;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1064
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1065
    RETURN ( _MKSMALLINT(-1) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1066
%}
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1067
    "2r000100 lowBit"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1068
    "2r010010 lowBit"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1069
    "2r100001 lowBit"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1070
    "0 lowBit"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1071
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1072
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1073
bitShift:shiftCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1074
    "return the value of the receiver shifted by shiftCount bits;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1075
     leftShift if shiftCount > 0; rightShift otherwise.
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1076
     Notice: the result of bitShift: on negative receivers is not 
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1077
	     defined in the language standard (since the implementation
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1078
	     is free to choose any internal representation for integers)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1079
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1080
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1081
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1082
    INT bits, count;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1083
252
  1084
    if (__isSmallInteger(shiftCount)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1085
	count = _intVal(shiftCount);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1086
	bits = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1087
	if (count > 0) {
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1088
#if defined(_LONGLONG)
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1089
	    unsigned long long result;
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1090
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1091
	    result = bits;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1092
	    if (count <= N_INT_BITS) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1093
		result <<= count;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1094
		if (result <= _MAX_INT) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1095
		    RETURN ( _MKSMALLINT(result) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1096
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1097
		{
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1098
		    extern OBJ LargeInteger;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1099
		    static struct inlineCache val = _ILC5;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1100
		    OBJ aLarge;
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1101
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1102
		    aLarge = (*val.ilc_func)(LargeInteger,
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1103
				     @symbol(sign:value16:value16:value16:value16:),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1104
				     CON_COMMA nil, &val,
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1105
				     _MKSMALLINT(1),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1106
				     _MKSMALLINT(lowBits(result)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1107
				     _MKSMALLINT(hiBits(result)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1108
				     _MKSMALLINT(lowBits(result >> 32)),
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1109
				     _MKSMALLINT(hiBits(result >> 32)) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1110
		    RETURN(aLarge);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1111
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1112
	    }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1113
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1114
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1115
	     * check for overflow
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1116
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1117
	    if (count < (N_INT_BITS-1)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1118
		if (! (bits >> (N_INT_BITS - 1 - count))) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1119
		    RETURN ( _MKSMALLINT(bits << count) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1120
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1121
		/*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1122
		 * so, there is an overflow ...
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1123
		 * handle it as largeInteger
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1124
		 */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1125
		/* FALL THROUGH */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1126
	    }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1127
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1128
	} else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1129
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1130
	     * right shifts cannot overflow
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1131
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1132
	    if (count < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1133
		/*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1134
		 * some machines ignore shifts bigger than
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1135
		 * the number of bits in an int ...
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1136
		 */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1137
		if (count < (-N_INT_BITS-1))
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1138
		    RETURN (_MKSMALLINT(0));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1139
		RETURN ( _MKSMALLINT(bits >> -count) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1140
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1141
	    RETURN (self );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1142
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1143
    }
85
claus
parents: 77
diff changeset
  1144
%}.
claus
parents: 77
diff changeset
  1145
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1146
	^ (LargeInteger value:self) bitShift:shiftCount
85
claus
parents: 77
diff changeset
  1147
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1148
    ^ self bitShift:(shiftCount coerce:1)
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1149
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1150
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1151
bitOr:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1152
    "return the bitwise-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1153
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1154
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1155
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1156
    /* oring the tags doesn't change it */
252
  1157
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1158
	RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1159
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1160
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1161
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1162
    ^ self retry:#bitOr coercing:anInteger
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1163
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1164
    "(2r000000100 bitOr:2r00000011) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1165
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1166
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1167
bitAnd:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1168
    "return the bitwise-and of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1169
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1170
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1171
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1172
    /* anding the tags doesn't change it */
252
  1173
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1174
	RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1175
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1176
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1177
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1178
    ^ self retry:#bitAnd coercing:anInteger
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1179
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1180
    "(2r001010100 bitAnd:2r00001111) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1181
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1182
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1183
bitXor:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1184
    "return the bitwise-exclusive-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1185
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1186
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1187
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1188
    /* xoring the tags turns it off - or it in again */
252
  1189
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1190
	RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1191
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1192
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1193
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1194
    ^ self retry:#bitXor coercing:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1195
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1196
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1197
bitInvert
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1198
    "return the value of the receiver with all bits inverted"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1199
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1200
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1201
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1202
    /* invert anything except tag bits */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1203
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1204
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1205
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1206
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1207
bitTest:aMask
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1208
    "return true, if any bit from aMask is set in the receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1209
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1210
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1211
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1212
    /* and all bits except tag */
252
  1213
    if (__isSmallInteger(aMask)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1214
	RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1215
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1216
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1217
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1218
    ^ self retry:#bitTest coercing:aMask
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1219
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1220
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1221
!SmallInteger methodsFor:'byte access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1222
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1223
digitLength
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1224
    "return the number bytes used by this Integer"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1225
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1226
    ^ self abs highBit - 1 // 8 + 1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1227
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1228
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1229
digitAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1230
    "return 8 bits of value, starting at byte index"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1231
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1232
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1233
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1234
    INT val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1235
252
  1236
    if (__isSmallInteger(index)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1237
	val = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1238
	if (val < 0)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1239
	    val = -val;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1240
	switch (_intVal(index)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1241
	    case 1:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1242
		RETURN ( _MKSMALLINT( val & 0xFF) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1243
	    case 2:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1244
		RETURN ( _MKSMALLINT( (val >> 8) & 0xFF) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1245
	    case 3:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1246
		RETURN ( _MKSMALLINT( (val >> 16) & 0xFF) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1247
	    case 4:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1248
		RETURN ( _MKSMALLINT( (val >> 24) & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1249
#ifdef alpha
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1250
	    case 5:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1251
		RETURN ( _MKSMALLINT( (val >> 32) & 0xFF) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1252
	    case 6:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1253
		RETURN ( _MKSMALLINT( (val >> 40) & 0xFF) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1254
	    case 7:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1255
		RETURN ( _MKSMALLINT( (val >> 48) & 0xFF) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1256
	    case 8:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1257
		RETURN ( _MKSMALLINT( (val >> 56) & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1258
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1259
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1260
    }
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1261
%}.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1262
    index > 0 ifFalse:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1263
	self primitiveFailed
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1264
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1265
    ^ 0
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1266
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1267
    "(16r12345678 digitAt:1) printStringRadix:16"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1268
    "(16r12345678 digitAt:3) printStringRadix:16"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1269
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1270
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1271
!SmallInteger methodsFor:'misc math'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1272
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1273
gcd:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1274
    "return the greatest common divisor (Euclid's algorithm).
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1275
     This has been redefined here for more speed since due to the
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1276
     use of gcd in Fraction code, it has become time-critical for
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
     some code. (thanx to MessageTally)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1278
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1279
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1280
252
  1281
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1282
	INT orgArg, ttt, selfInt, temp;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1283
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1284
	ttt = orgArg = _intVal(anInteger);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1285
	if (ttt) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1286
	    selfInt = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1287
	    while (ttt != 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1288
		temp = selfInt % ttt;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1289
		selfInt = ttt;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1290
		ttt = temp;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1291
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1292
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1293
	     * since its not defined in what the sign of
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1294
	     * a modulu result is when the arg is negative,
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1295
	     * change it explicitely here ...
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1296
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1297
	    if (orgArg < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1298
		/* result should be negative */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1299
		if (selfInt > 0) selfInt = -selfInt;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1300
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1301
		/* result should be positive */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1302
		if (selfInt < 0) selfInt = -selfInt;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1303
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1304
	    RETURN ( _MKSMALLINT(selfInt) );
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1305
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1306
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1307
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1308
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1309
    ^ super gcd:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1310
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1311
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1312
intlog10
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1313
    "return the truncation of log10 of the receiver -
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1314
     stupid implementation; used to find out the number of digits needed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1315
     to print a number/and for conversion to a LargeInteger"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1316
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1317
    self <= 0 ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1318
	self error:'logarithm of negative integer'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1319
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1320
    self < 10 ifTrue:[^ 1].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1321
    self < 100 ifTrue:[^ 2].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1322
    self < 1000 ifTrue:[^ 3].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1323
    self < 10000 ifTrue:[^ 4].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1324
    self < 100000 ifTrue:[^ 5].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1325
    self < 1000000 ifTrue:[^ 6].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1326
    self < 10000000 ifTrue:[^ 7].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1327
    self < 100000000 ifTrue:[^ 8].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1328
    self < 1000000000 ifTrue:[^ 9].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1329
    ^ 10
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1330
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1331
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1332
!SmallInteger methodsFor:'coercing and converting'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1333
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1334
coerce:aNumber
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1335
    "return aNumber converted into receivers type"
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1336
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1337
    ^ aNumber asInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1338
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1339
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1340
generality
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1341
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1342
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1343
    ^ 20
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1344
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1345
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1346
asFloat
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1347
    "return a Float with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1348
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1349
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1350
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1351
    OBJ newFloat;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1352
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1353
    _qMKFLOAT(newFloat, (double)_intVal(self), SENDER);
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1354
/*
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1355
    _qNew(newFloat, sizeof(struct floatstruct), SENDER);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1356
    _InstPtr(newFloat)->o_class = Float;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1357
    _FloatInstPtr(newFloat)->f_floatvalue = _intVal(self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1358
*/
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1359
    RETURN ( newFloat );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1360
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1361
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1362
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1363
asLargeInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1364
    "return a LargeInteger with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1365
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1366
    ^ LargeInteger value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1367
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1368
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1369
asCharacter
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1370
    "Return a character with the receiver as ascii value"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1371
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1372
    ^ Character value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1373
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1374
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1375
!SmallInteger methodsFor:'iteration'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1376
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1377
timesRepeat:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1378
    "evaluate the argument, aBlock self times"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1379
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1380
    |count "{ Class: SmallInteger }" |
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1381
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1382
    count := self.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1383
    [count > 0] whileTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1384
	aBlock value.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1385
	count := count - 1
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1386
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1387
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1388
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1389
to:stop do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1390
    "evaluate aBlock for every integer between (and including) the receiver
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1391
     and the argument, stop.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1392
     Reimplemented for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1393
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1394
    |home|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1395
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1396
    REGISTER INT tmp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1397
    INT final;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1398
    REGISTER OBJFUNC code;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1399
    extern OBJ Block;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1400
    static struct inlineCache blockVal = __ILC1(0);
2
claus
parents: 1
diff changeset
  1401
    REGISTER OBJ rHome;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1402
252
  1403
    if (__isSmallInteger(stop)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1404
	tmp = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1405
	final = _intVal(stop);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1406
	if (__isBlockLike(aBlock)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1407
	 && ((code = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1408
	 && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1409
#ifdef NEW_BLOCK_CALL
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1410
	    while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1411
		if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1412
		(*code)(aBlock, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1413
		tmp++;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1414
	    }
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1415
#else /* old BLOCK_CALL */
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1416
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1417
	     * arg is a compiled block - 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1418
	     * directly call it without going through "Block-value"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1419
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1420
	    home = _BlockInstPtr(aBlock)->b_home;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1421
	    rHome = home;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1422
	    if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1423
		/*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1424
		 * home will not move - keep in in a register
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1425
		 */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1426
		while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1427
		    if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1428
		    (*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1429
		    tmp++;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1430
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1431
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1432
		while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1433
		    if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1434
		    (*code)(home, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1435
		    tmp++;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1436
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1437
	    }
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1438
#endif /* NEW_BLOCK_CALL */
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1439
	} else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1440
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1441
	     * arg is something else - call it with value"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1442
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1443
	    while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1444
		if (InterruptPending != nil) interrupt(CONARG);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1445
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1446
		(*blockVal.ilc_func)(aBlock, 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1447
				     @symbol(value:), 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1448
				     CON_COMMA nil, &blockVal, 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1449
				     _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1450
		tmp++;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1451
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1452
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1453
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1454
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1455
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1456
.
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1457
    ^ super to:stop do:aBlock
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1458
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1459
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1460
     1 to:10 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1461
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1462
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1463
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1464
to:stop by:incr do:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1465
    "reimplemented for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1466
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1467
    |home|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1468
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1469
    REGISTER INT tmp, step;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1470
    REGISTER INT final;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1471
    REGISTER OBJFUNC code;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1472
    extern OBJ Block;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1473
    static struct inlineCache blockVal = __ILC1(0);
2
claus
parents: 1
diff changeset
  1474
    REGISTER OBJ rHome;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1475
252
  1476
    if (__bothSmallInteger(incr, stop)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1477
	tmp = _intVal(self);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1478
	final = _intVal(stop);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1479
	step = _intVal(incr);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1480
	if (__isBlockLike(aBlock)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1481
	 && ((code = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1482
	 && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1483
#ifdef NEW_BLOCK_CALL
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1484
	    if (step < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1485
		while (tmp >= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1486
		    if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1487
		    (*code)(aBlock, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1488
		    tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1489
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1490
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1491
		while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1492
		    if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1493
		    (*code)(aBlock, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1494
		    tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1495
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1496
	    }
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1497
#else
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1498
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1499
	     * arg is a compiled block - 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1500
	     * directly call it without going through "Block-value"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1501
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1502
	    home = _BlockInstPtr(aBlock)->b_home;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1503
	    rHome = home;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1504
	    if (step < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1505
		if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1506
		    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1507
		     * home is on stack - will not move
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1508
		     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1509
		    while (tmp >= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1510
			if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1511
			(*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1512
			tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1513
		    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1514
		} else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1515
		    while (tmp >= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1516
			if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1517
			(*code)(home, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1518
			tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1519
		    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1520
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1521
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1522
		if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1523
		    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1524
		     * home is on stack - will not move
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1525
		     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1526
		    while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1527
			if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1528
			(*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1529
			tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1530
		    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1531
		} else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1532
		    while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1533
			if (InterruptPending != nil) interrupt(CONARG);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1534
			(*code)(home, CON_COMMA _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1535
			tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1536
		    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1537
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1538
	    }
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1539
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1540
	} else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1541
	    /*
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1542
	     * arg is something else - call it with value"
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1543
	     */
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1544
	    if (step < 0) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1545
		while (tmp >= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1546
		    if (InterruptPending != nil) interrupt(CONARG);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1547
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1548
		    (*blockVal.ilc_func)(aBlock, 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1549
					 @symbol(value:), 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1550
					 CON_COMMA nil, &blockVal,
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1551
					 _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1552
		    tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1553
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1554
	    } else {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1555
		while (tmp <= final) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1556
		    if (InterruptPending != nil) interrupt(CONARG);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1557
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1558
		    (*blockVal.ilc_func)(aBlock, 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1559
					 @symbol(value:), 
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1560
					 CON_COMMA nil, &blockVal,
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1561
					 _MKSMALLINT(tmp));
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1562
		    tmp += step;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1563
		}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1564
	    }
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1565
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1566
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1567
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1568
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1569
.
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1570
    ^ super to:stop by:incr do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1571
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1572
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1573
     1 to:10 by:3 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  1574
    "
2
claus
parents: 1
diff changeset
  1575
! !
claus
parents: 1
diff changeset
  1576
claus
parents: 1
diff changeset
  1577
!SmallInteger class methodsFor:'binary storage'!
claus
parents: 1
diff changeset
  1578
claus
parents: 1
diff changeset
  1579
binaryDefinitionFrom: stream manager: manager
claus
parents: 1
diff changeset
  1580
    "read the binary representation as stored in storeBinaryOn:"
claus
parents: 1
diff changeset
  1581
claus
parents: 1
diff changeset
  1582
    | value |
claus
parents: 1
diff changeset
  1583
claus
parents: 1
diff changeset
  1584
    value := stream next bitAnd: 16r7F.
claus
parents: 1
diff changeset
  1585
    value > 16r3F ifTrue: [
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1586
	value := value - 16r80
2
claus
parents: 1
diff changeset
  1587
    ].
claus
parents: 1
diff changeset
  1588
    value := (value bitShift: 8) bitOr: stream next.
claus
parents: 1
diff changeset
  1589
    value := (value bitShift: 8) bitOr: stream next.
claus
parents: 1
diff changeset
  1590
    value := (value bitShift: 8) bitOr: stream next.
claus
parents: 1
diff changeset
  1591
    ^ value
claus
parents: 1
diff changeset
  1592
! !
claus
parents: 1
diff changeset
  1593
claus
parents: 1
diff changeset
  1594
!SmallInteger methodsFor:'binary storage'!
claus
parents: 1
diff changeset
  1595
claus
parents: 1
diff changeset
  1596
hasSpecialBinaryRepresentation
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1597
    "return true, if the receiver has a special binary representation"
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1598
2
claus
parents: 1
diff changeset
  1599
    ^ true
claus
parents: 1
diff changeset
  1600
!
claus
parents: 1
diff changeset
  1601
claus
parents: 1
diff changeset
  1602
storeBinaryOn: stream manager: manager
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1603
    "append a binary representation onto stream.
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1604
     Redefined since SmallIntegers are stored as their value with the 32nd bit 
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1605
     set as a tag.
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1606
     To make the binary file a bit more compact, zeros and single byte ints
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1607
     are stored with a more compact representation (using special type-codes)."
2
claus
parents: 1
diff changeset
  1608
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1609
    self == 0 ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1610
	stream nextPut: manager codeForZero.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1611
	^ self
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1612
    ].
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1613
    (self between:0 and:255) ifTrue:[
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1614
	stream nextPut: manager codeForByteInteger.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1615
	stream nextPut: self.
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1616
	^ self
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
  1617
    ].
2
claus
parents: 1
diff changeset
  1618
    stream nextPut: (((self bitShift: -24) bitAnd: 16rFF) bitOr: 16r80).
claus
parents: 1
diff changeset
  1619
    stream nextPut: ((self bitShift: -16) bitAnd: 16rFF).
claus
parents: 1
diff changeset
  1620
    stream nextPut: ((self bitShift: -8) bitAnd: 16rFF).
claus
parents: 1
diff changeset
  1621
    stream nextPut: (self bitAnd: 16rFF)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1622
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1623
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1624
!SmallInteger methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1625
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1626
printOn:aStream
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1627
    "append my printstring (base 10) to aStream."
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1628
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1629
    aStream nextPutAll:(self printString)
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1630
!
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1631
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1632
printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1633
    "return my printstring (base 10)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1634
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1635
    "since printf knows pretty good how to do this,
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1636
     here is an exception to the rule of basing printString
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1637
     upon the printOn: method."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1638
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1639
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1640
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1641
    char buffer[30];
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1642
    OBJ newString;
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1643
#ifdef THISCONTEXT_IN_REGISTER
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1644
    OBJ sav = __thisContext;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1645
#endif
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1646
    int sz;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1647
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1648
    sprintf(buffer, "%d", _intVal(self));
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1649
#ifdef THISCONTEXT_IN_REGISTER
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1650
    __thisContext = sav;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1651
#endif
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1652
    sz = sizeof(struct stringheader) + strlen(buffer) + 1;
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1653
    _qNew(newString, sz, SENDER);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1654
    _InstPtr(newString)->o_class = String;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1655
    strcpy(_stringVal(newString), buffer);
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1656
    RETURN (newString);
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1657
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1658
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1659
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1660
printOn:aStream base:radix
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1661
    "append my printstring in any number base to aStream.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1662
     The radix argument should be between 2 and 36."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1663
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1664
    aStream nextPutAll:(self printStringRadix:radix)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1665
!
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  1666
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1667
printStringRadix:radix
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1668
    "return my printstring (optimized for bases 16, 10 and 8)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1669
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1670
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1671
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1672
    char *format = (char *)0;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1673
    char buffer[30];
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1674
    OBJ newString;
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1675
    int sz;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1676
252
  1677
    if (__isSmallInteger(radix)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1678
	switch (_intVal(radix)) {
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1679
	    case 10:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1680
		format = "%d";
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1681
		break;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1682
	    case 16:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1683
		format = "%x";
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1684
		break;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1685
	    case 8:
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1686
		format = "%o";
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1687
		break;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1688
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1689
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1690
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1691
    if (format) {
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1692
#ifdef THISCONTEXT_IN_REGISTER
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1693
	OBJ sav = __thisContext;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1694
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1695
	sprintf(buffer, format, _intVal(self));
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1696
#ifdef THISCONTEXT_IN_REGISTER
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1697
	__thisContext = sav;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1698
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1699
	sz = sizeof(struct stringheader) + strlen(buffer) + 1;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1700
	_qNew(newString, sz, SENDER);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1701
	_InstPtr(newString)->o_class = String;
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1702
	strcpy(_stringVal(newString), buffer);
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1703
	RETURN (newString);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1704
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1705
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1706
.
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1707
    "fall back for seldom used bases"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1708
    ^ super printStringRadix:radix
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1709
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1710
    "123 printStringRadix:16"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1711
    "123 printStringRadix:8"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1712
    "123 printStringRadix:2"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1713
    "123 printStringRadix:3"
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1714
    "123 printStringRadix:1"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1715
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1716
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1717
printfPrintString:formatString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1718
    "non-portable, but sometimes useful.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1719
     return a printed representation of the receiver
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1720
     as specified by formatString, which is defined by the C-
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1721
     function 'printf'.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1722
     No checking for string overrun - the resulting string 
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1723
     must be shorter than 256 chars or else ...
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1724
     This method is NONSTANDARD and may be removed without notice."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1725
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1726
%{  /* STACK: 400 */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1727
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1728
    char buffer[256];
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1729
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1730
    if (__isString(formatString)) {
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1731
#ifdef THISCONTEXT_IN_REGISTER
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1732
	OBJ sav = __thisContext;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1733
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1734
	sprintf(buffer, _stringVal(formatString), _intVal(self));
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1735
#ifdef THISCONTEXT_IN_REGISTER
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1736
	__thisContext = sav;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1737
#endif
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1738
	RETURN ( _MKSTRING(buffer COMMA_SND) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1739
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1740
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1741
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1742
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1743
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1744
    "123 printfPrintString:'%%d -> %d'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1745
    "123 printfPrintString:'%%6d -> %6d'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1746
    "123 printfPrintString:'%%x -> %x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1747
    "123 printfPrintString:'%%4x -> %4x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1748
    "123 printfPrintString:'%%04x -> %04x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1749
! !