SmallInteger.st
author Claus Gittinger <cg@exept.de>
Tue, 26 Feb 2002 11:41:59 +0100
changeset 6415 f163a6319b5f
parent 6400 3746d31f044a
child 6416 6609ffc66d4e
permissions -rw-r--r--
unsigned C/Java 32bit shifts
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
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    13
"{ Package: 'stx:libbasic' }"
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    14
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    15
Integer subclass:#SmallInteger
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    16
	instanceVariableNames:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    17
	classVariableNames:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    18
	poolDictionaries:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    19
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    22
!SmallInteger class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    23
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    24
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    25
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    26
 COPYRIGHT (c) 1988 by Claus Gittinger
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
    27
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    28
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    38
documentation
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    39
"
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
    SmallIntegers are Integers in the range of at least +/- 2^30 
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
    41
    (i.e. 31 bits, which is not a guaranteed: on an alpha, 63 bits are used,
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
    42
     if the system was configured for 64bit mode).
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    44
    These are no real objects - they have no instances (not even storage !!)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    45
    and cannot be subclassed.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    46
    The reason is to save both storage and runtime by not collecting
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    47
    SmallIntegers in the system. SmallInts are marked by having the TAG_INT 
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
    bit set, in contrast to all other objects which do not. 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    49
    Since this knowledge is hardwired into the system (and there is no 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
    class-field stored with SmallIntegers) there can be no subclass of 
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
    SmallInteger (sorry).
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    52
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    53
    If you really need this kind of thing, create a subclass of Integer,
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    54
    with an instance variable holding the value.
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    55
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    56
    [author:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    57
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    58
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    59
    [see also:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    60
	Number
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    61
	Float Fraction FixedPoint
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    62
	LargeInteger
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    63
"
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    64
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    65
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    66
!SmallInteger class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
basicNew:size
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    82
!SmallInteger class methodsFor:'bit mask constants'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    83
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    84
bitMaskFor:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    85
    "return a bitmask for the index's bit (index starts at 1)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    86
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    87
    (index between:1 and:SmallInteger maxBits) ifFalse:[
4523
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    88
        ^ SubscriptOutOfBoundsSignal 
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    89
                raiseRequestWith:index
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
    90
                errorString:'index out of bounds'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    91
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    92
    ^ 1 bitShift:(index - 1)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    93
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    94
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    95
!SmallInteger class methodsFor:'constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
a27a279701f8 Initial revision
claus
parents:
diff changeset
    97
maxBits
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    98
    "return the number of bits 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 */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   102
    RETURN ( __MKSMALLINT(N_INT_BITS) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
%}
2
claus
parents: 1
diff changeset
   104
claus
parents: 1
diff changeset
   105
    "SmallInteger maxBits"
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
maxBytes
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   109
    "return the number of bytes in instances of me.
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 */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   113
    RETURN ( __MKSMALLINT(N_INT_BITS / 8 + 1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
%}
2
claus
parents: 1
diff changeset
   115
3684
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   116
    "
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   117
     SmallInteger maxBytes
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   118
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
a27a279701f8 Initial revision
claus
parents:
diff changeset
   121
maxVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   122
    "return the largest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   123
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
%{  /* NOCONTEXT */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   126
    RETURN ( __MKSMALLINT(_MAX_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
%}
2
claus
parents: 1
diff changeset
   128
claus
parents: 1
diff changeset
   129
    "SmallInteger maxVal"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   130
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   131
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   132
minVal
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   133
    "return the smallest Integer representable as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   134
     For very special uses only - not constant across implementations"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   135
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   136
%{  /* NOCONTEXT */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   137
    RETURN ( __MKSMALLINT(_MIN_INT) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   138
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   139
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   140
    "SmallInteger minVal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   141
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   142
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   143
!SmallInteger class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   144
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   145
canBeSubclassed
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   146
    "return true, if its allowed to create subclasses of the receiver.
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   147
     Return false here - since it is NOT possible for SmallInteger
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   148
     (due to the tagged representation of SmallIntegers)"
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   149
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   150
    ^ false
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   151
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   152
    "Modified: / 5.11.1998 / 16:11:27 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   154
2672
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   155
hasImmediateInstances
4661
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   156
    "return true if this class has immediate instances
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   157
     i.e. if the instances are represented in the pointer itself and
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   158
     no real object header/storage is used for the object.
2672
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   159
     Redefined from Behavior"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   160
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   161
    ^ true
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   162
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   163
    "Created: 3.6.1997 / 12:01:26 / cg"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   164
!
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   165
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   166
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   167
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   168
     Here, true is returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
    ^ true
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   171
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   172
    "Modified: 23.4.1996 / 16:00:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   174
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
!SmallInteger methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   176
a27a279701f8 Initial revision
claus
parents:
diff changeset
   177
* aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   178
    "return the product of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   179
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   182
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   183
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   184
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   185
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   186
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   187
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   188
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   189
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   190
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   191
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   192
    INT myValue, otherValue;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   193
    unsigned INT productLow, productHi;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   194
    int negative;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   195
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   196
#   define low16Bits(foo)  ((foo) & 0xFFFF)
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   197
#   define hi16Bits(foo)   ((foo) >> 16)
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   198
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   199
#   define hi32Bits(foo)   ((foo) >> 32)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   200
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   201
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   202
     * can we use long long arithmetic ?
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   203
     *
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   204
     * long-long arithmetic seems to be buggy with some systems
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   205
     * (took me a while to find this out :-(
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   206
     * (try 10000 * 10000)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   207
     */
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   208
#if defined(sparc) && defined(__GNUC__) && (__GNUC__ >= 2)
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   209
# define USE_LONGLONG_FOR_MUL
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   210
#endif
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   211
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   212
#if defined(i386) && defined(__GNUC__) && (__GNUC__ >= 2)
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   213
# define USE_LONGLONG_FOR_MUL
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   214
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   215
252
   216
    if (__isSmallInteger(aNumber)) {
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   217
        myValue = __intVal(self);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   218
        otherValue = __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   219
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   220
#if defined(USE_LONGLONG_FOR_MUL)
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   221
        {
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   222
# if defined(alpha) && !defined(alpha64)
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   223
#  define LONGLONG      INT64
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   224
# else
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   225
#  define LONGLONG      long long
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   226
# endif
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   227
            LONGLONG product;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   228
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   229
            product = (LONGLONG)myValue * (LONGLONG)otherValue;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   230
            if ((product >= (LONGLONG)_MIN_INT) 
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   231
             && (product <= (LONGLONG)_MAX_INT)) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   232
                RETURN ( __MKSMALLINT((INT)product) );
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   233
            }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   234
            if (product < 0) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   235
                negative = -1;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   236
                product = -product;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   237
            } else {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   238
                negative = 1;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   239
            }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   240
            productHi = product >> 32;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   241
            productLow = product & 0xFFFFFFFFL;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   242
        }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   243
#else /* no long-long */
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   244
        negative = 1;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   245
        if (myValue < 0) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   246
            negative = -1;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   247
            myValue = -myValue;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   248
        }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   249
        if (otherValue < 0) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   250
            negative = -negative;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   251
            otherValue = -otherValue;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   252
        }
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   253
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   254
# if defined(__GNUC__) && defined(mc68k)
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   255
        asm ("mulu%.l %3,%1:%0"
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   256
                : "=d"  ((unsigned long)(productLow)),
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   257
                  "=d"  ((unsigned long)(productHi))
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   258
                : "%0"  ((unsigned long)(myValue)),
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   259
                  "dmi" ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   260
# else
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   261
#  if defined (__GNUC__) && defined(i386)
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   262
        asm ("mull %3"
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   263
                : "=a"  ((unsigned long)(productLow)),
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   264
                  "=d"  ((unsigned long)(productHi))
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   265
                : "%0"  ((unsigned long)(myValue)),
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   266
                  "rm"  ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   267
#  else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   268
#   if defined(WIN32)
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   269
        asm {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   270
            mov   eax, myValue
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   271
            mov   edx, otherValue
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   272
            mul   edx
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   273
            mov   productLow, eax
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   274
            mov   productHi, edx
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   275
        }
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   276
#   else /* generic */
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   277
        {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   278
            unsigned INT pHH, pHL, pLH, pLL;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   279
            unsigned INT low1, low2, hi1, hi2;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   280
            unsigned INT t;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   281
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   282
            /* unsigned multiply myValue * otherValue -> productHi, productLow
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   283
             *
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   284
             * this is too slow:
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   285
             * since most machines can do 32*32 to 64 bit multiply,
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   286
             * (or at least 32*32 with Overflow check)
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   287
             * - need more assembler (inline) functions here 
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   288
             */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   289
#    ifdef alpha64
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   290
            low1 = low32Bits((unsigned INT)myValue);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   291
            hi1 = hi32Bits((unsigned INT)myValue);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   292
            low2 = low32Bits((unsigned INT)otherValue);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   293
            hi2 = hi32Bits((unsigned INT)otherValue);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   294
#     define LLMASK 0xC000000000000000L
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   295
#    else
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   296
            low1 = low16Bits((unsigned INT)myValue);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   297
            hi1 = hi16Bits((unsigned INT)myValue);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   298
            low2 = low16Bits((unsigned INT)otherValue);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   299
            hi2 = hi16Bits((unsigned INT)otherValue);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   300
#     define LLMASK 0xC0000000
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   301
#    endif
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   302
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   303
            pLH = low1 * hi2;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   304
            pHL = hi1 * low2;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   305
            pLL = low1 * low2;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   306
            pHH = hi1 * hi2;
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   307
        
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   308
            /*
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   309
             * the common case ...
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   310
             */
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   311
            if ((pHL == 0)
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   312
             && (pLH == 0)
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   313
             && (pHH == 0)
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   314
             && ((pLL & LLMASK) == 0)) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   315
                if (negative < 0) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   316
                    RETURN ( __MKSMALLINT(- ((INT)pLL)) );
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   317
                }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   318
                RETURN ( __MKSMALLINT((INT)pLL) );
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   319
            }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   320
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   321
            /*
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   322
             *   pHH |--------|--------|
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   323
             *   pLH          |--------|--------|
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   324
             *   pHL          |--------|--------|
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   325
             *   pLL                   |--------|--------|
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   326
             */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   327
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   328
#    ifdef alpha64
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   329
            t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   330
            productLow = (t << 32) + low32Bits(pLL);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   331
            productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   332
#    else
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   333
            t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   334
            productLow = (t << 16) + low16Bits(pLL);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   335
            productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   336
#    endif
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   337
        }
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   338
#   endif /* ! WIN32 */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   339
#  endif /* ! (__GNUC__ && i386) */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   340
# endif /* ! (__GNUC__ && mc68k) */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   341
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   342
        if (productHi == 0) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   343
            if (negative < 0) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   344
                if (productLow <= -(_MIN_INT)) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   345
                    RETURN ( __MKSMALLINT(-((INT)productLow)) );
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   346
                }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   347
            } else {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   348
                if (productLow <= _MAX_INT) {
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   349
                    RETURN ( __MKSMALLINT(productLow) );
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   350
                }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   351
            }
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   352
        }
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   353
#endif /* ! USE_LONGLONG */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   354
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   355
#ifdef alpha64
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   356
        RETURN (__MKLARGEINT128(negative, productLow, productHi));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   357
#else
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   358
        RETURN (__MKLARGEINT64(negative, productLow, productHi));
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   359
#endif
283
a897d331b4c1 *** empty log message ***
claus
parents: 282
diff changeset
   360
    } else if (__isFloatLike(aNumber)) {
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   361
        OBJ newFloat;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   362
        double val = (double)__intVal(self) * __floatVal(aNumber);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   363
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   364
        __qMKFLOAT(newFloat, val);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   365
        RETURN ( newFloat );
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   366
    } else if (__isShortFloat(aNumber)) {
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   367
        OBJ newFloat;
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   368
        float val = (float)__intVal(self) * __shortFloatVal(aNumber);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   369
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   370
        __qMKSFLOAT(newFloat, val);
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   371
        RETURN ( newFloat );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   372
    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
   373
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
    ^ aNumber productFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   375
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   376
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   377
+ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   378
    "return the sum of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   379
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   380
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   381
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   382
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   383
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   384
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   385
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   386
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   387
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   388
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   389
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   390
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   391
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   392
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   393
#ifdef _ADD_IO_IO
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   394
        RETURN ( _ADD_IO_IO(self, aNumber) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   395
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   396
        REGISTER INT sum;
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   397
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   398
        sum =  __intVal(self) + __intVal(aNumber);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   399
        if (__ISVALIDINTEGER(sum)) {
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   400
            RETURN ( __MKSMALLINT(sum) );
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   401
        }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   402
        RETURN ( __MKLARGEINT(sum) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   403
#endif
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   404
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   405
    if (__isFloatLike(aNumber)) {
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   406
        OBJ newFloat;
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   407
        double val = (double)__intVal(self) + __floatVal(aNumber);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   408
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   409
        __qMKFLOAT(newFloat, val);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   410
        RETURN ( newFloat );
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   411
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   412
    if (__isShortFloat(aNumber)) {
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   413
        OBJ newFloat;
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   414
        float val = (float)__intVal(self) + __shortFloatVal(aNumber);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   415
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   416
        __qMKSFLOAT(newFloat, val);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   417
        RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   418
    }
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   419
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   420
    ^ aNumber sumFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   421
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   422
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   423
- aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   424
    "return the difference of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   425
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   426
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   427
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   428
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   429
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   430
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   431
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   432
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   433
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   434
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   435
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   436
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   437
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   438
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   439
#ifdef _SUB_IO_IO
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   440
        RETURN ( _SUB_IO_IO(self, aNumber) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   441
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   442
        REGISTER INT diff;
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   443
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   444
        diff =  __intVal(self) - __intVal(aNumber);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   445
        if (__ISVALIDINTEGER(diff)) {
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   446
            RETURN ( __MKSMALLINT(diff) );
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   447
        }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   448
        RETURN ( __MKLARGEINT(diff) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   449
#endif
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   450
    } 
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   451
    if (__isFloatLike(aNumber)) {
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   452
        OBJ newFloat;
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   453
        double val = (double)__intVal(self) - __floatVal(aNumber);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   454
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   455
        __qMKFLOAT(newFloat, val);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   456
        RETURN ( newFloat );
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   457
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   458
    if (__isShortFloat(aNumber)) {
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   459
        OBJ newFloat;
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   460
        float val = (float)__intVal(self) - __shortFloatVal(aNumber);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   461
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   462
        __qMKSFLOAT(newFloat, val);
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   463
        RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   464
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   465
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   466
    ^ aNumber differenceFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   467
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   468
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   469
/ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   470
    "return the quotient of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   471
a27a279701f8 Initial revision
claus
parents:
diff changeset
   472
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   473
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   474
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   475
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   476
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   477
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   478
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   479
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   480
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   481
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   482
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   483
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   484
    INT me, t, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   485
    double dval;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   486
252
   487
    if (__isSmallInteger(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   488
        val = __intVal(aNumber);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   489
        if (val != 0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   490
            me = __intVal(self);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   491
            t = me / val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   492
#ifdef GOOD_OPTIMIZER
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   493
            if (me % val == 0) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   494
#else
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   495
            /* this is stupid - all I want is to look for a remainder ... 
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   496
               but most compilers are too stupid and generate an extra modulus
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   497
               instruction for "if (me % val)".
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   498
               Even if most divide instructions already leave the remainder in
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   499
               some register.
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   500
               Therefore I use a multiplication which is faster than a modulo
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   501
               on most machines. Hint to GNU people :-)
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   502
            */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   503
            if ((t * val) == me) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   504
#endif
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   505
                RETURN ( __MKSMALLINT(t) );
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   506
            }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   507
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   508
    } else {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   509
        if (__isFloatLike(aNumber)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   510
            dval = __floatVal(aNumber);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   511
            if (dval != 0.0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   512
                OBJ newFloat;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   513
                double val = (double)__intVal(self) / dval;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   514
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   515
                __qMKFLOAT(newFloat, val);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   516
                RETURN ( newFloat );
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   517
            }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   518
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   519
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   520
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   521
    aNumber isInteger ifTrue:[
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   522
        aNumber == 0 ifTrue:[
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5930
diff changeset
   523
            ^ DivisionByZeroSignal raiseRequestWith:thisContext.
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   524
        ].
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   525
        ^ Fraction numerator:self denominator:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   526
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   527
    ^ aNumber quotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   528
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   529
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   530
     8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   531
     9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   532
     9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   533
     9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   534
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   535
     -8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   536
     -9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   537
     -9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   538
     -9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   539
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   540
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   541
2
claus
parents: 1
diff changeset
   542
// aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   543
    "return the integer part of the quotient of the receivers value
1884
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   544
     and the arguments value. The result is truncated toward negative infinity
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   545
     and negative, if the operands signs differ.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   546
     Be careful with negative results: 9 // 4 = 2, 
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   547
     while -9 // 4 = -3. 
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   548
     The following is always true:
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   549
        (receiver // aNumber) * aNumber + (receiver \\ aNUmber) = receiver
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   550
     See #quo: which returns -2 in the latter."
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   551
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   552
%{  /* NOCONTEXT */
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   553
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   554
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   555
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   556
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   557
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   558
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   559
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   560
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   561
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   562
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   563
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   564
    INT dividend, divisor, rslt;
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   565
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   566
    if (__isSmallInteger(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   567
        divisor = __intVal(aNumber);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   568
        if (divisor != 0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   569
            dividend = __intVal(self);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   570
            rslt = dividend / divisor;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   571
            /*
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   572
             * Optimized to speed up positive result
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   573
             */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   574
            if (rslt <= 0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   575
                if (rslt == 0) {
4967
ce7e7852115f Fix bad result -1 when doing 1000 // 3600000
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   576
                    if ((dividend ^ divisor) < 0) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   577
                        /*
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   578
                         * result (negative) has been truncated toward 0.
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   579
                         * Return -1, because we truncate toward negative inf.
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   580
                         */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   581
                         rslt = -1;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   582
                    }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   583
                } else {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   584
                    /*
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   585
                     * If result (negative) has been truncated toward 0,
4967
ce7e7852115f Fix bad result -1 when doing 1000 // 3600000
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   586
                     * subtract 1, because we truncate toward negative inf.
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   587
                     */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   588
                    if (divisor > 0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   589
                        if (rslt * divisor > dividend) {        
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   590
                            rslt--;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   591
                        }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   592
                    } else {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   593
                        if (rslt * divisor < dividend) {        
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   594
                            rslt--;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   595
                        }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   596
                    }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   597
                }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   598
            }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   599
            RETURN ( __MKSMALLINT(rslt) );
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   600
        }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   601
    } else {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   602
        if (__isFraction(aNumber)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   603
            OBJ t;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   604
            INT num, den;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   605
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   606
            t = __FractionInstPtr(aNumber)->f_numerator;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   607
            if (__isSmallInteger(t)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   608
                num = __intVal(t);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   609
                t = __FractionInstPtr(aNumber)->f_denominator;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   610
                if (__isSmallInteger(t)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   611
                    den = __intVal(t);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   612
                    RETURN ( __MKSMALLINT(__intVal(self) * den / num ));
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   613
                }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   614
            }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   615
        }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   616
    }
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   617
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   618
    (aNumber = 0) ifTrue:[
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5930
diff changeset
   619
        ^ DivisionByZeroSignal raiseRequestWith:thisContext.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   620
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   621
    ^ self retry:#// coercing:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   622
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   623
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   624
     9 // 4     ~~ 2 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   625
     -9 // 4    ~~ -3 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   626
     9 // -4    ~~ -3 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   627
     -9 // -4   ~~ 2 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   628
     1 // 2     ~~ 0 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   629
     -1 // 2    ~~ -1 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   630
     1 // -2    ~~ -1 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   631
     -1 // -2   ~~ 0 ifTrue:[self halt].
4967
ce7e7852115f Fix bad result -1 when doing 1000 // 3600000
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   632
     10000 // 3600000 ~~ 0 ifTrue:[self halt].   
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   633
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   634
     9 quo:4   => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   635
     -9 quo:4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   636
     9 quo:-4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   637
     -9 quo:-4 => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   638
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   639
!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   640
2
claus
parents: 1
diff changeset
   641
\\ aNumber
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   642
    "Answer the integer remainder m defined by division with truncation toward
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   643
     negative infinity. The remainder has the same sign as aNumber.
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   644
     m < |aNumber| AND there is an integer k with (k * aNumber + m) = self
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   645
     The following is always true:
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   646
        (receiver // aNumber) * aNumber + (receiver \\ aNumber) = receiver
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   647
     Compare with #rem:
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   648
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   649
     Redefined for speed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   650
a27a279701f8 Initial revision
claus
parents:
diff changeset
   651
%{  /* NOCONTEXT */
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   652
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   653
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   654
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   655
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   656
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   657
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   658
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   659
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   660
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   661
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   662
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   663
    INT dividend, divisor, rem;
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   664
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   665
    if (__isSmallInteger(aNumber)
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   666
        && (divisor = __intVal(aNumber)) != 0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   667
        /*
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   668
         * Note that the sign of something modulo a negative number is undefined
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   669
         * in C!
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   670
         */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   671
        dividend = __intVal(self);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   672
        rem = dividend % divisor;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   673
        if (rem) {
4967
ce7e7852115f Fix bad result -1 when doing 1000 // 3600000
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   674
            if ((rem ^ divisor) < 0) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   675
                /* sign of remainder is different from sign of divisor */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   676
                rem = -rem;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   677
            }
4967
ce7e7852115f Fix bad result -1 when doing 1000 // 3600000
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   678
            if ((dividend ^ divisor) < 0) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   679
                /* different signs, so division would have returned a
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   680
                 * negative number. 
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   681
                 * C rounds toward zero, this code will simulate
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   682
                 * rounding towards negative infinity.
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   683
                 */
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   684
                rem = divisor - rem;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   685
            }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   686
        }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   687
        RETURN ( __MKSMALLINT(rem) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   688
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   689
%}.
2
claus
parents: 1
diff changeset
   690
    (aNumber = 0) ifTrue:[
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5930
diff changeset
   691
        ^ DivisionByZeroSignal raiseRequestWith:thisContext.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   692
    ].
2
claus
parents: 1
diff changeset
   693
    ^ self retry:#\\ coercing:aNumber
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   694
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   695
    "                                                    
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   696
     9 \\ 4  == 1 ifFalse:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   697
     -9 \\ 4 == 3 ifFalse:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   698
     9 \\ -4 == -3 ifFalse:[self halt].                   
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   699
     -9 \\ -4 == -1 ifFalse:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   700
     (9 rem:4) == 1 ifFalse:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   701
     (-9 rem:4) == -1 ifFalse:[self halt].
4967
ce7e7852115f Fix bad result -1 when doing 1000 // 3600000
Stefan Vogel <sv@exept.de>
parents: 4955
diff changeset
   702
     1000 \\ 3600000 == 1000 ifFalse:[self halt]
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   703
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   704
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   705
a27a279701f8 Initial revision
claus
parents:
diff changeset
   706
abs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   707
    "return the absolute value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   708
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   709
a27a279701f8 Initial revision
claus
parents:
diff changeset
   710
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   711
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   712
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   713
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   714
    if (val >= 0) {
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   715
        RETURN (self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   716
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   717
    if (val != _MIN_INT) {
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   718
        RETURN ( __MKSMALLINT(-val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   719
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   720
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   721
    RETURN( __MKLARGEINT(-_MIN_INT));
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   722
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   723
    ^ super abs
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   724
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   725
a27a279701f8 Initial revision
claus
parents:
diff changeset
   726
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   727
    "return the negative value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   728
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   729
a27a279701f8 Initial revision
claus
parents:
diff changeset
   730
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   731
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   732
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   733
a27a279701f8 Initial revision
claus
parents:
diff changeset
   734
    if (val != _MIN_INT) {
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   735
        RETURN ( __MKSMALLINT(- val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   736
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   737
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   738
    RETURN (__MKLARGEINT( -_MIN_INT));
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   739
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   740
    ^ 0 - self
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   741
"/    "only reached for minVal"
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   742
"/    ^ (LargeInteger value:(SmallInteger maxVal)) + 1
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   743
!
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   744
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   745
quo:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   746
    "return the integer part of the quotient of the receivers value
1884
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   747
     and the arguments value. The result is truncated towards zero
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   748
     and negative, if the operands signs differ.. 
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   749
     The following is always true:
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   750
        (receiver quo: aNumber) * aNumber + (receiver rem: aNumber) = receiver
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   751
     For positive results, this is the same as #//,
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   752
     for negative results, the remainder is ignored.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   753
     I.e.: '9 // 4 = 2' and '-9 // 4 = -3'
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   754
     in contrast: '9 quo: 4 = 2' and '-9 quo: 4 = -2'"
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   755
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   756
%{  /* NOCONTEXT */
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   757
    INT val;
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   758
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   759
    if (__isSmallInteger(aNumber)) {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   760
        val = __intVal(aNumber);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   761
        if (val != 0) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   762
            RETURN ( __MKSMALLINT(__intVal(self) / val) );
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   763
        }
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   764
    } else {
4455
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   765
        if (__isFraction(aNumber)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   766
            OBJ t;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   767
            INT num, den;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   768
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   769
            t = __FractionInstPtr(aNumber)->f_numerator;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   770
            if (__isSmallInteger(t)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   771
                num = __intVal(t);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   772
                t = __FractionInstPtr(aNumber)->f_denominator;
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   773
                if (__isSmallInteger(t)) {
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   774
                    den = __intVal(t);
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   775
                    RETURN ( __MKSMALLINT(__intVal(self) * den / num ));
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   776
                }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   777
            }
2d31d0d986be Raise DivisionByZeroSignal proceedable (as in ST-80)!
Stefan Vogel <sv@exept.de>
parents: 4184
diff changeset
   778
        }
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   779
    }
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   780
%}.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   781
    (aNumber = 0) ifTrue:[
5954
d706efecb134 ZeroDivide has a parameter
Claus Gittinger <cg@exept.de>
parents: 5930
diff changeset
   782
        ^ DivisionByZeroSignal raiseRequestWith:thisContext.
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   783
    ].
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   784
    ^ self retry:#quo: coercing:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   785
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   786
    "
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   787
     9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   788
     -9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   789
     9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   790
     -9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   791
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   792
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   793
a27a279701f8 Initial revision
claus
parents:
diff changeset
   794
!SmallInteger methodsFor:'bit operators'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   795
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   796
bitAnd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   797
    "return the bitwise-and of the receiver and the argument, anInteger"
1
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
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   801
    /* anding the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   802
    if (__isSmallInteger(anInteger)) {
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   803
        RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   804
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   805
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   806
    anInteger class == LargeInteger ifTrue:[
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   807
        ^ anInteger bitAnd:self
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   808
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   809
    ^ self retry:#bitAnd: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   810
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   811
    "(2r001010100 bitAnd:2r00001111) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   812
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   813
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   814
bitAt:index
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   815
    "return the value of the index's bit (index starts at 1).
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   816
     Notice: the result of bitAt: on negative receivers is not 
4523
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
   817
             defined in the language standard (since the implementation
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
   818
             is free to choose any internal representation for integers)"
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   819
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   820
    |mask|
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   821
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   822
    index <= 0 ifTrue:[
4523
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
   823
        ^ SubscriptOutOfBoundsSignal 
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
   824
                raiseRequestWith:index
28d9633c9cb4 subscriptBoundsError when accessing bad bits
Claus Gittinger <cg@exept.de>
parents: 4455
diff changeset
   825
                errorString:'index out of bounds'
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   826
    ].
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   827
    (index > SmallInteger maxBits) ifTrue:[^ 0].
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   828
    mask := 1 bitShift:(index - 1).
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   829
    ((self bitAnd:mask) == 0) ifTrue:[^ 0].
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   830
    ^ 1
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   831
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   832
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   833
     16r00000001 bitAt:0
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   834
     16r00000001 bitAt:1 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   835
     16r00008000 bitAt:16 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   836
     16r00800000 bitAt:24 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   837
     16r08000000 bitAt:28 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   838
     16r10000000 bitAt:29
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   839
     16r20000000 bitAt:30 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   840
     16r40000000 bitAt:31 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   841
     16r80000000 bitAt:32 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   842
     16r100000000 bitAt:33 
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   843
    "
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   844
!
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   845
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   846
bitClear:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   847
    "return the bitwise-and of the receiver and the complement of the argument, anInteger,
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   848
     returning the receiver with bits of the argument cleared."
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   849
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   850
%{  /* NOCONTEXT */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   851
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   852
    /* anding the tags doesn't change it */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   853
    if (__isSmallInteger(anInteger)) {
5458
2aa89d4fad64 example
Claus Gittinger <cg@exept.de>
parents: 5447
diff changeset
   854
        RETURN ( ((OBJ) (((INT)self & ~(INT)anInteger) | TAG_INT)) );
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   855
    }
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   856
%}.
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   857
    ^ self retry:#bitClear: coercing:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   858
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   859
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   860
     (2r001010100 bitClear:2r00001111) radixPrintStringRadix:2
5458
2aa89d4fad64 example
Claus Gittinger <cg@exept.de>
parents: 5447
diff changeset
   861
     (2r111111111 bitClear:2r00001000) radixPrintStringRadix:2
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   862
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   863
!
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   864
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   865
bitInvert
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   866
    "return the value of the receiver with all bits inverted"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   867
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   868
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   869
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   870
    /* invert anything except tag bits */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   871
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
   872
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
   873
    ^ self primitiveFailed
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   874
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   875
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   876
bitOr:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   877
    "return the bitwise-or of the receiver and the argument, anInteger"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   878
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   879
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   880
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   881
    /* oring the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   882
    if (__isSmallInteger(anInteger)) {
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   883
        RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   884
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   885
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   886
    ^ self retry:#bitOr: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   887
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   888
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   889
     (2r000000100 bitOr:2r00000011) radixPrintStringRadix:2
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   890
     (0 bitOr:16r20000000) hexPrintString   
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   891
     (0 bitOr:16r40000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   892
     (0 bitOr:16r80000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   893
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   894
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   895
1506
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   896
bitShift32:shiftCount
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   897
    "return the value of the receiver shifted by shiftCount bits,
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   898
     but only within 32 bits, shifting into/out-of the sign bit.
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   899
     May be useful for communication interfaces, to create ST-numbers
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   900
     from a signed 32bit int value given as individual bytes."
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   901
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   902
%{  /* NOCONTEXT */
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   903
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   904
    INT bits, count;
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   905
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   906
    if (__isSmallInteger(shiftCount)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   907
	count = __intVal(shiftCount);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   908
	if (count >= 32) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   909
	    RETURN (__MKSMALLINT(0));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   910
	}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   911
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   912
	bits = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   913
	if (count > 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   914
	    bits = bits << count;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   915
	} else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   916
	    bits = bits >> (-count);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   917
	}
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   918
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   919
	bits &= 0xFFFFFFFFL;
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   920
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   921
	RETURN (__MKINT(bits));
1506
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   922
    }
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   923
%}.
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   924
    ^ self primitiveFailed
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   925
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   926
    "
2824
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
   927
     128 bitShift:24   
1506
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   928
     128 bitShift32:24  
2824
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
   929
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
   930
     1 bitShift:31   
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
   931
     1 bitShift32:31  
1506
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   932
    "
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   933
!
3b4ff5941981 added bitShift32: for int32 arithmetic
Claus Gittinger <cg@exept.de>
parents: 1336
diff changeset
   934
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   935
bitShift:shiftCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
   936
    "return the value of the receiver shifted by shiftCount bits;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   937
     leftShift if shiftCount > 0; rightShift otherwise.
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   938
     Notice: the result of bitShift: on negative receivers is not 
4177
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   939
             defined in the language standard (since the implementation
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   940
             is free to choose any internal representation for integers)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   941
a27a279701f8 Initial revision
claus
parents:
diff changeset
   942
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   943
a27a279701f8 Initial revision
claus
parents:
diff changeset
   944
    INT bits, count;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   945
252
   946
    if (__isSmallInteger(shiftCount)) {
4177
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   947
        bits = __intVal(self);
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   948
        if (bits == 0) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   949
            RETURN (self);
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   950
        }
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   951
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   952
        count = __intVal(shiftCount);
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   953
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   954
        if (count > 0) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   955
            /*
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   956
             * a left shift
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   957
             */
4183
4a745f6f47b6 oops - longlong shift fails with i386,GCC
Claus Gittinger <cg@exept.de>
parents: 4177
diff changeset
   958
#if defined(USE_LONGLONG_FOR_SHIFT)
4177
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   959
            if (count <= N_INT_BITS) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   960
                unsigned LONGLONG result;
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   961
4183
4a745f6f47b6 oops - longlong shift fails with i386,GCC
Claus Gittinger <cg@exept.de>
parents: 4177
diff changeset
   962
                result = (unsigned LONGLONG)bits;
4177
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   963
                result <<= count;
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   964
                if (result <= _MAX_INT) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   965
                    RETURN ( __MKSMALLINT(result) );
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   966
                }
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   967
                {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   968
                    RETURN (__MKLARGEINT64(1, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   969
                }
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   970
            }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   971
#else
4177
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   972
            /*
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   973
             * check for overflow
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   974
             */
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   975
            if (count < (N_INT_BITS-1)) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   976
                if (! (bits >> (N_INT_BITS - 1 - count))) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   977
                    RETURN ( __MKSMALLINT(bits << count) );
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   978
                }
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   979
                /*
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   980
                 * so, there is an overflow ...
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   981
                 * handle it as largeInteger
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   982
                 */
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   983
                /* FALL THROUGH */
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   984
            }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   985
#endif
4177
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   986
        } else {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   987
            if (count == 0) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   988
                RETURN (self);
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   989
            }
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   990
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   991
            /*
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   992
             * right shifts cannot overflow
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   993
             *
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   994
             * some machines ignore shifts bigger than
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   995
             * the number of bits in an int ...
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   996
             */
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   997
            count = -count;
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   998
            if (count > (N_INT_BITS-1)) {
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
   999
                RETURN (__MKSMALLINT(0));
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
  1000
            }
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
  1001
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
  1002
            RETURN ( __MKSMALLINT(bits >> count) );
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
  1003
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1004
    }
85
claus
parents: 77
diff changeset
  1005
%}.
claus
parents: 77
diff changeset
  1006
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
4177
f73868159267 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4176
diff changeset
  1007
        ^ (LargeInteger value:self) bitShift:shiftCount
85
claus
parents: 77
diff changeset
  1008
    ].
6400
3746d31f044a bitShift:float trouble fixed.
Claus Gittinger <cg@exept.de>
parents: 6344
diff changeset
  1009
    ^ self bitShift:(1 coerce:shiftCount)   "/ is this a good idea ?
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1010
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1011
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1012
bitTest:aMask
5782
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1013
    "return true, if any bit from aMask is set in the receiver.
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1014
     I.e. true, if the bitwise-AND of the receiver and the argument, anInteger
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1015
     is non-0, false otherwise."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1016
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1017
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1018
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1019
    /* and all bits except tag */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1020
    if (__isSmallInteger(aMask)) {
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1021
        RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1022
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1023
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1024
    aMask class == LargeInteger ifTrue:[
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1025
        ^ (aMask bitAnd:self) ~~ 0
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1026
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1027
    ^ self retry:#bitTest: coercing:aMask
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1028
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1029
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1030
bitXor:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1031
    "return the bitwise-exclusive-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1032
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1033
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1034
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1035
    /* xoring the tags turns it off - or it in again */
252
  1036
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1037
	RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1038
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1039
%}.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1040
    ^ self retry:#bitXor: coercing:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1041
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1042
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1043
clearBit:anInteger
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1044
    "return a new number where the specified bit is off.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1045
     Bits are counted from 1 starting with the least significant.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1046
     The methods name may be missleading: the receiver is not changed,
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1047
     but a new number is returned. Should be named #withBitCleared:"
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1048
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1049
%{  /* NOCONTEXT */
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1050
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1051
    if (__isSmallInteger(anInteger)) {
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1052
        int index = __intVal(anInteger);
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1053
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1054
        if (index > 0) {
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1055
#ifdef alpha64
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1056
            if (index <= 62)
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1057
#else
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1058
            if (index <= 30)
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1059
#endif
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1060
            {
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1061
                INT mask = __MASKSMALLINT(1 << (index-1));
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1062
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1063
                RETURN ( ((OBJ) ((INT)self & ~(INT)mask)) );
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1064
            }
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1065
            RETURN (self);  /* nothing to do ... */
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1066
        }
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1067
    }
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1068
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1069
    ^ super clearBit:anInteger
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1070
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1071
    "
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1072
     (16r401 clearBit:1     ) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1073
     (16r401 clearBit:0     ) hexPrintString
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1074
     (16r3fffffff clearBit:1) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1075
     (16r3fffffff clearBit:29) hexPrintString  
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1076
     (16r3fffffff clearBit:30) hexPrintString  
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1077
     (16r3fffffff clearBit:31) hexPrintString  
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1078
     (16r3fffffff bitAt:29) hexPrintString     
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1079
     (16r3fffffff bitAt:30) hexPrintString     
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1080
     (16r3fffffff bitAt:31) hexPrintString       
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1081
     (16r40000001 clearBit:1) hexPrintString  
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1082
     (16rF0000001 clearBit:29) hexPrintString   
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1083
     (16rF0000001 clearBit:30) hexPrintString
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1084
     (16rF0000001 clearBit:31) hexPrintString 
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1085
     (16rF0000001 clearBit:32) hexPrintString 
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1086
    "
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1087
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1088
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1089
!
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1090
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1091
highBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1092
    "return the bitIndex of the highest bit set. The returned bitIndex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1093
     starts at 1 for the least significant bit. Returns -1 if no bit is set."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1094
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1095
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1096
4953
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1097
    INT bits;
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1098
#ifdef alpha64
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1099
    int INDEX0;
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1100
#endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1101
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1102
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1103
    if (bits == 0) {
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1104
        RETURN ( __MKSMALLINT(-1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1105
    }
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  1106
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1107
#ifdef __BSR
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1108
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1109
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1110
     * the following code is not faster on a PIII-400
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1111
     * (but saves a few code-bytes, though)
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1112
     */
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1113
    bits = __BSR(bits);
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1114
    RETURN ( __MKSMALLINT(bits + 1) );
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1115
#else
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1116
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1117
# ifdef alpha64
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1118
    INDEX0 = 0;
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1119
    if (bits & 0xFFFFFFFF00000000L) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1120
        INDEX0 = 32;
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1121
        bits = bits >> 32;
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1122
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1123
# else
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1124
#  define INDEX0 0
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1125
# endif
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  1126
4953
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1127
    /*
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1128
     * a binary search ...
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1129
     */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1130
    if ((bits & 0xFFFF0000) == 0) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1131
        if ((bits & 0x0000FF00) == 0) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1132
            if ((bits & 0x000000F0) == 0) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1133
                if ((bits & 0x0000000C) == 0) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1134
                    if (bits & 0x00000002) {          
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1135
                        RETURN (__MKSMALLINT(INDEX0+2) );     /* 0x00000002 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1136
                    }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1137
                    RETURN (__MKSMALLINT(INDEX0+1) );         /* 0x00000001 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1138
                } else {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1139
                    if (bits & 0x00000008) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1140
                        RETURN (__MKSMALLINT(INDEX0+4) );     /* 0x00000008 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1141
                    } 
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1142
                    RETURN (__MKSMALLINT(INDEX0+3) );         /* 0x00000004 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1143
                }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1144
            } else {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1145
                if ((bits & 0x000000C0) == 0) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1146
                    if (bits & 0x00000020) {          
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1147
                        RETURN (__MKSMALLINT(INDEX0+6) );     /* 0x00000020 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1148
                    }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1149
                    RETURN (__MKSMALLINT(INDEX0+5) );         /* 0x00000010 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1150
                } else {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1151
                    if (bits & 0x00000080) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1152
                        RETURN (__MKSMALLINT(INDEX0+8) );     /* 0x00000080 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1153
                    } 
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1154
                    RETURN (__MKSMALLINT(INDEX0+7) );         /* 0x00000040 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1155
                }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1156
            }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1157
        } else {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1158
            if (bits & 0x0000F000) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1159
                if (bits & 0x0000C000) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1160
                    if (bits & 0x00008000) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1161
                        RETURN (__MKSMALLINT(INDEX0+16) );    /* 0x00008000 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1162
                    } 
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1163
                    RETURN (__MKSMALLINT(INDEX0+15) );        /* 0x00004000 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1164
                } else {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1165
                    if (bits & 0x00002000) {          
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1166
                        RETURN (__MKSMALLINT(INDEX0+14) );    /* 0x00002000 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1167
                    }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1168
                    RETURN (__MKSMALLINT(INDEX0+13) );        /* 0x00001000 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1169
                }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1170
            } else {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1171
                if (bits & 0x00000C00) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1172
                    if (bits & 0x00000800) {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1173
                        RETURN (__MKSMALLINT(INDEX0+12) );    /* 0x00000800 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1174
                    } 
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1175
                    RETURN (__MKSMALLINT(INDEX0+11) );        /* 0x00000400 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1176
                } else {
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1177
                    if (bits & 0x00000200) {          
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1178
                        RETURN (__MKSMALLINT(INDEX0+10) );    /* 0x00000200 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1179
                    }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1180
                    RETURN (__MKSMALLINT(INDEX0+9) );         /* 0x00000100 */
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1181
                }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1182
            }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1183
        }
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1184
    } else {
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1185
        if (bits & 0xFF000000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1186
            if (bits & 0xF0000000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1187
                if (bits & 0xC0000000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1188
                    if (bits & 0x80000000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1189
                        RETURN (__MKSMALLINT(INDEX0+32) );    /* 0x80000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1190
                    } 
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1191
                    RETURN (__MKSMALLINT(INDEX0+31) );        /* 0x40000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1192
                } else {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1193
                    if (bits & 0x20000000) {          
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1194
                        RETURN (__MKSMALLINT(INDEX0+30) );    /* 0x20000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1195
                    }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1196
                    RETURN (__MKSMALLINT(INDEX0+29) );        /* 0x10000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1197
                }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1198
            } else {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1199
                if (bits & 0x0C000000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1200
                    if (bits & 0x08000000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1201
                        RETURN (__MKSMALLINT(INDEX0+28) );    /* 0x08000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1202
                    } 
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1203
                    RETURN (__MKSMALLINT(INDEX0+27) );        /* 0x04000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1204
                } else {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1205
                    if (bits & 0x02000000) {          
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1206
                        RETURN (__MKSMALLINT(INDEX0+26) );    /* 0x02000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1207
                    }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1208
                    RETURN (__MKSMALLINT(INDEX0+25) );        /* 0x01000000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1209
                }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1210
            }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1211
        } else {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1212
            if (bits & 0x00F00000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1213
                if (bits & 0x00C00000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1214
                    if (bits & 0x00800000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1215
                        RETURN (__MKSMALLINT(INDEX0+24) );    /* 0x00800000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1216
                    } 
4953
b021f07215b2 better highBit (using binary search)
Claus Gittinger <cg@exept.de>
parents: 4951
diff changeset
  1217
                    RETURN (__MKSMALLINT(INDEX0+23) );        /* 0x00400000 */
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1218
                } else {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1219
                    if (bits & 0x00200000) {          
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1220
                        RETURN (__MKSMALLINT(INDEX0+22) );    /* 0x00200000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1221
                    }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1222
                    RETURN (__MKSMALLINT(INDEX0+21) );        /* 0x00100000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1223
                }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1224
            } else {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1225
                if (bits & 0x000C0000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1226
                    if (bits & 0x00080000) {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1227
                        RETURN (__MKSMALLINT(INDEX0+20) );    /* 0x00080000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1228
                    } 
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1229
                    RETURN (__MKSMALLINT(INDEX0+19) );        /* 0x00040000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1230
                } else {
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1231
                    if (bits & 0x00020000) {          
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1232
                        RETURN (__MKSMALLINT(INDEX0+18) );    /* 0x00020000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1233
                    }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1234
                    RETURN (__MKSMALLINT(INDEX0+17) );        /* 0x00010000 */
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1235
                }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1236
            }
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1237
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1238
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1239
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1240
%}
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1241
    "
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1242
     ((0 to:64) collect:[:s | 1 bitShift:s])
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1243
        collect:[:n | n highBit]         
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1244
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1245
     (((0 to:64) collect:[:s | 1 bitShift:s])
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1246
        collect:[:n | n highBit]) = (1 to:65)     
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1247
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1248
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1249
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1250
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1251
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1252
            2r1 highBit
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1253
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1254
     ]   
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1255
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1256
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1257
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1258
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1259
            2r1111 highBit
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1260
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1261
     ]  
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1262
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1263
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1264
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1265
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1266
            2r11111111111111 highBit
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1267
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1268
     ]   
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1269
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1270
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1271
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1272
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1273
            2r11111111111111111111111111 highBit     
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1274
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1275
     ]   
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1276
    "
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1277
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1278
    "
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1279
     2r000100 highBit      
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1280
     2r010100 highBit      
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1281
     2r000001 highBit      
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1282
     0 highBit             
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1283
     SmallInteger maxVal highBit 
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1284
    "
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1285
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1286
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1287
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1288
invertBit:anInteger
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1289
    "return a new number where the specified bit is inverted.
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1290
     Bits are counted from 1 starting with the least significant.
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1291
     The methods name may be missleading: the receiver is not changed,
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1292
     but a new number is returned. Should be named #withBitInverted:"
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1293
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1294
%{  /* NOCONTEXT */
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1295
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1296
    if (__isSmallInteger(anInteger)) {
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1297
        int index = __intVal(anInteger);
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1298
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1299
        if (index > 0) {
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1300
#ifdef alpha64
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1301
            if (index <= 62)
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1302
#else
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1303
            if (index <= 30)
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1304
#endif
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1305
            {
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1306
                INT mask = __MASKSMALLINT(1 << (index-1));
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1307
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1308
                RETURN ( ((OBJ) ((INT)self ^ (INT)mask)) );
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1309
            }
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1310
        }
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1311
    }
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1312
%}.
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1313
    ^ super invertBit:anInteger
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1314
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1315
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1316
     (16r401 invertBit:2     ) hexPrintString      
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1317
     (16r401 invertBit:1     ) hexPrintString      
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1318
     (16r30000000 invertBit:1) hexPrintString     
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1319
     (16r40000000 invertBit:0) hexPrintString  
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1320
     (16r0 invertBit:29) hexPrintString             
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1321
     (16r0 invertBit:30) hexPrintString             
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1322
     (16r0 invertBit:31) hexPrintString             
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1323
     (16r0 invertBit:32) hexPrintString       
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1324
     (16r0 invertBit:33) hexPrintString       
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1325
     (16r0 invertBit:100) hexPrintString      
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1326
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1327
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1328
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1329
!
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1330
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1331
lowBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1332
    "return the bitIndex of the lowest bit set. The returned bitIndex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1333
     starts at 1 for the least significant bit. Returns -1 if no bit is set."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1334
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1335
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1336
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1337
    INT mask, index, bits;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1338
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1339
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1340
    if (bits == 0) {
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1341
        RETURN ( __MKSMALLINT(-1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1342
    }
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1343
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1344
#ifdef __BSF
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1345
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1346
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1347
     * the following code is only marginally faster on a PIII-400
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1348
     * (but saves a few code-bytes, though)
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1349
     */
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1350
    bits = __BSF(bits);
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1351
    RETURN ( __MKSMALLINT(bits + 1) );
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1352
#else
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1353
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1354
    if ((bits & 0xFFFFFF) == 0) {
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1355
        mask = 0x1000000;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1356
        index = 25;
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1357
    } else {
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1358
        if ((bits & 0xFFFF) == 0) {
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1359
            mask = 0x10000;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1360
            index = 17;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1361
        } else {
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1362
            if ((bits & 0xFF) == 0) {
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1363
                mask = 0x100;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1364
                index = 9;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1365
            } else {
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1366
                mask = 1;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1367
                index = 1;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1368
            }
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1369
        }
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1370
    }
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1371
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1372
# ifdef alpha64
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1373
    while (index != 63) {
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1374
# else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1375
    while (index != 31) {
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1376
# endif
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1377
        if (bits & mask) {
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1378
            RETURN ( __MKSMALLINT(index) );
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1379
        }
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1380
        mask = mask << 1;
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1381
        index++;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1382
    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1383
    RETURN ( __MKSMALLINT(-1) );
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1384
#endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1385
%}
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1386
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1387
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1388
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1389
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1390
            2r1000 lowBit
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1391
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1392
     ]  
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1393
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1394
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1395
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1396
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1397
            2r11110000000 lowBit
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1398
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1399
     ] 
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1400
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1401
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1402
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1403
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1404
            2r1000000000000 lowBit
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1405
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1406
     ]  
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1407
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1408
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1409
     Time millisecondsToRun:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1410
        1000000 timesRepeat:[
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1411
            2r1000000000000000000000000000 lowBit     
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1412
        ]
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1413
     ]  
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1414
    "
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1415
    "
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1416
     2r000100 lowBit
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1417
     2r010010 lowBit
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1418
     2r100001 lowBit
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1419
     16r1000 lowBit 
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1420
     16r1000000 lowBit 
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1421
     0 lowBit 
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1422
    "
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1423
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1424
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1425
setBit:anInteger
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1426
    "return a new number where the specified bit is on.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1427
     Bits are counted from 1 starting with the least significant.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1428
     The methods name may be missleading: the receiver is not changed,
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1429
     but a new number is returned. Should be named #withBitSet:"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1430
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1431
%{  /* NOCONTEXT */
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1432
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1433
    if (__isSmallInteger(anInteger)) {
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1434
        int index = __intVal(anInteger);
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1435
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1436
        if (index > 0) {
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1437
#ifdef alpha64
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1438
            if (index <= 62)
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1439
#else
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1440
            if (index <= 30)
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1441
#endif
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1442
            {
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1443
                INT mask = __MASKSMALLINT(1 << (index-1));
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1444
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1445
                RETURN ( ((OBJ) ((INT)self | (INT)mask)) );
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1446
            }
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1447
        }
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1448
    }
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1449
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1450
    ^ super setBit:anInteger
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1451
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1452
    "
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1453
     (16r401 setBit:2     ) hexPrintString      
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1454
     (16r30000000 setBit:1) hexPrintString     
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1455
     (16r40000000 setBit:0) hexPrintString  
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1456
     (16r0 setBit:29) hexPrintString             
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1457
     (16r0 setBit:30) hexPrintString             
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1458
     (16r0 setBit:31) hexPrintString             
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1459
     (16r0 setBit:32) hexPrintString       
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1460
     (16r0 setBit:33) hexPrintString       
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1461
     (16r0 setBit:100) hexPrintString      
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1462
    "
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1463
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1464
6415
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1465
!
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1466
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1467
unsignedBitShift32:shiftCount
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1468
    "return the value of the receiver shifted by shiftCount bits,
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1469
     but only within 32 unsigned bits.
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1470
     May be useful for communication interfaces, to create ST-numbers
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1471
     from an unsigned 32bit int value given as individual byte,
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1472
     or to emulate C/Java semantics."
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1473
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1474
%{  /* NOCONTEXT */
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1475
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1476
    unsigned INT bits;
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1477
    INT count;
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1478
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1479
    if (__isSmallInteger(shiftCount)) {
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1480
        count = __intVal(shiftCount);
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1481
        if (count >= 32) {
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1482
            RETURN (__MKSMALLINT(0));
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1483
        }
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1484
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1485
        bits = __intVal(self);
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1486
        if (count > 0) {
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1487
            bits = bits << count;
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1488
        } else {
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1489
            bits = bits >> (-count);
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1490
        }
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1491
#ifdef alpha64
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1492
        bits &= 0xFFFFFFFFL;
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1493
#endif
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1494
        RETURN (__MKUINT(bits));
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1495
    }
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1496
%}.
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1497
    ^ self primitiveFailed
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1498
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1499
    "
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1500
     128 unsignedBitShift:24   
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1501
     128 unsignedBitShift32:24  
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1502
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1503
     1 unsignedBitShift:31   
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1504
     1 unsignedBitShift32:31 
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1505
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1506
     -1 unsignedBitShift32:-1  
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1507
     -1 unsignedBitShift32:1  
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1508
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1509
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1510
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1511
!SmallInteger methodsFor:'byte access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1512
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1513
digitAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1514
    "return 8 bits of value, starting at byte index"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1515
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1516
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1517
357
claus
parents: 329
diff changeset
  1518
    REGISTER INT val;
claus
parents: 329
diff changeset
  1519
    INT idx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1520
252
  1521
    if (__isSmallInteger(index)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1522
	val = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1523
	if (val < 0)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1524
	    val = -val;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1525
	switch (idx = __intVal(index)) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1526
	    case 1:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1527
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1528
	    case 2:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1529
		val = (val >> 8);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1530
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1531
	    case 3:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1532
		val = (val >> 16);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1533
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1534
	    case 4:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1535
		val = (val >> 24);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1536
		break;
2653
6d9354cf956d prep for alpha
Claus Gittinger <cg@exept.de>
parents: 2650
diff changeset
  1537
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1538
	    case 5:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1539
		val = (val >> 32);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1540
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1541
	    case 6:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1542
		val = (val >> 40);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1543
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1544
	    case 7:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1545
		val = (val >> 48);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1546
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1547
	    case 8:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1548
		val = (val >> 56);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1549
		break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1550
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1551
	    default:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1552
		if (idx < 1)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1553
		    goto bad;   /* sorry */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1554
		RETURN (__MKSMALLINT(0));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1555
	}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1556
	RETURN ( __MKSMALLINT( val & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1557
    }
357
claus
parents: 329
diff changeset
  1558
  bad: ;
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1559
%}.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1560
    index > 0 ifFalse:[
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1561
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1562
	 index less than 1 - not allowed
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1563
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1564
	^ self primitiveFailed
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1565
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1566
    ^ 0
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1567
357
claus
parents: 329
diff changeset
  1568
    "
claus
parents: 329
diff changeset
  1569
     (16r12345678 digitAt:1) printStringRadix:16
claus
parents: 329
diff changeset
  1570
     (16r12345678 digitAt:3) printStringRadix:16
claus
parents: 329
diff changeset
  1571
     (16r12345678 digitAt:15) printStringRadix:16
claus
parents: 329
diff changeset
  1572
     (16r12345678 digitAt:0) printStringRadix:16
claus
parents: 329
diff changeset
  1573
     (16r12345678 digitAt:-10) printStringRadix:16
claus
parents: 329
diff changeset
  1574
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1575
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1576
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1577
digitByteAt:index
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1578
    "return 8 bits of my signed value, starting at byte index.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1579
     For positive receivers, this is the same as #digitAt:;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1580
     for negative ones, the actual bit representation is returned."
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1581
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1582
%{  /* NOCONTEXT */
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1583
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1584
    REGISTER INT val;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1585
    INT idx;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1586
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1587
    if (__isSmallInteger(index)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1588
	val = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1589
	switch (idx = __intVal(index)) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1590
	    case 1:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1591
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1592
	    case 2:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1593
		val = (val >> 8);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1594
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1595
	    case 3:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1596
		val = (val >> 16);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1597
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1598
	    case 4:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1599
		val = (val >> 24);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1600
		break;
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1601
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1602
	    case 5:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1603
		val = (val >> 32);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1604
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1605
	    case 6:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1606
		val = (val >> 40);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1607
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1608
	    case 7:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1609
		val = (val >> 48);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1610
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1611
	    case 8:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1612
		val = (val >> 56);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1613
		break;
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1614
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1615
	    default:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1616
		if (idx < 1)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1617
		    goto bad;   /* sorry */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1618
		if (val < 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1619
		    RETURN (__MKSMALLINT(0xFF));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1620
		}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1621
		RETURN (__MKSMALLINT(0));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1622
	}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1623
	RETURN ( __MKSMALLINT( val & 0xFF) );
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1624
    }
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1625
  bad: ;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1626
%}.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1627
    index > 0 ifFalse:[
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1628
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1629
	 index less than 1 - not allowed
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1630
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1631
	^ self primitiveFailed
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1632
    ].
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1633
    ^ 0
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1634
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1635
    "
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1636
     (10 digitByteAt:1) printStringRadix:16 
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1637
     (10 digitByteAt:3) printStringRadix:16 
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1638
     (-10 digitByteAt:1) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1639
     (-10 digitByteAt:3) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1640
    "
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1641
!
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1642
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1643
digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1644
    "return a byteArray filled with the receivers bits
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1645
     (8 bits of the absolute value per element),
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1646
     least significant byte is first"
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1647
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1648
    ^ self asLargeInteger digitBytes.
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1649
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1650
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1651
      16r12 digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1652
      16r1234 digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1653
      16r12345678 digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1654
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1655
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1656
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1657
digitBytesMSB:msbFlag
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1658
    "return a byteArray filled with the receivers bits
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1659
     (8 bits of the absolute value per element),
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1660
     if msbflag = true, most significant byte is first,
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1661
     otherwise least significant byte is first"
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1662
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1663
    ^ self asLargeInteger digitBytesMSB:msbFlag.
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1664
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1665
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1666
      16r12 digitBytesMSB:true
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1667
      16r1234 digitBytesMSB:true
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1668
      16r1234 digitBytesMSB:false
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1669
      16r12345678 digitBytesMSB:true
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1670
      16r12345678 digitBytesMSB:false
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1671
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1672
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1673
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1674
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1675
digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1676
    "return the number bytes required to represent this Integer.
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1677
     For negative receivers, the digitLength of its absolute value
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1678
     is returned."
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1679
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1680
%{  /* NOCONTEXT */
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1681
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1682
    INT val = __intVal(self);
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1683
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1684
    if (val < 0) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1685
	val = -val;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1686
    }
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1687
#ifdef alpha64
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1688
    if (val & 0xFFFFFFFF00000000L) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1689
	if (val & 0xFFFF000000000000L) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1690
	    if (val & 0xFF00000000000000L) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1691
		RETURN ( __MKSMALLINT(8));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1692
	    } else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1693
		RETURN ( __MKSMALLINT(7));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1694
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1695
	} else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1696
	    if (val & 0x0000FF0000000000L) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1697
		RETURN ( __MKSMALLINT(6));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1698
	    } else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1699
		RETURN ( __MKSMALLINT(5));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1700
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1701
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1702
    }
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1703
#endif
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1704
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1705
    if (val & 0xFFFF0000) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1706
	if (val & 0xFF000000) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1707
	    RETURN ( __MKSMALLINT(4));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1708
	} else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1709
	    RETURN ( __MKSMALLINT(3));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1710
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1711
    } else {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1712
	if (val & 0x0000FF00) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1713
	    RETURN ( __MKSMALLINT(2));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1714
	} else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1715
	    RETURN ( __MKSMALLINT(1));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1716
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1717
    }
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1718
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1719
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1720
    ^ self abs highBit - 1 // 8 + 1
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1721
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1722
    "
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1723
     16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1724
     -16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1725
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1726
     16rFF000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1727
     16rFF0000 digitLength  
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1728
     16rFF00 digitLength    
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1729
     16rFF digitLength      
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1730
     -16rFF000000 digitLength 
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1731
     -16rFF0000 digitLength  
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1732
     -16rFF00 digitLength   
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1733
     -16rFF digitLength    
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1734
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1735
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1736
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1737
!SmallInteger methodsFor:'catching messages'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1738
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1739
basicAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1740
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1741
     defined here since basicAt: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1742
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1743
    self notIndexed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1744
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1745
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1746
basicAt:index put:anObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1747
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1748
     defined here since basicAt:put: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1749
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1750
    self notIndexed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1751
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1752
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1753
basicSize
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1754
    "return the number of indexed instvars - SmallIntegers have none.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1755
     Defined here since basicSize in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1756
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1757
    ^ 0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1758
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1759
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1760
size
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1761
    "return the number of indexed instvars - SmallIntegers have none."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1762
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1763
    ^ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1764
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1765
5240
2a91958ba1f1 categories
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1766
!SmallInteger methodsFor:'coercing & converting'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1767
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1768
asCharacter
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1769
    "Return a character with the receiver as ascii value"
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  1770
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1771
    ^ Character value:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1772
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1773
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1774
asFloat
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1775
    "return a Float with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1776
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1777
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1778
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1779
    OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1780
    double dVal = (double)__intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1781
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1782
    __qMKFLOAT(newFloat, dVal);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1783
    RETURN ( newFloat );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1784
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1785
    ^ self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1786
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1787
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1788
asLargeInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1789
    "return a LargeInteger with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1790
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1791
    ^ LargeInteger value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1792
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1793
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1794
asShortFloat
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1795
    "return a ShortFloat with same value as receiver"
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1796
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1797
%{  /* NOCONTEXT */
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1798
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1799
    OBJ dummy = @global(ShortFloat);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1800
    OBJ newFloat;
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1801
    float fVal = (float)__intVal(self);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1802
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1803
    __qMKSFLOAT(newFloat, fVal);
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1804
    RETURN ( newFloat );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1805
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1806
    ^ self primitiveFailed
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1807
!
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  1808
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1809
coerce:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1810
    "return aNumber converted into receivers type"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1811
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1812
    ^ aNumber asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1813
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1814
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1815
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1816
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1817
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1818
    ^ 20
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1819
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1820
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1821
signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1822
    "return a smallInteger from sign-extending the 8'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1823
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1824
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1825
%{  /* NOCONTEXT */
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  1826
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1827
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1828
    if (i & 0x80) {
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1829
        i = i | ~0xFFL;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1830
    } else {
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1831
        i = i & 0x7F;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1832
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1833
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1834
    RETURN (__MKSMALLINT(i));
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1835
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1836
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1837
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1838
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1839
     16rFF signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1840
     16r7F signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1841
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1842
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1843
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1844
signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1845
    "return a smallInteger from sign-extending the 16'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1846
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1847
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1848
%{  /* NOCONTEXT */
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  1849
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1850
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1851
    if (i & 0x8000) {
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1852
        i = i | ~0xFFFFL;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1853
    } else {
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1854
        i = i & 0x7FFF;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1855
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1856
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1857
    RETURN (__MKSMALLINT(i));
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1858
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1859
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1860
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1861
    "
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1862
     16rFFFF signExtendedShortValue 
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1863
     16r7FFF signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  1864
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1865
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1866
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1867
!SmallInteger methodsFor:'comparing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1868
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1869
< aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1870
    "return true, if the argument is greater than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1871
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1872
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1873
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1874
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1875
#ifdef POSITIVE_ADDRESSES
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1876
	RETURN ( (__intVal(self) < __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1877
#else
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1878
	/* tag bit does not change ordering */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1879
	RETURN ( ((INT)self < (INT)aNumber) ? true : false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1880
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1881
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1882
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1883
	RETURN ( ((double)__intVal(self) < __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1884
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1885
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1886
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1887
    ^ aNumber lessFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1888
    "^ self retry:#< coercing:aNumber"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1889
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1890
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1891
<= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1892
    "return true, if the argument is greater or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1893
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1894
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1895
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1896
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1897
#ifdef POSITIVE_ADDRESSES
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1898
        RETURN ( (__intVal(self) <= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1899
#else
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1900
        /* tag bit does not change ordering */
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1901
        RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1902
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1903
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1904
    if (__isFloatLike(aNumber)) {
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1905
        RETURN ( ((double)__intVal(self) <= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1906
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1907
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1908
    ^ (self > aNumber) not
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1909
"/    ^ self retry:#<= coercing:aNumber
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1910
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1911
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1912
= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1913
    "return true, if the arguments value is equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1914
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1915
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1916
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1917
    if (aNumber == self) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1918
	RETURN ( true );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1919
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1920
    if (! __isNonNilObject(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1921
	/* a smallint or nil */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1922
	RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1923
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1924
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1925
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1926
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1927
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1928
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1929
.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1930
    aNumber respondsToArithmetic ifFalse:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1931
    ^ self retry:#= coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1932
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1933
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1934
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1935
    "return true, if the argument is less than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1936
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1937
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1938
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1939
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1940
#ifdef POSITIVE_ADDRESSES
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1941
        RETURN ( (__intVal(self) > __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1942
#else
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1943
        /* tag bit does not change ordering */
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1944
        RETURN ( ((INT)self > (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1945
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1946
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1947
    if (__isFloatLike(aNumber)) {
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1948
        RETURN ( ((double)__intVal(self) > __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1949
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1950
%}.
6092
ff6ac7fb2dee avoid endless recursion when trying to evaluate anInt < aSymbol
Claus Gittinger <cg@exept.de>
parents: 6067
diff changeset
  1951
    aNumber respondsToArithmetic ifTrue:[
ff6ac7fb2dee avoid endless recursion when trying to evaluate anInt < aSymbol
Claus Gittinger <cg@exept.de>
parents: 6067
diff changeset
  1952
        ^ (aNumber < self)
ff6ac7fb2dee avoid endless recursion when trying to evaluate anInt < aSymbol
Claus Gittinger <cg@exept.de>
parents: 6067
diff changeset
  1953
    ].
ff6ac7fb2dee avoid endless recursion when trying to evaluate anInt < aSymbol
Claus Gittinger <cg@exept.de>
parents: 6067
diff changeset
  1954
    ^ aNumber greaterFromInteger:self
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1955
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1956
"/    ^ self retry:#> coercing:aNumber
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1957
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1958
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1959
>= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1960
    "return true, if the argument is less or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1961
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1962
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1963
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1964
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1965
#ifdef POSITIVE_ADDRESSES
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1966
        RETURN ( (__intVal(self) >= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1967
#else
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1968
        /* tag bit does not change ordering */
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1969
        RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1970
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1971
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1972
    if (__isFloatLike(aNumber)) {
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1973
        RETURN ( ((double)__intVal(self) >= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1974
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1975
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1976
    ^ (self < aNumber) not
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  1977
    "/ ^ self retry:#>= coercing:aNumber
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1978
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1979
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1980
hash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1981
    "return an integer useful for hashing on value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1982
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1983
    self >= 0 ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1984
    ^ self negated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1985
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1986
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1987
identityHash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1988
    "return an integer useful for hashing on identity"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1989
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  1990
     self >= 0 ifTrue:[^ self].
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  1991
     ^ self negated
1963
ea26c7b9ca1d experimental: new hash value for smallInts
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  1992
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  1993
    "Modified: 11.11.1996 / 18:42:14 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1994
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1995
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1996
max:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1997
    "return the receiver or the argument, whichever is greater"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1998
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1999
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2000
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2001
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2002
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2003
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2004
	if ((INT)(self) > (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2005
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2006
	if (__intVal(self) > __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2007
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2008
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2009
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2010
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2011
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2012
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2013
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2014
	if ( (double)__intVal(self) > __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2015
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2016
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2017
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2018
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2019
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2020
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2021
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2022
    (self > aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2023
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2024
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2025
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2026
min:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2027
    "return the receiver or the argument, whichever is smaller"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2028
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2029
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2030
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2031
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2032
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2033
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2034
	if ((INT)(self) < (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2035
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2036
	if (__intVal(self) < __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2037
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2038
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2039
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2040
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2041
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2042
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2043
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2044
	if ( (double)__intVal(self) < __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2045
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2046
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2047
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2048
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2049
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2050
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2051
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2052
    (self < aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2053
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2054
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2055
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2056
~= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2057
    "return true, if the arguments value is not equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2058
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2059
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2060
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2061
    if (aNumber == self) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2062
	RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2063
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2064
    if (! __isNonNilObject(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2065
	/* a smallint or nil */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2066
	RETURN ( true );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2067
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2068
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2069
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2070
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? false : true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2071
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2072
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2073
    aNumber respondsToArithmetic ifFalse:[^ true].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2074
    ^ self retry:#~= coercing:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2075
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2076
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2077
!SmallInteger methodsFor:'copying'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2078
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2079
deepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2080
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2081
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2082
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2083
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2084
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2085
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2086
deepCopyUsing:aDictionary
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2087
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2088
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2089
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2090
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2091
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2092
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2093
shallowCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2094
    "return a shallow copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2095
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2096
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2097
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2098
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2099
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2100
simpleDeepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2101
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2102
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2103
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2104
    ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2105
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2106
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2107
!SmallInteger methodsFor:'iteration'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2108
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2109
timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  2110
    "evaluate the argument, aBlock self times.
claus
parents: 329
diff changeset
  2111
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2112
357
claus
parents: 329
diff changeset
  2113
%{
claus
parents: 329
diff changeset
  2114
    REGISTER INT tmp;
claus
parents: 329
diff changeset
  2115
    static struct inlineCache blockVal = __ILC0(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2116
357
claus
parents: 329
diff changeset
  2117
    tmp = __intVal(self);
claus
parents: 329
diff changeset
  2118
    if (tmp > 0) {
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2119
        if (__isBlockLike(aBlock)
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2120
         && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(0))) {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2121
            {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2122
                REGISTER OBJFUNC codeVal;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2123
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2124
                /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2125
                 * specially tuned version for compiled blocks, 
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2126
                 * (the most common case)
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2127
                 */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2128
                if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2129
#ifdef PARANOIA
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2130
                 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2131
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2132
                ) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2133
357
claus
parents: 329
diff changeset
  2134
#ifdef NEW_BLOCK_CALL
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2135
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2136
#                   define BLOCK_ARG  aBlock
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2137
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2138
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2139
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2140
#                   define BLOCK_ARG  rHome
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2141
                    REGISTER OBJ rHome;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2142
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2143
                    /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2144
                     * home on stack - no need to refetch
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2145
                     */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2146
                    rHome = __BlockInstPtr(aBlock)->b_home;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2147
                    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2148
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2149
                    {
2604
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  2150
#ifdef WIN32
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  2151
# undef UNROLL_LOOPS
7f11d9ba8d03 NT compiler has trouble with unrolled loops ...
Claus Gittinger <cg@exept.de>
parents: 2470
diff changeset
  2152
#endif
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2153
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2154
#ifdef UNROLL_LOOPS
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2155
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2156
                        /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2157
                         * you are not supposed to program like this - I know what I do
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2158
                         */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2159
                        while (tmp > 8) {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2160
                            if (InterruptPending != nil) goto interrupted0;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2161
        continue0:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2162
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2163
                            if (InterruptPending != nil) goto interrupted1;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2164
        continue1:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2165
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2166
                            if (InterruptPending != nil) goto interrupted2;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2167
        continue2:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2168
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2169
                            if (InterruptPending != nil) goto interrupted3;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2170
        continue3:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2171
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2172
                            if (InterruptPending != nil) goto interrupted4;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2173
        continue4:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2174
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2175
                            if (InterruptPending != nil) goto interrupted5;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2176
        continue5:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2177
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2178
                            if (InterruptPending != nil) goto interrupted6;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2179
        continue6:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2180
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2181
                            if (InterruptPending != nil) goto interrupted7;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2182
        continue7:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2183
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2184
                            tmp -= 8;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2185
                        }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2186
#endif /* UNROLL_LOOPS */
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2187
                        do {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2188
                            if (InterruptPending != nil) goto interruptedX;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2189
        continueX:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2190
                            (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2191
                        } while(--tmp);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2192
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2193
                        RETURN (self);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2194
                        if (0) {
2824
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  2195
#ifdef UNROLL_LOOPS
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2196
                            interrupted0:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2197
                                                __interruptL(@line); goto continue0;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2198
                            interrupted1:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2199
                                                __interruptL(@line); goto continue1;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2200
                            interrupted2:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2201
                                                __interruptL(@line); goto continue2;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2202
                            interrupted3:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2203
                                                __interruptL(@line); goto continue3;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2204
                            interrupted4:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2205
                                                __interruptL(@line); goto continue4;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2206
                            interrupted5:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2207
                                                __interruptL(@line); goto continue5;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2208
                            interrupted6:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2209
                                                __interruptL(@line); goto continue6;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2210
                            interrupted7:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2211
                                                __interruptL(@line); goto continue7;
2824
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  2212
#endif /* UNROLL_LOOPS */
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2213
                            interruptedX:
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2214
                                                __interruptL(@line); goto continueX;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2215
                        }
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2216
                    }
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2217
                }
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2218
            }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  2219
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2220
#           undef BLOCK_ARG
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  2221
400
claus
parents: 394
diff changeset
  2222
#ifdef NEW_BLOCK_CALL
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2223
#           define BLOCK_ARG  aBlock
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2224
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  2225
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2226
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2227
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  2228
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  2229
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2230
            /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2231
             * sorry - must check for the blocks code within the loops;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2232
             * it could be recompiled or flushed (in the interrupt)
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2233
             */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2234
            do {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2235
                REGISTER OBJFUNC codeVal;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2236
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2237
                if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2238
                    /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2239
                     * arg is a compiled block with code -
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2240
                     * directly call it without going through Block>>value
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2241
                     * however, if there is an interrupt, refetch the code pointer.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2242
                     */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2243
                    /* stay here, while no interrupts are pending ... */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2244
                    do {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2245
                        (*codeVal)(BLOCK_ARG);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2246
                        if (InterruptPending != nil) goto outerLoop;
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2247
                    } while (--tmp);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2248
                    RETURN (self);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2249
                } else {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2250
                    if (InterruptPending != nil) __interruptL(@line);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2251
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2252
                    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2253
                        /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2254
                         * arg is a compiled block with bytecode -
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2255
                         * directly call interpreter without going through Block>>value
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2256
                         */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2257
                        __interpret(aBlock, 0, nil, IBLOCK_ARG, nil, nil);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2258
                    } else {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2259
                        /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2260
                         * arg is something else - call it with #value
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2261
                         */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2262
                        (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2263
                    }
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2264
                }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2265
    outerLoop: ;
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2266
            } while (--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2267
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2268
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2269
#           undef IBLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2270
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2271
            RETURN (self);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2272
        }
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2273
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2274
        /*
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2275
         * not a block-like thingy - call it with #value
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2276
         */
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2277
        do {
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2278
            if (InterruptPending != nil) __interruptL(@line);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2279
            (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2280
        } while(--tmp);
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2281
        RETURN (self);
357
claus
parents: 329
diff changeset
  2282
    }
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2283
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2284
    ^ super timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  2285
claus
parents: 329
diff changeset
  2286
"/    |count "{ Class: SmallInteger }" |
claus
parents: 329
diff changeset
  2287
"/
claus
parents: 329
diff changeset
  2288
"/    count := self.
claus
parents: 329
diff changeset
  2289
"/    [count > 0] whileTrue:[
claus
parents: 329
diff changeset
  2290
"/        aBlock value.
claus
parents: 329
diff changeset
  2291
"/        count := count - 1
claus
parents: 329
diff changeset
  2292
"/    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2293
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2294
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2295
to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2296
    "reimplemented as primitive for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2297
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2298
%{
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2299
    REGISTER INT tmp, step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2300
    REGISTER INT final;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2301
    static struct inlineCache blockVal = __ILC1(0);
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2302
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2303
    if (__bothSmallInteger(incr, stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2304
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2305
	final = __intVal(stop);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2306
	step = __intVal(incr);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2307
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2308
	if (__isBlockLike(aBlock)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2309
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2310
	    {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2311
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2312
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2313
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2314
		 * specially tuned version for static compiled blocks, called with
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2315
		 * home on the stack (the most common case)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2316
		 */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2317
		if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2318
#ifdef PARANOIA
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2319
		 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2320
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2321
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2322
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2323
#ifdef NEW_BLOCK_CALL
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2324
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2325
#                   define BLOCK_ARG  aBlock
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2326
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2327
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2328
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2329
#                   define BLOCK_ARG  rHome
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2330
		    REGISTER OBJ rHome;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2331
		    rHome = __BlockInstPtr(aBlock)->b_home;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2332
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2333
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2334
#endif
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2335
		    {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2336
			if (step < 0) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2337
			    if (step == -1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2338
				while (tmp >= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2339
				    if (InterruptPending != nil) __interruptL(@line);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2340
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2341
				    tmp--;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2342
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2343
			    } else {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2344
				while (tmp >= final) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2345
				    if (InterruptPending != nil) __interruptL(@line);
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2346
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2347
				    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2348
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2349
			    }
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2350
			} else {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2351
			    if (step == 1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2352
				while (tmp <= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2353
				    if (InterruptPending != nil) __interruptL(@line);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2354
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2355
				    tmp++;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2356
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2357
			    } else {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2358
				while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2359
				    if (InterruptPending != nil) __interruptL(@line);
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2360
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2361
				    tmp += step;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2362
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2363
			    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2364
			}
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2365
			RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2366
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2367
		}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2368
	    }
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2369
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2370
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2371
	     * sorry - must check for the blocks code within the loops;
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2372
	     * it could be recompiled or flushed (in the interrupt)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2373
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2374
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2375
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2376
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2377
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2378
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2379
#           define IBLOCK_ARG nil
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2380
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2381
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2382
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2383
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2384
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2385
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2386
		while (tmp >= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2387
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2388
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2389
		    if (InterruptPending != nil) __interruptL(@line);
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2390
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2391
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2392
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2393
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2394
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2395
			 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2396
			(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2397
		    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2398
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2399
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2400
			     * arg is a compiled block with bytecode -
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2401
			     * directly call interpreter without going through Block>>value
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2402
			     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2403
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2404
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2405
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2406
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2407
				idx = __MKSMALLINT(tmp);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2408
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2409
			    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2410
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2411
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2412
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2413
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2414
			} else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2415
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2416
			     * arg is something else - call it with #value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2417
			     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2418
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2419
			}
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2420
		    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2421
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2422
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2423
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2424
		while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2425
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2426
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2427
		    if (InterruptPending != nil) __interruptL(@line);
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2428
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2429
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2430
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2431
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2432
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2433
			 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2434
			(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2435
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2436
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2437
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2438
			     * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2439
			     * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2440
			     */
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2441
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2442
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2443
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2444
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2445
				idx = __MKSMALLINT(tmp);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2446
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2447
			    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2448
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2449
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2450
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2451
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2452
			} else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2453
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2454
			     * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2455
			     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2456
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2457
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2458
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2459
		    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2460
		}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2461
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2462
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2463
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2464
#           undef IBLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2465
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2466
	} else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2467
	    /*
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2468
	     * arg is something else - call it with #value:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2469
	     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2470
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2471
		while (tmp >= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2472
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2473
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2474
		    (*blockVal.ilc_func)(aBlock, 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2475
					 @symbol(value:), 
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  2476
					 nil, &blockVal,
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2477
					 __MKSMALLINT(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2478
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2479
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2480
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2481
		while (tmp <= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2482
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2483
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2484
		    (*blockVal.ilc_func)(aBlock, 
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2485
					 @symbol(value:), 
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  2486
					 nil, &blockVal,
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2487
					 __MKSMALLINT(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2488
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2489
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2490
	    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2491
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2492
	RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2493
    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  2494
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2495
    "/
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2496
    "/ arrive here if stop is not a smallInteger
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2497
    "/ pass on to super ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2498
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2499
    ^ super to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2500
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2501
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2502
     1 to:10 by:3 do:[:i | i printNewline]
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2503
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2504
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2505
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2506
to:stop do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2507
    "evaluate aBlock for every integer between (and including) the receiver
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2508
     and the argument, stop.
357
claus
parents: 329
diff changeset
  2509
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2510
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2511
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2512
    REGISTER INT tmp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2513
    INT final;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  2514
    static struct inlineCache blockVal = __ILC1(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2515
252
  2516
    if (__isSmallInteger(stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2517
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2518
	final = __intVal(stop);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2519
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2520
	if (__isBlockLike(aBlock)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2521
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2522
	    {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2523
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2524
		 * specially tuned version for the most common case,
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2525
		 * where called with home on the stack
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2526
		 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2527
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2528
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2529
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2530
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2531
#ifdef NEW_BLOCK_CALL
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2532
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2533
#                   define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2534
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2535
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2536
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2537
#                   define BLOCK_ARG  rHome
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2538
		    REGISTER OBJ rHome;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2539
		    rHome = __BlockInstPtr(aBlock)->b_home;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2540
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2541
#endif
400
claus
parents: 394
diff changeset
  2542
		    {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2543
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2544
#ifdef PARANOIA
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2545
			if (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC))) 
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2546
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2547
			{
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2548
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2549
			     * static compiled blocks ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2550
			     */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2551
#ifdef UNROLL_LOOPS
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2552
			    /*
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2553
			     * The following code is designed to run as fast as possible;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2554
			     *  - taken branches only if interrupts are pending
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2555
			     *  - only forward branches (which are usually predicted as not taken)
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2556
			     *  - unrolled the loop
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2557
			     *
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2558
			     * you are not supposed to program like this - I know what I do
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2559
			     */
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2560
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2561
			    INT t8 = (INT)(__MKSMALLINT(tmp+8));
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2562
			    tmp = (INT)(__MKSMALLINT(tmp));
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2563
			    final = (INT)(__MKSMALLINT(final));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2564
# else
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2565
			    INT t8 = tmp+8;
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2566
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2567
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2568
			    for (;;) {
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2569
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2570
				while (t8 <= final) {
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2571
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2572
				    t8 += (INT)(__MASKSMALLINT(8));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2573
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2574
				    t8 += 8;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2575
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2576
				    if (InterruptPending != nil) goto interrupted0;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2577
	continue0:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2578
# if TAG_INT==1
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2579
				    (*codeVal)(BLOCK_ARG, tmp);
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2580
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2581
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2582
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2583
				    if (InterruptPending != nil) goto interrupted1;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2584
	continue1:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2585
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2586
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(1)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2587
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2588
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+1));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2589
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2590
				    if (InterruptPending != nil) goto interrupted2;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2591
	continue2:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2592
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2593
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(2)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2594
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2595
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+2));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2596
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2597
				    if (InterruptPending != nil) goto interrupted3;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2598
	continue3:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2599
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2600
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(3)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2601
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2602
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+3));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2603
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2604
				    if (InterruptPending != nil) goto interrupted4;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2605
	continue4:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2606
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2607
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(4)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2608
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2609
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+4));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2610
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2611
				    if (InterruptPending != nil) goto interrupted5;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2612
	continue5:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2613
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2614
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(5)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2615
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2616
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+5));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2617
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2618
				    if (InterruptPending != nil) goto interrupted6;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2619
	continue6:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2620
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2621
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(6)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2622
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2623
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+6));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2624
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2625
				    if (InterruptPending != nil) goto interrupted7;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2626
	continue7:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2627
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2628
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(7)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2629
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2630
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+7));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2631
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2632
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2633
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2634
				    tmp += (INT)(__MASKSMALLINT(8));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2635
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2636
				    tmp += 8;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2637
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2638
				}
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2639
				while (tmp <= final) {
2824
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  2640
				    if (InterruptPending != nil) goto interruptedX;
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  2641
	continueX:
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2642
# if TAG_INT==1
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2643
				    (*codeVal)(BLOCK_ARG, tmp);
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2644
				    tmp += (INT)(__MASKSMALLINT(1));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2645
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2646
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2647
				    tmp++;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2648
# endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2649
				}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2650
				RETURN (self);
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2651
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2652
				if (0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2653
				    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2654
				     * no discussion about those gotos ...
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2655
				     * ... its better for your CPU's pipelines
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2656
				     * (if you dont understand why, just dont argue).
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2657
				     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2658
				    interrupted7:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2659
						    __interruptL(@line); goto continue7;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2660
				    interrupted6:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2661
						    __interruptL(@line); goto continue6;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2662
				    interrupted5:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2663
						    __interruptL(@line); goto continue5;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2664
				    interrupted4:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2665
						    __interruptL(@line); goto continue4;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2666
				    interrupted3:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2667
						    __interruptL(@line); goto continue3;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2668
				    interrupted2:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2669
						    __interruptL(@line); goto continue2;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2670
				    interrupted1:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2671
						    __interruptL(@line); goto continue1;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2672
				    interrupted0:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2673
						    __interruptL(@line); goto continue0;
2824
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  2674
				    interruptedX:
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  2675
						    __interruptL(@line); goto continueX;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2676
				}
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2677
			    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  2678
#else
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2679
			    while (tmp <= final) {
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2680
				if (InterruptPending != nil) __interruptL(@line);
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2681
				(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2682
				tmp ++;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2683
			    }
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2684
			    RETURN (self);
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  2685
#endif /* UNROLL_LOOPS */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2686
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2687
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2688
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2689
			 * mhmh - seems to be a block with dynamic code
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2690
			 * must refetch, to allow dynamic recompilation or code flush.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2691
			 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2692
			while (tmp <= final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2693
			    if (InterruptPending != nil) __interruptL(@line);
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2694
			    if ((codeVal = __BlockInstPtr(aBlock)->b_code) == (OBJFUNC)nil) break;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2695
			    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2696
			    tmp ++;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2697
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2698
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2699
			if (tmp > final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2700
			    RETURN (self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2701
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2702
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2703
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2704
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2705
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2706
#           undef BLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2707
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2708
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2709
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2710
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  2711
#else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2712
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2713
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  2714
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  2715
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2716
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2717
	     * sorry - must check for the blocks code within the loops;
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2718
	     * it could be recompiled or flushed (in the interrupt)
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2719
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2720
	    while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2721
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2722
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2723
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2724
		    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2725
		     * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2726
		     * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2727
		     */
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2728
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2729
		    /* stay here, while no interrupts are pending ... */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2730
		    do {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2731
			(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2732
			if (InterruptPending != nil) goto outerLoop;
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2733
			tmp++;
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2734
		    } while (tmp <= final);
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2735
		    RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2736
		} else {
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2737
		    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2738
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2739
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2740
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2741
			 * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2742
			 * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2743
			 */
400
claus
parents: 394
diff changeset
  2744
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2745
			{
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2746
			    OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2747
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2748
			    idx = __MKSMALLINT(tmp);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2749
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2750
			}
400
claus
parents: 394
diff changeset
  2751
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2752
			__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
400
claus
parents: 394
diff changeset
  2753
#endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2754
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2755
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2756
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2757
			 * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2758
			 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2759
			(*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2760
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2761
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2762
	    outerLoop: ;
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2763
		tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2764
	    }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2765
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2766
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2767
#           undef IBLOCK_ARG
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2768
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2769
	    RETURN (self);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2770
	}
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2771
	/*
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2772
	 * arg is something else - call it with #value:
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2773
	 */
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2774
	while (tmp <= final) {
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2775
	    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2776
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2777
	    (*blockVal.ilc_func)(aBlock, 
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2778
					 @symbol(value:), 
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2779
					 nil, &blockVal,
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2780
					 __MKSMALLINT(tmp));
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2781
	    tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2782
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2783
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2784
    }
400
claus
parents: 394
diff changeset
  2785
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2786
400
claus
parents: 394
diff changeset
  2787
    "/
claus
parents: 394
diff changeset
  2788
    "/ arrive here if stop is not a smallInteger
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2789
    "/ pass on to super ...
400
claus
parents: 394
diff changeset
  2790
    "/
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2791
    ^ super to:stop do:aBlock
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2792
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  2793
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  2794
     1 to:10 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  2795
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2796
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2797
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2798
!SmallInteger methodsFor:'misc math'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2799
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2800
divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2801
    "return an array filled with self // aNumber and
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2802
     self \\ aNumber.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2803
     The result is only defined for positive receiver and
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2804
     argument."
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2805
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2806
%{  /* NOCONTEXT */
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2807
    INT val, div, mod, mySelf;
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2808
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
  2809
    if (__isSmallInteger(aNumber) &&
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2810
	(val = __intVal(aNumber)) > 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2811
	mySelf = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2812
	div = mySelf / val;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2813
	mod = mySelf % val;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2814
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2815
	RETURN (__ARRAY_WITH2( __MKSMALLINT(div),
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2816
			       __MKSMALLINT(mod)));
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2817
    }
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2818
%}.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2819
    ^ super divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2820
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2821
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2822
     10 // 3 
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2823
     10 \\ 3  
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2824
     10 divMod:3 
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2825
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2826
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  2827
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2828
gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2829
    "return the greatest common divisor (Euclid's algorithm).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2830
     This has been redefined here for more speed since due to the
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2831
     use of gcd in Fraction code, it has become time-critical for
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2832
     some code. (thanx to MessageTally)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2833
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2834
%{  /* NOCONTEXT */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2835
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2836
    if (__isSmallInteger(anInteger)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2837
	INT orgArg, ttt, selfInt, orgSelfInt, temp;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2838
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2839
	ttt = orgArg = __intVal(anInteger);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2840
	if (ttt) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2841
	    selfInt = orgSelfInt = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2842
	    while (ttt != 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2843
		temp = selfInt % ttt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2844
		selfInt = ttt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2845
		ttt = temp;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2846
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2847
	    /*
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2848
	     * since its not defined in C, what the sign of
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2849
	     * a modulus result is when the arg is negative,
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2850
	     * change it explicitely here ...
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2851
	     */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2852
	    if (orgArg < 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2853
		/* result should be negative */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2854
		if (orgSelfInt > 0) selfInt = -selfInt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2855
	    } else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2856
		/* result should be positive */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2857
		if (orgSelfInt < 0) selfInt = -selfInt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2858
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2859
	    RETURN ( __MKSMALLINT(selfInt) );
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2860
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2861
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2862
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2863
.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2864
    ^ super gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2865
!
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2866
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2867
gcd_helper:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2868
    "same as gcd - see knuth & Integer>>gcd:"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2869
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2870
    ^ self gcd:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2871
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2872
    "Created: 1.3.1997 / 16:58:01 / cg"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2873
!
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  2874
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2875
intlog10
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2876
    "return the truncation of log10 of the receiver -
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2877
     stupid implementation; used to find out the number of digits needed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2878
     to print a number/and for conversion to a LargeInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2879
     Implemented that way, to allow for tiny systems without a Float class
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2880
     (i.e. without log)."
2
claus
parents: 1
diff changeset
  2881
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2882
    self <= 0 ifTrue:[
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2883
        ^ self class
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2884
            raise:#domainErrorSignal
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2885
            receiver:self
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2886
            selector:#intlog10
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2887
            arguments:#()
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2888
            errorString:'logarithm of negative integer'
2
claus
parents: 1
diff changeset
  2889
    ].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2890
    self < 10 ifTrue:[^ 1].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2891
    self < 100 ifTrue:[^ 2].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2892
    self < 1000 ifTrue:[^ 3].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2893
    self < 10000 ifTrue:[^ 4].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2894
    self < 100000 ifTrue:[^ 5].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2895
    self < 1000000 ifTrue:[^ 6].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2896
    self < 10000000 ifTrue:[^ 7].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2897
    self < 100000000 ifTrue:[^ 8].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2898
    self < 1000000000 ifTrue:[^ 9].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2899
    ^ 10
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2900
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2901
    "
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2902
      -1 intlog10
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  2903
    "
2
claus
parents: 1
diff changeset
  2904
! !
claus
parents: 1
diff changeset
  2905
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  2906
!SmallInteger methodsFor:'modulo arithmetic'!
2
claus
parents: 1
diff changeset
  2907
5447
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2908
asUnsigned
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2909
    "return an integer with my bit-pattern, but positive.
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2910
     May be required for bit operations on the sign-bit."
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2911
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2912
    self < 0 ifTrue:[
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2913
        ^ self + (SmallInteger maxVal + 1) + (SmallInteger maxVal + 1)
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2914
    ]
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2915
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2916
    "
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2917
     -1 asUnsigned          
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2918
     SmallInteger minVal asUnsigned   
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2919
    "
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2920
!
1e3d8ac264c7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5412
diff changeset
  2921
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2922
plus:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2923
    "return the sum of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2924
     The argument must be another SmallInteger.
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  2925
     If the result overflows the smallInteger range, the value modulo the 
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2926
     smallInteger range is returned (i.e. the low bits of the sum).
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  2927
     This is of course not always correct, but some code does a modulo anyway
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2928
     and can therefore speed things up by not going through LargeIntegers."
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  2929
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2930
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2931
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2932
    if (__isSmallInteger(aNumber)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2933
	INT sum;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2934
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2935
	sum = __intVal(self) + __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2936
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2937
	sum &= 0x7FFFFFFFFFFFFFFFL;
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2938
#else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2939
	sum &= 0x7FFFFFFF;
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2940
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2941
	RETURN ( __MKSMALLINT(sum));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2942
    }
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2943
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2944
    self primitiveFailed
2
claus
parents: 1
diff changeset
  2945
!
claus
parents: 1
diff changeset
  2946
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2947
subtract:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2948
    "return the difference of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2949
     The argument must be another SmallInteger.
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  2950
     If the result overflows the smallInteger range, the value modulo the 
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2951
     smallInteger range is returned (i.e. the low bits of the sum).
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  2952
     This is of course not always correct, but some code does a modulo anyway
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2953
     and can therefore speed things up by not going through LargeIntegers."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2954
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2955
%{  /* NOCONTEXT */
2
claus
parents: 1
diff changeset
  2956
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2957
    if (__isSmallInteger(aNumber)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2958
	INT diff;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2959
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2960
	diff = __intVal(self) - __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2961
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2962
	diff &= 0x7FFFFFFFFFFFFFFFL;
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2963
#else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2964
	diff &= 0x7FFFFFFF;
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2965
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2966
	RETURN ( __MKSMALLINT(diff));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2967
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2968
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2969
    self primitiveFailed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2970
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2971
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2972
times:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2973
    "return the product of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2974
     The argument must be another SmallInteger.
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  2975
     If the result overflows the smallInteger range, the value modulo the 
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2976
     smallInteger range is returned (i.e. the low bits of the product).
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  2977
     This is of course not always correct, but some code does a modulo anyway
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2978
     and can therefore speed things up by not going through LargeIntegers."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2979
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2980
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2981
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2982
    if (__isSmallInteger(aNumber)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2983
	INT prod;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2984
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2985
	prod = __intVal(self) * __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2986
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2987
	prod &= 0x7FFFFFFFFFFFFFFFL;
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2988
#else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2989
	prod &= 0x7FFFFFFF;
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  2990
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2991
	RETURN ( __MKSMALLINT(prod));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2992
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2993
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2994
    self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2995
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2996
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2997
!SmallInteger methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2998
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2999
printOn:aStream
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3000
    "append my printstring (base 10) to aStream."
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3001
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3002
    aStream nextPutAll:(self printString)
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3003
!
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3004
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3005
printOn:aStream base:radix showRadix:showRadix
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3006
    "append a string representation of the receiver in the specified numberBase to aStream
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3007
     (if showRadix is true, with initial XXr)
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3008
     The radix argument should be between 2 and 36."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3009
6144
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  3010
    radix < 2 ifTrue:[
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  3011
        self error:'invalid radix'
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  3012
    ].
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  3013
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3014
    showRadix ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3015
        radix printOn:aStream.
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3016
        aStream nextPutAll:'r'.    
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3017
    ].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3018
    aStream nextPutAll:(self printStringRadix:radix)
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3019
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3020
    "Created: / 7.9.2001 / 13:54:40 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3021
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3022
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3023
printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3024
    "return my printstring (base 10)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3025
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3026
    "since this was heavily used in some applications,
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3027
     here is an exception to the rule of basing printString
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3028
     upon the printOn: method."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3029
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3030
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3031
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3032
    char buffer[30];
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3033
    char *cp;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3034
    OBJ newString;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3035
    INT myValue;
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3036
    int negative = 0;
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3037
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3038
#ifdef SLOW_CODE
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3039
    /* 
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3040
     * this takes twice as long as the code below ...
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3041
     * (printf is soooo slow)
369
claus
parents: 357
diff changeset
  3042
     */
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3043
# ifdef alpha64
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3044
    sprintf(buffer, "%ld", __intVal(self));
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3045
# else
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3046
    sprintf(buffer, "%d", __intVal(self));
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3047
# endif
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3048
    newString = __MKSTRING(buffer COMMA_SND);
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3049
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3050
#else
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3051
    myValue = __intVal(self);
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3052
    if (myValue == 0) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3053
	RETURN (__MKSTRING_L("0", 1));
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3054
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3055
    if (myValue < 0) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3056
	negative = 1;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3057
	myValue = -myValue;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3058
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3059
    cp = buffer + sizeof(buffer) - 1;
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3060
    *cp-- = '\0';
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3061
    while (myValue != 0) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3062
	*cp = '0' + (myValue % 10);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3063
	myValue = myValue / 10;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3064
	cp--;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3065
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3066
    if (negative) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3067
	*cp-- = '-';
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3068
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3069
    newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3070
#endif
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3071
    if (newString != nil) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3072
	RETURN (newString);
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3073
    }
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3074
%}.
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3075
    "/ only arrive here,
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3076
    "/  when having memory problems (i.e. no space for string) ...
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3077
    ^ super printString
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3078
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3079
    "
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3080
     1234 printString   
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3081
     0    printString      
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3082
     -100 printString   
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3083
    "
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3084
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3085
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3086
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3087
printStringRadix:base
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3088
    "return my printstring (optimized for bases 16, 10 and 8)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3089
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3090
    |s|
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3091
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3092
%{
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3093
    char buffer[64+3];  /* for alpha, base 2 plus sign */
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3094
    char *cp;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3095
    OBJ newString;
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3096
    INT myValue;
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3097
    int negative = 0;
3706
6cd714580176 avoid name conflict.
Claus Gittinger <cg@exept.de>
parents: 3705
diff changeset
  3098
    INT __base;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3099
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3100
    if (__isSmallInteger(base)) {
3707
a80825dc682b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3706
diff changeset
  3101
	__base = __intVal(base);
3706
6cd714580176 avoid name conflict.
Claus Gittinger <cg@exept.de>
parents: 3705
diff changeset
  3102
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3103
#ifdef SLOW_CODE
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3104
	switch (__base) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3105
	    case 10:
2788
e4436755d153 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2787
diff changeset
  3106
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3107
		format = "%ld";
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3108
#else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3109
		format = "%d";
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3110
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3111
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3112
	    case 16:
2788
e4436755d153 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2787
diff changeset
  3113
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3114
		format = "%lx";
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3115
#else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3116
		format = "%x";
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3117
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3118
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3119
	    case 8:
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3120
#ifdef alpha64
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3121
		format = "%lo";
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3122
#else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3123
		format = "%o";
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3124
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3125
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3126
	}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3127
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3128
	if (format) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3129
	    /*
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3130
	     * actually only needed on sparc: since thisContext is
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3131
	     * in a global register, which gets destroyed by printf,
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3132
	     * manually save it here - very stupid ...
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3133
	     */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3134
	    __BEGIN_PROTECT_REGISTERS__
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3135
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3136
	    sprintf(buffer, format, __intVal(self));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3137
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3138
	    __END_PROTECT_REGISTERS__
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3139
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3140
	    newString = __MKSTRING(buffer COMMA_SND);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3141
	    if (newString != nil) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3142
		RETURN (newString);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3143
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3144
	}
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3145
#else
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3146
	if ((__base <= 36) && (__base > 1)) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3147
	    myValue = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3148
	    if (myValue == 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3149
		RETURN (__MKSTRING_L("0", 1));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3150
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3151
	    if (myValue < 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3152
		negative = 1;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3153
		myValue = -myValue;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3154
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3155
	    cp = buffer + sizeof(buffer) - 1;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3156
	    *cp-- = '\0';
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3157
	    while (myValue != 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3158
		int digit;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3159
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3160
		digit = myValue % __base;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3161
		if (digit <= 9) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3162
		    *cp = '0' + digit;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3163
		} else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3164
		    *cp = 'A' + digit - 10;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3165
		}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3166
		myValue = myValue / __base;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3167
		cp--;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3168
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3169
	    if (negative) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3170
		*cp-- = '-';
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3171
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3172
	    newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3173
	    if (newString != nil) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3174
		RETURN (newString);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3175
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3176
	}
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3177
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3178
    }
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3179
%}.
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3180
    "/ arrive here, for bad base,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3181
    "/ or when having memory problems (i.e. no space for string) ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3182
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3183
    "/
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3184
    "/ fall back for seldom used bases
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3185
    "/ Notice: cannt use super>>printStringRadix: here,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3186
    "/ since that would lead to endless recursion ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3187
    "/ (a consequence of reversing printOn / printString functionality)
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3188
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3189
    s := WriteStream on:(String new:10).
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3190
    super printOn:s base:base.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3191
    ^ s contents.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3192
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3193
    "
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3194
      127 printStringRadix:16  
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3195
      123 printStringRadix:16  
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3196
      123 printStringRadix:10  
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3197
      123 printStringRadix:8   
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3198
      123 printStringRadix:3  
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3199
      123 printStringRadix:2  
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3200
      123 printStringRadix:1
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3201
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3202
      -127 printStringRadix:16   
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3203
      -123 printStringRadix:16   
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3204
      -123 printStringRadix:10   
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3205
      -123 printStringRadix:8    
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3206
      -123 printStringRadix:3    
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3207
      -123 printStringRadix:2    
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3208
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3209
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3210
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3211
printfPrintString:formatString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3212
    "non-portable, but sometimes useful.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3213
     return a printed representation of the receiver
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3214
     as specified by formatString, which is defined by the C-
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3215
     function 'printf'.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3216
     No checking for string overrun - the resulting string 
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3217
     must be shorter than 256 chars or else ...
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3218
     This method is NONSTANDARD and may be removed without notice;
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3219
     it is provided to allow special conversions in very special
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3220
     situaltions.
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3221
     Notice that a conversion may not be portable; for example,
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3222
     to correctly convert an int on a 64-bit alpha, a %ld is required,
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3223
     while other systems may be happy with a %d ...
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3224
     Use at your own risk (if at all)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3225
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3226
%{  /* STACK: 400 */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3227
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3228
    char buffer[256];
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3229
    OBJ s;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3230
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3231
    if (__isString(formatString)) {
379
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  3232
	/*
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  3233
	 * actually only needed on sparc: since thisContext is
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  3234
	 * in a global register, which gets destroyed by printf,
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  3235
	 * manually save it here - very stupid ...
5b5a130ccd09 revision added
claus
parents: 370
diff changeset
  3236
	 */
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3237
	__BEGIN_PROTECT_REGISTERS__
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3238
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3239
	sprintf(buffer, __stringVal(formatString), __intVal(self));
809
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3240
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3241
	__END_PROTECT_REGISTERS__
5eef87c2907b e convenient macro for register saving (sparc only)
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3242
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3243
	s = __MKSTRING(buffer COMMA_SND);
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3244
	if (s != nil) {
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3245
	    RETURN (s);
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3246
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3247
    }
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3248
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3249
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3250
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3251
    "123 printfPrintString:'%%d -> %d'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3252
    "123 printfPrintString:'%%6d -> %6d'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3253
    "123 printfPrintString:'%%x -> %x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3254
    "123 printfPrintString:'%%4x -> %4x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3255
    "123 printfPrintString:'%%04x -> %04x'"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3256
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3257
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3258
!SmallInteger methodsFor:'private'!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3259
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3260
sign:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3261
    "private: for protocol completeness with LargeIntegers"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3262
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3263
    |absVal|
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3264
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3265
    absVal := self abs.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3266
    aNumber < 0 ifTrue:[
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3267
	^ absVal negated
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3268
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3269
    aNumber == 0 ifTrue:[^ 0].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3270
    ^ absVal
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3271
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3272
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3273
     -4 sign:-1   
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3274
     -4 sign:0    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3275
     -4 sign:1    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3276
     -4 sign:-1   
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3277
     -4 sign:0    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3278
     -4 sign:1    
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3279
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3280
! !
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3281
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3282
!SmallInteger methodsFor:'testing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3283
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3284
between:min and:max
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3285
    "return true if the receiver is less than or equal to the argument max
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3286
     and greater than or equal to the argument min.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3287
     - reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3288
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3289
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3290
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3291
    if (__bothSmallInteger(min, max)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3292
	REGISTER INT selfVal;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3293
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3294
	selfVal = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3295
	if (selfVal < __intVal(min)) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3296
	     RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3297
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3298
	if (selfVal > __intVal(max)) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3299
	     RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3300
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3301
	RETURN ( true );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3302
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3303
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3304
    (self < min) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3305
    (self > max) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3306
    ^ true
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3307
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3308
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3309
even
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3310
    "return true, if the receiver is even"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3311
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3312
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3313
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3314
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3315
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3316
    ^ super even
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3317
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3318
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3319
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3320
    "return true, if the receiver is less than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3321
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3322
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3323
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3324
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3325
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3326
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3327
    RETURN ( ((INT)(self) < 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3328
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3329
    RETURN ( (__intVal(self) < 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3330
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3331
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3332
    ^ self < 0
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3333
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3334
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3335
odd
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3336
    "return true, if the receiver is odd"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3337
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3338
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3339
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3340
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3341
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3342
    ^ super odd
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3343
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3344
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3345
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3346
positive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3347
    "return true, if the receiver is not negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3348
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3349
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3350
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3351
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3352
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3353
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3354
    RETURN ( ((INT)(self) >= 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3355
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3356
    RETURN ( (__intVal(self) >= 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3357
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3358
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3359
    ^ super positive
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3360
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3361
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3362
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3363
sign
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3364
    "return the sign of the receiver
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3365
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3366
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3367
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3368
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3369
    INT val = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3370
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3371
    if (val < 0) {
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3372
        RETURN ( __MKSMALLINT(-1) ); 
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3373
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3374
    if (val > 0) {
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3375
        RETURN ( __MKSMALLINT(1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3376
    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3377
    RETURN ( __MKSMALLINT(0) );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3378
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3379
    ^ super sign
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3380
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3381
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3382
strictlyPositive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3383
    "return true, if the receiver is greater than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3384
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3385
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3386
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3387
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3388
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3389
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3390
    RETURN ( ((INT)(self) > 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3391
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3392
    RETURN ( (__intVal(self) > 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3393
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3394
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3395
    ^ super strictlyPositive
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3396
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3397
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3398
!SmallInteger class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3399
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3400
version
6415
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  3401
    ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.143 2002-02-26 10:41:59 cg Exp $'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3402
! !