SmallInteger.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Tue, 10 Aug 2010 09:55:15 +0100
branchjv
changeset 17795 569eec7576f1
parent 17780 b6e42c92eba0
child 17797 71451ae83564
permissions -rw-r--r--
Merged with /trunk
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
"
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    12
"{ Package: 'stx:libbasic' }"
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    13
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
Integer subclass:#SmallInteger
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    15
	instanceVariableNames:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    16
	classVariableNames:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    17
	poolDictionaries:''
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    18
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    21
!SmallInteger class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    22
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    23
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    24
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    25
 COPYRIGHT (c) 1988 by Claus Gittinger
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
    26
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    27
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    28
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    37
documentation
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    38
"
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    39
    SmallIntegers are Integers in the range of at least +/- 2^30
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
    40
    (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
    41
     if the system was configured for 64bit mode).
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    43
    These are no real objects - they have no instances (not even storage !!)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    44
    and cannot be subclassed.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    45
    The reason is to save both storage and runtime by not collecting
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    46
    SmallIntegers in the system. SmallInts are marked by having the TAG_INT
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    47
    bit set, in contrast to all other objects which do not.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    48
    Since this knowledge is hardwired into the system (and there is no
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    49
    class-field stored with SmallIntegers) there can be no subclass of
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
    SmallInteger (sorry).
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    52
    If you really need this kind of thing, create a subclass of Integer,
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    53
    with an instance variable holding the value.
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    54
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    55
    [author:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    56
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    57
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    58
    [see also:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    59
	Number
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    60
	Float Fraction FixedPoint
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    61
	LargeInteger
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    62
"
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    63
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    64
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    65
!SmallInteger class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    66
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
basicNew:size
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    81
!SmallInteger class methodsFor:'bit mask constants'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    82
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    83
bitMaskFor:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    84
    "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
    85
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    86
    (index between:1 and:SmallInteger maxBits) ifFalse:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    87
	^ SubscriptOutOfBoundsSignal
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    88
		raiseRequestWith:index
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    89
		errorString:'index out of bounds'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    90
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    91
    ^ 1 bitShift:(index - 1)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    92
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    93
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    94
!SmallInteger class methodsFor:'constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    95
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
maxBits
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    97
    "return the number of bits in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    98
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    99
a27a279701f8 Initial revision
claus
parents:
diff changeset
   100
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   101
    RETURN ( __mkSmallInteger(N_INT_BITS) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
%}
2
claus
parents: 1
diff changeset
   103
claus
parents: 1
diff changeset
   104
    "SmallInteger maxBits"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   105
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
maxBytes
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   108
    "return the number of bytes in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   109
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   110
a27a279701f8 Initial revision
claus
parents:
diff changeset
   111
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   112
    RETURN ( __mkSmallInteger(N_INT_BITS / 8 + 1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
%}
2
claus
parents: 1
diff changeset
   114
3684
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   115
    "
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   116
     SmallInteger maxBytes
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   117
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
maxVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   121
    "return the largest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   122
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   125
    RETURN ( __mkSmallInteger(_MAX_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
%}
2
claus
parents: 1
diff changeset
   127
claus
parents: 1
diff changeset
   128
    "SmallInteger maxVal"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   129
!
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
minVal
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   132
    "return the smallest Integer representable as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   133
     For very special uses only - not constant across implementations"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   134
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   135
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   136
    RETURN ( __mkSmallInteger(_MIN_INT) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   137
%}
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
    "SmallInteger minVal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   140
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   141
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   142
!SmallInteger class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   143
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   144
canBeSubclassed
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   145
    "return true, if its allowed to create subclasses of the receiver.
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   146
     Return false here - since it is NOT possible for SmallInteger
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   147
     (due to the tagged representation of SmallIntegers)"
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   148
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   149
    ^ false
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   150
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   151
    "Modified: / 5.11.1998 / 16:11:27 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
2672
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   154
hasImmediateInstances
4661
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   155
    "return true if this class has immediate instances
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   156
     i.e. if the instances are represented in the pointer itself and
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   157
     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
   158
     Redefined from Behavior"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   159
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   160
    ^ true
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   161
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   162
    "Created: 3.6.1997 / 12:01:26 / cg"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   163
!
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   164
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   165
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   166
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   167
     Here, true is returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
    ^ true
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   170
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   171
    "Modified: 23.4.1996 / 16:00:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   172
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
a27a279701f8 Initial revision
claus
parents:
diff changeset
   174
!SmallInteger methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
a27a279701f8 Initial revision
claus
parents:
diff changeset
   176
* aNumber
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   177
    "return the product of the receiver and the argument"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   178
a27a279701f8 Initial revision
claus
parents:
diff changeset
   179
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   181
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   182
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   183
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   184
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   185
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   186
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   187
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   188
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   189
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   190
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   191
    INT myValue, otherValue;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   192
    unsigned INT productLow, productHi;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   193
    int negative;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   194
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   195
#   define low16Bits(foo)  ((foo) & 0xFFFF)
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   196
#   define hi16Bits(foo)   ((foo) >> 16)
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   197
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   198
#   define hi32Bits(foo)   ((foo) >> 32)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   199
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   200
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   201
     * can we use long long arithmetic ?
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   202
     *
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   203
     * long-long arithmetic seems to be buggy with some systems
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   204
     * (took me a while to find this out :-(
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   205
     * (try 10000 * 10000)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   206
     */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   207
#if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   208
# define USE_LONGLONG_FOR_MUL
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   209
#endif
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   210
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   211
#if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   212
# define USE_LONGLONG_FOR_MUL
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   213
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   214
252
   215
    if (__isSmallInteger(aNumber)) {
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   216
        myValue = __intVal(self);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   217
        otherValue = __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   218
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   219
#if defined(USE_LONGLONG_FOR_MUL)
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   220
        {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   221
# if defined(__alpha__) && !defined(__alpha64__)
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   222
#  define LONGLONG      INT64
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   223
# else
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   224
#  define LONGLONG      long long
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   225
# endif
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   226
            LONGLONG product;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   227
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   228
            product = (LONGLONG)myValue * (LONGLONG)otherValue;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   229
            if ((product >= (LONGLONG)_MIN_INT)
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   230
             && (product <= (LONGLONG)_MAX_INT)) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   231
                RETURN ( __mkSmallInteger((INT)product) );
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   232
            }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   233
            if (product < 0) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   234
                negative = -1;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   235
                product = -product;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   236
            } else {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   237
                negative = 1;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   238
            }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   239
            productHi = product >> 32;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   240
            productLow = product & 0xFFFFFFFFL;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   241
        }
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   242
#else /* no long-long */
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   243
        negative = 1;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   244
        if (myValue < 0) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   245
            negative = -1;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   246
            myValue = -myValue;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   247
        }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   248
        if (otherValue < 0) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   249
            negative = -negative;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   250
            otherValue = -otherValue;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   251
        }
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   252
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   253
# if defined(__GNUC__) && defined(__mc68k__)
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   254
        asm ("mulu%.l %3,%1:%0"
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   255
                : "=d"  ((unsigned long)(productLow)),
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   256
                  "=d"  ((unsigned long)(productHi))
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   257
                : "%0"  ((unsigned long)(myValue)),
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   258
                  "dmi" ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   259
# else
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   260
#  if defined (__GNUC__) && defined(__i386__)
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   261
        asm ("mull %3"
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   262
                : "=a"  ((unsigned long)(productLow)),
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   263
                  "=d"  ((unsigned long)(productHi))
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   264
                : "%0"  ((unsigned long)(myValue)),
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   265
                  "rm"  ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   266
#  else
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
   267
#   if defined(WIN32) && defined(__BORLANDC__)
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   268
        asm {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   269
            mov   eax, myValue
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   270
            mov   edx, otherValue
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   271
            mul   edx
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   272
            mov   productLow, eax
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   273
            mov   productHi, edx
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   274
        }
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   275
#   else /* generic */
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   276
        {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   277
            unsigned INT pHH, pHL, pLH, pLL;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   278
            unsigned INT low1, low2, hi1, hi2;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   279
            unsigned INT t;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   280
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   281
            /* unsigned multiply myValue * otherValue -> productHi, productLow
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   282
             *
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   283
             * this is too slow:
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   284
             * since most machines can do 32*32 to 64 bit multiply,
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   285
             * (or at least 32*32 with Overflow check)
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   286
             * - need more assembler (inline) functions here
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   287
             */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   288
#    if __POINTER_SIZE__ == 8
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   289
            low1 = low32Bits((unsigned INT)myValue);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   290
            hi1 = hi32Bits((unsigned INT)myValue);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   291
            low2 = low32Bits((unsigned INT)otherValue);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   292
            hi2 = hi32Bits((unsigned INT)otherValue);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   293
#     define LLMASK 0xC000000000000000L
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   294
#    else
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   295
            low1 = low16Bits((unsigned INT)myValue);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   296
            hi1 = hi16Bits((unsigned INT)myValue);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   297
            low2 = low16Bits((unsigned INT)otherValue);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   298
            hi2 = hi16Bits((unsigned INT)otherValue);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   299
#     define LLMASK 0xC0000000
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   300
#    endif
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   301
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   302
            pLH = low1 * hi2;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   303
            pHL = hi1 * low2;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   304
            pLL = low1 * low2;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   305
            pHH = hi1 * hi2;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   306
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   307
            /*
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   308
             * the common case ...
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   309
             */
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   310
            if ((pHL == 0)
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   311
             && (pLH == 0)
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   312
             && (pHH == 0)
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   313
             && ((pLL & LLMASK) == 0)) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   314
                if (negative < 0) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   315
                    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   316
                }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   317
                RETURN ( __mkSmallInteger((INT)pLL) );
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   318
            }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   319
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   320
            /*
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   321
             *   pHH |--------|--------|
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   322
             *   pLH          |--------|--------|
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   323
             *   pHL          |--------|--------|
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   324
             *   pLL                   |--------|--------|
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   325
             */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   326
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   327
#    if __POINTER_SIZE__ == 8
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   328
            t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   329
            productLow = (t << 32) + low32Bits(pLL);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   330
            productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   331
#    else
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   332
            t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   333
            productLow = (t << 16) + low16Bits(pLL);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   334
            productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   335
#    endif
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   336
        }
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   337
#   endif /* ! WIN32 */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   338
#  endif /* ! (__GNUC__ && __i386__) */
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   339
# endif /* ! (__GNUC__ && __mc68k__) */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   340
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   341
        if (productHi == 0) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   342
            if (negative < 0) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   343
                if (productLow <= -(_MIN_INT)) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   344
                    RETURN ( __mkSmallInteger(-((INT)productLow)) );
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   345
                }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   346
            } else {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   347
                if (productLow <= _MAX_INT) {
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   348
                    RETURN ( __mkSmallInteger(productLow) );
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   349
                }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   350
            }
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   351
        }
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   352
#endif /* ! USE_LONGLONG */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   353
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   354
#if __POINTER_SIZE__ == 8
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   355
        RETURN (__MKLARGEINT128(negative, productLow, productHi));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   356
#else
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   357
        RETURN (__MKLARGEINT64(negative, productLow, productHi));
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   358
#endif
283
a897d331b4c1 *** empty log message ***
claus
parents: 282
diff changeset
   359
    } else if (__isFloatLike(aNumber)) {
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   360
        OBJ newFloat;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   361
        double val = (double)__intVal(self) * __floatVal(aNumber);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   362
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   363
        __qMKFLOAT(newFloat, val);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   364
        RETURN ( newFloat );
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   365
    } else if (__isShortFloat(aNumber)) {
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   366
        OBJ newFloat;
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   367
        float val = (float)__intVal(self) * __shortFloatVal(aNumber);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   368
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   369
        __qMKSFLOAT(newFloat, val);
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   370
        RETURN ( newFloat );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   371
    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
   372
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   373
    ^ aNumber productFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   375
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   376
+ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   377
    "return the sum of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   378
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   379
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   380
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   381
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   382
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   383
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   384
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   385
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   386
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   387
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   388
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   389
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   390
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   391
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   392
#ifdef _ADD_IO_IO
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   393
	RETURN ( _ADD_IO_IO(self, aNumber) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   394
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   395
	REGISTER INT sum;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   396
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   397
	sum =  __intVal(self) + __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   398
	if (__ISVALIDINTEGER(sum)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   399
	    RETURN ( __mkSmallInteger(sum) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   400
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   401
	RETURN ( __MKLARGEINT(sum) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   402
#endif
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   403
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   404
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   405
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   406
	double val = (double)__intVal(self) + __floatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   407
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   408
	__qMKFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   409
	RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   410
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   411
    if (__isShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   412
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   413
	float val = (float)__intVal(self) + __shortFloatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   414
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   415
	__qMKSFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   416
	RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   417
    }
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   418
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   419
    ^ aNumber sumFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   420
!
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
- aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   423
    "return the difference of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   424
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   425
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   426
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   427
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   428
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   429
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   430
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   431
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   432
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   433
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   434
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   435
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   436
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   437
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   438
#ifdef _SUB_IO_IO
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   439
	RETURN ( _SUB_IO_IO(self, aNumber) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   440
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   441
	REGISTER INT diff;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   442
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   443
	diff =  __intVal(self) - __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   444
	if (__ISVALIDINTEGER(diff)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   445
	    RETURN ( __mkSmallInteger(diff) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   446
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   447
	RETURN ( __MKLARGEINT(diff) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   448
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   449
    }
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   450
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   451
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   452
	double val = (double)__intVal(self) - __floatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   453
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   454
	__qMKFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   455
	RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   456
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   457
    if (__isShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   458
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   459
	float val = (float)__intVal(self) - __shortFloatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   460
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   461
	__qMKSFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   462
	RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   463
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   464
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   465
    ^ aNumber differenceFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   466
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   467
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   468
/ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   469
    "return the quotient of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   470
a27a279701f8 Initial revision
claus
parents:
diff changeset
   471
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   472
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   473
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   474
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   475
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   476
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   477
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   478
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   479
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   480
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   481
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   482
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   483
    INT me, t, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   484
    double dval;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   485
252
   486
    if (__isSmallInteger(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   487
	val = __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   488
	if (val != 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   489
	    me = __intVal(self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   490
	    t = me / val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   491
#ifdef GOOD_OPTIMIZER
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   492
	    if (me % val == 0) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   493
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   494
	    /* this is stupid - all I want is to look for a remainder ...
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   495
	       but most compilers are too stupid and generate an extra modulus
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   496
	       instruction for "if (me % val)".
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   497
	       Even if most divide instructions already leave the remainder in
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   498
	       some register.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   499
	       Therefore I use a multiplication which is faster than a modulo
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   500
	       on most machines. Hint to GNU people :-)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   501
	    */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   502
	    if ((t * val) == me) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   503
#endif
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   504
		RETURN ( __mkSmallInteger(t) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   505
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   506
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   507
    } else {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   508
	if (__isFloatLike(aNumber)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   509
	    dval = __floatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   510
	    if (dval != 0.0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   511
		OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   512
		double val = (double)__intVal(self) / dval;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   513
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   514
		__qMKFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   515
		RETURN ( newFloat );
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   516
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   517
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   518
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   519
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   520
    aNumber isInteger ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   521
	aNumber == 0 ifTrue:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   522
	    ^ ZeroDivide raiseRequestWith:thisContext.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   523
	].
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   524
	^ Fraction numerator:self denominator:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   525
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   526
    ^ aNumber quotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   527
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
     8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   530
     9 / 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 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   533
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   534
     -8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   535
     -9 / 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 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   538
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   539
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   540
2
claus
parents: 1
diff changeset
   541
// aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   542
    "return the integer part of the quotient of the receivers value
1884
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   543
     and the arguments value. The result is truncated toward negative infinity
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   544
     and negative, if the operands signs differ.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   545
     Be careful with negative results: 9 // 4 = 2,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   546
     while -9 // 4 = -3.
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   547
     The following is always true:
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   548
	(receiver // aNumber) * aNumber + (receiver \\ aNUmber) = receiver
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   549
     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
   550
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   551
%{  /* NOCONTEXT */
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   552
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
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   555
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   556
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   557
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   558
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   559
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   560
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   561
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   562
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   563
    INT dividend, divisor, rslt;
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   564
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   565
    if (__isSmallInteger(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   566
	divisor = __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   567
	if (divisor != 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   568
	    dividend = __intVal(self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   569
	    rslt = dividend / divisor;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   570
	    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   571
	     * Optimized to speed up positive result
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   572
	     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   573
	    if (rslt <= 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   574
		if (rslt == 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   575
		    if ((dividend ^ divisor) < 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   576
			/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   577
			 * result (negative) has been truncated toward 0.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   578
			 * Return -1, because we truncate toward negative inf.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   579
			 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   580
			 rslt = -1;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   581
		    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   582
		} else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   583
		    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   584
		     * If result (negative) has been truncated toward 0,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   585
		     * subtract 1, because we truncate toward negative inf.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   586
		     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   587
		    if (divisor > 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   588
			if (rslt * divisor > dividend) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   589
			    rslt--;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   590
			}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   591
		    } else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   592
			if (rslt * divisor < dividend) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   593
			    rslt--;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   594
			}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   595
		    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   596
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   597
	    }
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   598
	    RETURN ( __mkSmallInteger(rslt) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   599
	}
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   600
    } else {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   601
	if (__isFraction(aNumber)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   602
	    OBJ t;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   603
	    INT num, den;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   604
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   605
	    t = __FractionInstPtr(aNumber)->f_numerator;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   606
	    if (__isSmallInteger(t)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   607
		num = __intVal(t);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   608
		t = __FractionInstPtr(aNumber)->f_denominator;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   609
		if (__isSmallInteger(t)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   610
		    den = __intVal(t);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   611
		    RETURN ( __mkSmallInteger(__intVal(self) * den / num ));
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   612
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   613
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   614
	}
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   615
    }
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
    (aNumber = 0) ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   618
	^ ZeroDivide raiseRequestWith:thisContext.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   619
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   620
    ^ self retry:#// coercing:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   621
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   622
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   623
     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
   624
     -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
   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   ~~ 2 ifTrue:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   627
     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
   628
     -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
   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   ~~ 0 ifTrue:[self halt].
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   631
     10000 // 3600000 ~~ 0 ifTrue:[self halt].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   632
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   633
     9 quo:4   => 2
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
    "
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
2
claus
parents: 1
diff changeset
   640
\\ aNumber
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   641
    "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
   642
     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
   643
     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
   644
     The following is always true:
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   645
	(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
   646
     Compare with #rem:
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   647
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   648
     Redefined for speed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   649
a27a279701f8 Initial revision
claus
parents:
diff changeset
   650
%{  /* NOCONTEXT */
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   651
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
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   654
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   655
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   656
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   657
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   658
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   659
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   660
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   661
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   662
    INT dividend, divisor, rem;
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   663
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   664
    if (__isSmallInteger(aNumber)
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   665
	&& (divisor = __intVal(aNumber)) != 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   666
	/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   667
	 * Note that the sign of something modulo a negative number is undefined
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   668
	 * in C!
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   669
	 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   670
	dividend = __intVal(self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   671
	rem = dividend % divisor;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   672
	if (rem) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   673
	    if ((rem ^ divisor) < 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   674
		/* sign of remainder is different from sign of divisor */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   675
		rem = -rem;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   676
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   677
	    if ((dividend ^ divisor) < 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   678
		/* different signs, so division would have returned a
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   679
		 * negative number.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   680
		 * C rounds toward zero, this code will simulate
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   681
		 * rounding towards negative infinity.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   682
		 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   683
		rem = divisor - rem;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   684
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   685
	}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   686
	RETURN ( __mkSmallInteger(rem) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   687
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   688
%}.
2
claus
parents: 1
diff changeset
   689
    (aNumber = 0) ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   690
	^ ZeroDivide raiseRequestWith:thisContext.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   691
    ].
2
claus
parents: 1
diff changeset
   692
    ^ self retry:#\\ coercing:aNumber
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   693
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   694
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   695
     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
   696
     -9 \\ 4 == 3 ifFalse:[self halt].
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   697
     9 \\ -4 == -3 ifFalse:[self halt].
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   698
     -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
   699
     (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
   700
     (-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
   701
     1000 \\ 3600000 == 1000 ifFalse:[self halt]
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   702
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   703
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   704
a27a279701f8 Initial revision
claus
parents:
diff changeset
   705
abs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   706
    "return the absolute value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   707
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   708
a27a279701f8 Initial revision
claus
parents:
diff changeset
   709
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   710
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   711
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   712
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   713
    if (val >= 0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   714
	RETURN (self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   715
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   716
    if (val != _MIN_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   717
	RETURN ( __mkSmallInteger(-val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   718
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   719
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   720
    RETURN( __MKLARGEINT(-_MIN_INT));
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   721
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   722
    ^ super abs
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   723
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   724
a27a279701f8 Initial revision
claus
parents:
diff changeset
   725
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   726
    "return the negative value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   727
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   728
a27a279701f8 Initial revision
claus
parents:
diff changeset
   729
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   730
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   731
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   732
a27a279701f8 Initial revision
claus
parents:
diff changeset
   733
    if (val != _MIN_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   734
	RETURN ( __mkSmallInteger(- val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   735
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   736
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   737
    RETURN (__MKLARGEINT( -_MIN_INT));
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   738
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   739
    ^ 0 - self
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   740
"/    "only reached for minVal"
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   741
"/    ^ (LargeInteger value:(SmallInteger maxVal)) + 1
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   742
!
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
quo:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   745
    "return the integer part of the quotient of the receivers value
1884
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   746
     and the arguments value. The result is truncated towards zero
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   747
     and negative, if the operands signs differ..
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   748
     The following is always true:
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   749
	(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
   750
     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
   751
     for negative results, the remainder is ignored.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   752
     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
   753
     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
   754
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   755
%{  /* NOCONTEXT */
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   756
    INT val;
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   757
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   758
    if (__isSmallInteger(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   759
	val = __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   760
	if (val != 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   761
	    RETURN ( __mkSmallInteger(__intVal(self) / val) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   762
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   763
    } else {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   764
	if (__isFraction(aNumber)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   765
	    OBJ t;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   766
	    INT num, den;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   767
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   768
	    t = __FractionInstPtr(aNumber)->f_numerator;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   769
	    if (__isSmallInteger(t)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   770
		num = __intVal(t);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   771
		t = __FractionInstPtr(aNumber)->f_denominator;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   772
		if (__isSmallInteger(t)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   773
		    den = __intVal(t);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   774
		    RETURN ( __mkSmallInteger(__intVal(self) * den / num ));
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   775
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   776
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   777
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   778
    }
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
    (aNumber = 0) ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   781
	^ ZeroDivide raiseRequestWith:thisContext.
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   782
    ].
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   783
    ^ self retry:#quo: coercing:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   784
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
     9 // 4
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 quo: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
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   791
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   792
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
   793
1
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)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
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:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   807
	^ anInteger bitAnd:self
4613
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
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   814
bitAt:anIntegerIndex
11500
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   815
    "return the value of the index's bit (index starts at 1) as 0 or 1.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   816
     Notice: the result of bitAt: on negative receivers is not
11500
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   817
             defined in the language standard (since the implementation
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
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
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   820
%{  /* NOCONTEXT */
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   821
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   822
    if (__isSmallInteger(anIntegerIndex)) {
11500
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   823
        INT idx = __smallIntegerVal(anIntegerIndex);
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   824
        if (idx > 0) {
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   825
            if (idx > N_INT_BITS) {
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   826
                RETURN(__mkSmallInteger(0));
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   827
            }
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   828
            RETURN((__smallIntegerVal(self) & (1 << (idx-1))) ? __mkSmallInteger(1) : __mkSmallInteger(0));
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   829
        }
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   830
    }
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   831
%}.
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   832
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   833
    ^ SubscriptOutOfBoundsSignal
11500
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   834
            raiseRequestWith:anIntegerIndex
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   835
            errorString:'index out of bounds'
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   836
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   837
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   838
     16r00000001 bitAt:0
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   839
     16r00000001 bitAt:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   840
     16r00000001 bitAt:2
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   841
     16r00008000 bitAt:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   842
     16r00800000 bitAt:24
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   843
     16r08000000 bitAt:28
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   844
     16r10000000 bitAt:29
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   845
     16r20000000 bitAt:30
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   846
     16r40000000 bitAt:31
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   847
     16r80000000 bitAt:32
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   848
     16r100000000 bitAt:33
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   849
    "
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   850
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   851
" Smalltalk implementation:
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   852
    |mask|
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   853
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   854
    anIntegerIndex <= 0 ifTrue:[
11500
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   855
        ^ SubscriptOutOfBoundsSignal
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   856
                raiseRequestWith:anIntegerIndex
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   857
                errorString:'index out of bounds'
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   858
    ].
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   859
    (anIntegerIndex > SmallInteger maxBits) ifTrue:[^ 0].
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   860
    mask := 1 bitShift:(anIntegerIndex - 1).
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   861
    ((self bitAnd:mask) == 0) ifTrue:[^ 0].
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   862
    ^ 1
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   863
"
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   864
!
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   865
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   866
bitClear:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   867
    "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
   868
     returning the receiver with bits of the argument cleared."
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   869
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   870
%{  /* NOCONTEXT */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   871
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   872
    /* anding the tags doesn't change it */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   873
    if (__isSmallInteger(anInteger)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   874
	RETURN ( ((OBJ) (((INT)self & ~(INT)anInteger) | TAG_INT)) );
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   875
    }
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   876
%}.
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   877
    ^ self retry:#bitClear: coercing:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   878
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   879
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   880
     (2r001010100 bitClear:2r00001111) radixPrintStringRadix:2
5458
2aa89d4fad64 example
Claus Gittinger <cg@exept.de>
parents: 5447
diff changeset
   881
     (2r111111111 bitClear:2r00001000) radixPrintStringRadix:2
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   882
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   883
!
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   884
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   885
bitCount
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   886
    "return the number of 1-bits in the receiver"
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   887
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   888
%{  /* NOCONTEXT */
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   889
    int _cnt = 0;
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   890
    int _self = __intVal(self);
11666
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
   891
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
   892
    while (_self) {
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
   893
        _cnt++;
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
   894
        _self = _self & (_self - 1);
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   895
    }
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   896
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   897
    RETURN ( __MKSMALLINT(_cnt));
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   898
%}
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   899
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   900
    "
11666
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
   901
     1 to:100000 do:[:n |
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   902
        self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   903
     ]
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   904
    "
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   905
!
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   906
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   907
bitInvert
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   908
    "return the value of the receiver with all bits inverted"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   909
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   910
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   911
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   912
    /* invert anything except tag bits */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   913
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
   914
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
   915
    ^ self primitiveFailed
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   916
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   917
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   918
bitOr:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   919
    "return the bitwise-or of the receiver and the argument, anInteger"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   920
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   921
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   922
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   923
    /* oring the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   924
    if (__isSmallInteger(anInteger)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   925
	RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   926
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   927
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   928
    ^ self retry:#bitOr: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   929
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   930
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   931
     (2r000000100 bitOr:2r00000011) radixPrintStringRadix:2
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   932
     (0 bitOr:16r20000000) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   933
     (0 bitOr:16r40000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   934
     (0 bitOr:16r80000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   935
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   936
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   937
a27a279701f8 Initial revision
claus
parents:
diff changeset
   938
bitShift:shiftCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
   939
    "return the value of the receiver shifted by shiftCount bits;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   940
     leftShift if shiftCount > 0; rightShift otherwise.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   941
     Notice: the result of bitShift: on negative receivers is not
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   942
	     defined in the language standard (since the implementation
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   943
	     is free to choose any internal representation for integers).
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   944
	     However, ST/X preserves the sign."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   945
a27a279701f8 Initial revision
claus
parents:
diff changeset
   946
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   947
a27a279701f8 Initial revision
claus
parents:
diff changeset
   948
    INT bits, count;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   949
252
   950
    if (__isSmallInteger(shiftCount)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   951
	bits = __intVal(self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   952
	if (bits == 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   953
	    RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   954
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   955
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   956
	count = __intVal(shiftCount);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   957
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   958
	if (count > 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   959
	    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   960
	     * a left shift
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   961
	     */
4183
4a745f6f47b6 oops - longlong shift fails with i386,GCC
Claus Gittinger <cg@exept.de>
parents: 4177
diff changeset
   962
#if defined(USE_LONGLONG_FOR_SHIFT)
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   963
	    if (count <= N_INT_BITS) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   964
		unsigned LONGLONG result;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   965
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   966
		result = (unsigned LONGLONG)bits;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   967
		result <<= count;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   968
		if (result <= _MAX_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   969
		    RETURN ( __mkSmallInteger(result) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   970
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   971
		{
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   972
		    RETURN (__MKLARGEINT64(1, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   973
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   974
	    }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   975
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   976
	    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   977
	     * check for overflow
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   978
	     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   979
	    if (count < (N_INT_BITS-1)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   980
		if (! (bits >> (N_INT_BITS - 1 - count))) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   981
		    RETURN ( __mkSmallInteger(bits << count) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   982
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   983
		/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   984
		 * so, there is an overflow ...
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   985
		 * handle it as largeInteger
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   986
		 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   987
		/* FALL THROUGH */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   988
	    }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   989
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   990
	} else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   991
	    if (count == 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   992
		RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   993
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   994
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   995
	    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   996
	     * right shifts cannot overflow
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   997
	     *
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   998
	     * some machines ignore shifts bigger than
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   999
	     * the number of bits in an int ...
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1000
	     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1001
	    count = -count;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1002
	    if (count > (N_INT_BITS-1)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1003
		RETURN (__mkSmallInteger(0));
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1004
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1005
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1006
	    RETURN ( __mkSmallInteger(bits >> count) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1007
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1008
    }
85
claus
parents: 77
diff changeset
  1009
%}.
claus
parents: 77
diff changeset
  1010
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1011
	^ (LargeInteger value:self) bitShift:shiftCount
85
claus
parents: 77
diff changeset
  1012
    ].
6400
3746d31f044a bitShift:float trouble fixed.
Claus Gittinger <cg@exept.de>
parents: 6344
diff changeset
  1013
    ^ self bitShift:(1 coerce:shiftCount)   "/ is this a good idea ?
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1014
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1015
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1016
bitTest:aMask
5782
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1017
    "return true, if any bit from aMask is set in the receiver.
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1018
     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
  1019
     is non-0, false otherwise."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1020
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1021
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1022
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1023
    /* and all bits except tag */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1024
    if (__isSmallInteger(aMask)) {
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1025
        RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1026
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1027
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1028
    aMask class == LargeInteger ifTrue:[
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1029
        ^ (aMask bitAnd:self) ~~ 0
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1030
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1031
    ^ self retry:#bitTest: coercing:aMask
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1032
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1033
    "
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1034
     2r10001 bitTest:2r00001  
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1035
     2r10001 bitTest:2r00010  
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1036
     2r10001 bitTest:2r00100  
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1037
     2r10001 bitTest:2r01000  
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1038
     2r10001 bitTest:2r10000  
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1039
     2r10001 bitTest:2r10001  
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1040
     2r10001 bitTest:2r10010  
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1041
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1042
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1043
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1044
bitXor:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1045
    "return the bitwise-exclusive-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1046
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1047
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1048
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1049
    /* xoring the tags turns it off - or it in again */
252
  1050
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1051
	RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1052
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1053
%}.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1054
    ^ self retry:#bitXor: coercing:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1055
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1056
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1057
clearBit:anInteger
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8919
diff changeset
  1058
    "return a new integer where the specified bit is off.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1059
     Bits are counted from 1 starting with the least significant.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1060
     The methods name may be missleading: the receiver is not changed,
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1061
     but a new number is returned. Should be named #withBitCleared:"
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1062
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1063
%{  /* NOCONTEXT */
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1064
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1065
    if (__isSmallInteger(anInteger)) {
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1066
	int index = __intVal(anInteger);
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1067
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1068
	if (index > 0) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1069
#if __POINTER_SIZE__ == 8
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1070
	    if (index <= 62)
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1071
#else
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1072
	    if (index <= 30)
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1073
#endif
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1074
	    {
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1075
		INT mask = __MASKSMALLINT(1 << (index-1));
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1076
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1077
		RETURN ( ((OBJ) ((INT)self & ~(INT)mask)) );
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1078
	    }
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1079
	    RETURN (self);  /* nothing to do ... */
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1080
	}
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1081
    }
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1082
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1083
    ^ super clearBit:anInteger
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1084
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1085
    "
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1086
     (16r401 clearBit:1     ) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1087
     (16r401 clearBit:0     ) hexPrintString
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1088
     (16r3fffffff clearBit:1) hexPrintString
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1089
     (16r3fffffff clearBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1090
     (16r3fffffff clearBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1091
     (16r3fffffff clearBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1092
     (16r3fffffff bitAt:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1093
     (16r3fffffff bitAt:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1094
     (16r3fffffff bitAt:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1095
     (16r40000001 clearBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1096
     (16rF0000001 clearBit:29) hexPrintString
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1097
     (16rF0000001 clearBit:30) hexPrintString
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1098
     (16rF0000001 clearBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1099
     (16rF0000001 clearBit:32) hexPrintString
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1100
    "
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1101
!
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1102
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1103
highBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1104
    "return the bitIndex of the highest bit set. The returned bitIndex
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1105
     starts at 1 for the least significant bit.
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1106
     Returns 0 if no bit is set."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1107
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1108
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1109
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1110
    unsigned INT bits;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1111
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1112
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1113
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1114
    if (bits == 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1115
	RETURN ( __mkSmallInteger(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1116
    }
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  1117
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1118
#ifdef __BSR
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1119
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1120
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1121
     * 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
  1122
     * (but saves a few code-bytes, though)
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1123
     */
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1124
    index = __BSR(bits);
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1125
#else
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1126
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1127
    index = 0;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1128
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1129
# if __POINTER_SIZE__ == 8
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1130
    if (bits & 0xFFFFFFFF00000000L) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1131
	index += 32; bits = bits >> 32;
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1132
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1133
# endif
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1134
    if (bits & 0xFFFF0000L) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1135
	index += 16; bits = bits >> 16;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1136
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1137
    if (bits & 0xFF00) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1138
	index += 8; bits = bits >> 8;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1139
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1140
    if (bits & 0xF0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1141
	index += 4; bits = bits >> 4;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1142
    }
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1143
    if (bits & 0xC) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1144
	index += 2; bits = bits >> 2;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1145
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1146
    if (bits & 0x2) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1147
	index += 1; bits = bits >> 1;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1148
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1149
#endif /* no BSR instruction */
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1150
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1151
    RETURN ( __mkSmallInteger(index+1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1152
%}
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1153
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1154
     2r0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1155
     2r1 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1156
     2r10 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1157
     2r100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1158
     2r1000 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1159
     2r100000000000 highBit
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1160
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1161
     ((0 to:64) collect:[:s | 1 bitShift:s])
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1162
	collect:[:n | n highBit]
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1163
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1164
     (((0 to:64) collect:[:s | 1 bitShift:s])
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1165
	collect:[:n | n highBit]) = (1 to:65)
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1166
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1167
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1168
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1169
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1170
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1171
	    2r1 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1172
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1173
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1174
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1175
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1176
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1177
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1178
	    2r1111 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1179
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1180
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1181
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1182
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1183
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1184
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1185
	    2r11111111111111 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1186
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1187
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1188
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1189
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1190
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1191
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1192
	    2r11111111111111111111111111 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1193
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1194
     ]
4951
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
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1197
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1198
     2r000100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1199
     2r010100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1200
     2r000001 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1201
     0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1202
     SmallInteger maxVal highBit
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1203
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1204
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1205
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1206
invertBit:anInteger
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1207
    "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
  1208
     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
  1209
     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
  1210
     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
  1211
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1212
%{  /* NOCONTEXT */
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1213
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1214
    if (__isSmallInteger(anInteger)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1215
	int index = __intVal(anInteger);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1216
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1217
	if (index > 0) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1218
#if __POINTER_SIZE__ == 8
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1219
	    if (index <= 62)
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1220
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1221
	    if (index <= 30)
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1222
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1223
	    {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1224
		INT mask = __MASKSMALLINT(1 << (index-1));
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1225
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1226
		RETURN ( ((OBJ) ((INT)self ^ (INT)mask)) );
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1227
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1228
	}
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1229
    }
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1230
%}.
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1231
    ^ super invertBit:anInteger
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1232
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1233
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1234
     (16r401 invertBit:2     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1235
     (16r401 invertBit:1     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1236
     (16r30000000 invertBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1237
     (16r40000000 invertBit:0) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1238
     (16r0 invertBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1239
     (16r0 invertBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1240
     (16r0 invertBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1241
     (16r0 invertBit:32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1242
     (16r0 invertBit:33) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1243
     (16r0 invertBit:100) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1244
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1245
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1246
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1247
!
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1248
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1249
lowBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1250
    "return the bitIndex of the lowest bit set. The returned bitIndex
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1251
     starts at 1 for the least significant bit.
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1252
     Returns 0 if no bit is set."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1253
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1254
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1255
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1256
    unsigned INT bits;
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1257
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1258
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1259
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1260
    if (bits == 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1261
	RETURN ( __mkSmallInteger(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1262
    }
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1263
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1264
#ifdef __BSF
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1265
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1266
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1267
     * the following code is only marginally faster on a PIII-400
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1268
     * (and not at all faster on an Athlon...)
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1269
     * but saves a few code-bytes, though.
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1270
     */
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1271
    index = __BSF(bits);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1272
    RETURN ( __mkSmallInteger(index + 1) );
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1273
#else
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1274
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1275
    index = 1;
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1276
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1277
# if __POINTER_SIZE__ == 8
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1278
    if ((bits<<32) == 0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1279
	index += 32; bits >>= 32;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1280
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1281
# endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1282
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1283
    if ((bits & 0xFFFF)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1284
	index += 16; bits >>= 16;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1285
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1286
    if ((bits & 0xFF)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1287
	index += 8; bits >>= 8;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1288
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1289
    if ((bits & 0xF)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1290
	index += 4; bits >>= 4;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1291
    }
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1292
    if ((bits & 0x3)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1293
	index += 2; bits >>= 2;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1294
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1295
    if ((bits & 0x1)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1296
	index += 1;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1297
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1298
#endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1299
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1300
    RETURN ( __mkSmallInteger(index) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1301
%}
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1302
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1303
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1304
     0 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1305
     2r0001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1306
     2r0010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1307
     2r0100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1308
     2r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1309
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1310
     2r000100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1311
     2r010010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1312
     2r100001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1313
     16r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1314
     16r1000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1315
     16r1000000000000000 lowBit
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1316
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1317
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1318
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1319
	    2r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1320
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1321
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1322
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1323
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1324
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1325
	    2r11110000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1326
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1327
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1328
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1329
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1330
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1331
	    2r1000000000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1332
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1333
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1334
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1335
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1336
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1337
	    2r1000000000000000000000000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1338
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1339
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1340
    "
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1341
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1342
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1343
rightShift:shiftCount
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1344
    "return the value of the receiver shifted by shiftCount bits;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1345
     right shift if shiftCount > 0; left shift  otherwise.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1346
     Notice: the result of bitShift: on negative receivers is not
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1347
             defined in the language standard (since the implementation
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1348
             is free to choose any internal representation for integers).
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1349
             However, ST/X preserves the sign."
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1350
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1351
%{  /* NOCONTEXT */
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1352
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1353
    INT bits, count;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1354
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1355
    if (__isSmallInteger(shiftCount)) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1356
        bits = __intVal(self);
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1357
        if (bits == 0) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1358
            RETURN (self);
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1359
        }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1360
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1361
        count = __intVal(shiftCount);
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1362
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1363
        if (count < 0) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1364
            /*
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1365
             * a left shift
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1366
             */
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1367
            count = -count;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1368
#if defined(USE_LONGLONG_FOR_SHIFT)
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1369
            if (count <= N_INT_BITS) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1370
                unsigned LONGLONG result;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1371
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1372
                result = (unsigned LONGLONG)bits;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1373
                result <<= count;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1374
                if (result <= _MAX_INT) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1375
                    RETURN ( __mkSmallInteger(result) );
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1376
                }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1377
                {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1378
                    RETURN (__MKLARGEINT64(1, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1379
                }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1380
            }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1381
#else
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1382
            /*
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1383
             * check for overflow
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1384
             */
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1385
            if (count < (N_INT_BITS-1)) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1386
                if (! (bits >> (N_INT_BITS - 1 - count))) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1387
                    RETURN ( __mkSmallInteger(bits << count) );
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1388
                }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1389
                /*
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1390
                 * so, there is an overflow ...
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1391
                 * handle it as largeInteger
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1392
                 */
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1393
                /* FALL THROUGH */
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1394
            }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1395
#endif
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1396
        } else {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1397
            if (count == 0) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1398
                RETURN (self);
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1399
            }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1400
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1401
            /*
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1402
             * right shifts cannot overflow
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1403
             *
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1404
             * some machines ignore shifts bigger than
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1405
             * the number of bits in an int ...
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1406
             */
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1407
            if (count > (N_INT_BITS-1)) {
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1408
                RETURN (__mkSmallInteger(0));
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1409
            }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1410
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1411
            RETURN ( __mkSmallInteger(bits >> count) );
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1412
        }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1413
    }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1414
%}.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1415
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1416
        ^ (LargeInteger value:self) rightShift:shiftCount
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1417
    ].
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1418
    ^ self rightShift:(1 coerce:shiftCount)   "/ is this a good idea ?
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1419
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1420
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1421
    "
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1422
        16 rightShift:2
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1423
         4 rightShift:-2
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1424
    "
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1425
!
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1426
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1427
setBit:anInteger
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8919
diff changeset
  1428
    "return a new integer where the specified bit is on.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1429
     Bits are counted from 1 starting with the least significant.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1430
     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
  1431
     but a new number is returned. Should be named #withBitSet:"
5209
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
%{  /* NOCONTEXT */
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1434
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1435
    if (__isSmallInteger(anInteger)) {
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1436
	int index = __intVal(anInteger);
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1437
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1438
	if (index > 0) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1439
#if __POINTER_SIZE__ == 8
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1440
	    if (index <= 62)
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1441
#else
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1442
	    if (index <= 30)
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1443
#endif
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1444
	    {
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1445
		INT mask = __MASKSMALLINT(1 << (index-1));
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1446
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1447
		RETURN ( ((OBJ) ((INT)self | (INT)mask)) );
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1448
	    }
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1449
	}
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1450
    }
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1451
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1452
    ^ super setBit:anInteger
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1453
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1454
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1455
     (16r401 setBit:2     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1456
     (16r30000000 setBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1457
     (16r40000000 setBit:0) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1458
     (16r0 setBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1459
     (16r0 setBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1460
     (16r0 setBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1461
     (16r0 setBit:32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1462
     (16r0 setBit:33) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1463
     (16r0 setBit:100) hexPrintString
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1464
    "
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1465
! !
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1466
7267
954ce6491c1a method category rename
Claus Gittinger <cg@exept.de>
parents: 7156
diff changeset
  1467
!SmallInteger methodsFor:'bit operators-32bit'!
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1468
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1469
asSigned32
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1470
    "return a 32-bit integer with my bit-pattern. For protocol completeness."
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1471
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1472
    ^ self
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1473
!
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1474
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1475
asUnsigned32
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1476
    "return a 32-bit integer with my bit-pattern, but positive.
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1477
     May be required for bit operations on the sign-bit and/or to
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1478
     convert C/Java numbers."
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1479
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1480
    self < 0 ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1481
	^ 16r100000000 + self
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1482
    ].
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1483
    ^ self
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1484
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1485
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1486
     (-1 asUnsigned32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1487
     1 asUnsigned32
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1488
     (SmallInteger minVal asUnsigned32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1489
     (SmallInteger maxVal asUnsigned32) hexPrintString
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1490
    "
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1491
!
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1492
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1493
bitInvert32
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1494
    "return the value of the receiver with all bits inverted in 32bit signed int space
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1495
     (changes the sign)"
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1496
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1497
%{  /* NOCONTEXT */
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1498
    unsigned INT v;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1499
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1500
    v = __intVal(self);
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1501
    v = ~v;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1502
#if __POINTER_SIZE__ == 8
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1503
    v &= 0xFFFFFFFFL;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1504
#endif
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1505
    RETURN ( __MKUINT(v) );
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1506
%}.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1507
    ^ self primitiveFailed
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1508
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1509
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1510
     1 bitInvert32
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1511
     16r40000000 bitInvert32
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1512
     16r80000000 bitInvert32
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1513
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1514
!
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1515
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1516
bitRotate32:shiftCount
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1517
    "return the value of the receiver rotated by shiftCount bits,
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1518
     but only within 32 bits, rotating left for positive, right for negative counts.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1519
     Rotates through the sign bit.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1520
     Useful for crypt algorithms, or to emulate C/Java semantics."
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1521
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1522
%{  /* NOCONTEXT */
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1523
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1524
    unsigned INT bits;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1525
    int count;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1526
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1527
    if (__isSmallInteger(shiftCount)) {
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1528
        count = __intVal(shiftCount);
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1529
        count = count % 32;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1530
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1531
        bits = __intVal(self);
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1532
        if (count > 0) {
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1533
            bits = (bits << count) | (bits >> (32-count));
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1534
        } else {
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1535
            bits = (bits >> (-count)) | (bits << (32-(-count)));
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1536
        }
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1537
#if __POINTER_SIZE__ == 8
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1538
        bits &= 0xFFFFFFFFL;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1539
#endif
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1540
        RETURN (__MKUINT(bits));
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1541
    }
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1542
%}.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1543
    ^ self primitiveFailed
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1544
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1545
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1546
     128 rotate32:1
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1547
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1548
     1 rotate32:1   
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1549
     1 rotate32:2   
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1550
     1 rotate32:31
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1551
     1 rotate32:32
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1552
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1553
     1 rotate32:-1   
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1554
     1 rotate32:-2   
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1555
     1 rotate32:-3   
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1556
     1 rotate32:-32   
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1557
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1558
!
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1559
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1560
bitShift32:shiftCount
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1561
    "return the value of the receiver shifted by shiftCount bits,
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1562
     but only within 32 bits, shifting into/out-of the sign bit.
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1563
     May be useful for communication interfaces, to create ST-numbers
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1564
     from a signed 32bit int value given as individual bytes,
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1565
     or to emulate C/Java semantics."
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1566
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1567
%{  /* NOCONTEXT */
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1568
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1569
    INT bits, count;
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1570
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1571
    if (__isSmallInteger(shiftCount)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1572
	count = __intVal(shiftCount);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1573
	if (count >= 32) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1574
	    RETURN (__mkSmallInteger(0));
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1575
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1576
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1577
	bits = __intVal(self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1578
	if (count > 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1579
	    bits = bits << count;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1580
	} else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1581
	    bits = bits >> (-count);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1582
	}
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1583
#if __POINTER_SIZE__ == 8
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1584
	bits &= 0xFFFFFFFFL;
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1585
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1586
	RETURN (__MKINT(bits));
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1587
    }
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1588
%}.
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1589
    ^ self primitiveFailed
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1590
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1591
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1592
     128 bitShift:24
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1593
     128 bitShift32:24
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1594
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1595
     1 bitShift:31
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1596
     1 bitShift32:31
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1597
    "
6415
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1598
!
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1599
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1600
bitXor32:aNumber
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1601
    "return the xor of the receiver and the argument.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1602
     The argument must be another SmallInteger or a 4-byte LargeInteger.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1603
     If the result overflows the 32 bit range, the value modulo 16rFFFFFFFF is returned.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1604
     This is of course not always correct, but allows for C/Java behavior to be emulated."
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1605
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1606
%{  /* NOCONTEXT */
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1607
    INT rslt;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1608
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1609
    rslt =  __unsignedLongIntVal(self) ^ __unsignedLongIntVal(aNumber);
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1610
#if __POINTER_SIZE__ == 8
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1611
    rslt &= 0xFFFFFFFFL;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1612
#endif
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1613
    RETURN ( __MKUINT(rslt));
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1614
%}.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1615
    self primitiveFailed
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1616
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1617
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1618
     16r7FFFFFFF bitXor: 16r80000000          4294967295
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1619
     16r7FFFFFFF bitXor32: 16r80000000
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1620
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1621
!
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  1622
6415
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1623
unsignedBitShift32:shiftCount
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1624
    "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
  1625
     but only within 32 unsigned bits.
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1626
     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
  1627
     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
  1628
     or to emulate C/Java semantics."
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1629
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1630
%{  /* NOCONTEXT */
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1631
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1632
    unsigned INT bits;
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1633
    INT count;
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1634
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1635
    if (__isSmallInteger(shiftCount)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1636
	count = __intVal(shiftCount);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1637
	if (count >= 32) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1638
	    RETURN (__mkSmallInteger(0));
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1639
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1640
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1641
	bits = __intVal(self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1642
	if (count > 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1643
	    bits = bits << count;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1644
	} else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1645
	    bits = bits >> (-count);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1646
	}
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1647
#if __POINTER_SIZE__ == 8
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1648
	bits &= 0xFFFFFFFFL;
6415
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1649
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1650
	RETURN (__MKUINT(bits));
6415
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1651
    }
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1652
%}.
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1653
    ^ self primitiveFailed
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1654
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1655
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1656
     128 unsignedBitShift:24
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1657
     128 unsignedBitShift32:24
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1658
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1659
     1 unsignedBitShift:31
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1660
     1 unsignedBitShift32:31
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1661
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1662
     -1 unsignedBitShift32:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1663
     -1 unsignedBitShift32:1
6415
f163a6319b5f unsigned C/Java 32bit shifts
Claus Gittinger <cg@exept.de>
parents: 6400
diff changeset
  1664
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1665
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1666
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1667
!SmallInteger methodsFor:'byte access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1668
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1669
digitAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1670
    "return 8 bits of value, starting at byte index"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1671
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1672
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1673
357
claus
parents: 329
diff changeset
  1674
    REGISTER INT val;
claus
parents: 329
diff changeset
  1675
    INT idx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1676
252
  1677
    if (__isSmallInteger(index)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1678
	val = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1679
	if (val < 0)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1680
	    val = -val;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1681
	switch (idx = __intVal(index)) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1682
	    case 1:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1683
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1684
	    case 2:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1685
		val = (val >> 8);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1686
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1687
	    case 3:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1688
		val = (val >> 16);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1689
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1690
	    case 4:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1691
		val = (val >> 24);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1692
		break;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1693
#if __POINTER_SIZE__ == 8
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1694
	    case 5:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1695
		val = (val >> 32);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1696
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1697
	    case 6:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1698
		val = (val >> 40);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1699
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1700
	    case 7:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1701
		val = (val >> 48);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1702
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1703
	    case 8:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1704
		val = (val >> 56);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1705
		break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1706
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1707
	    default:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1708
		if (idx < 1)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1709
		    goto bad;   /* sorry */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1710
		RETURN (__mkSmallInteger(0));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1711
	}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1712
	RETURN ( __mkSmallInteger( val & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1713
    }
357
claus
parents: 329
diff changeset
  1714
  bad: ;
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1715
%}.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1716
    index > 0 ifFalse:[
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1717
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1718
	 index less than 1 - not allowed
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1719
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1720
	^ self primitiveFailed
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1721
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1722
    ^ 0
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1723
357
claus
parents: 329
diff changeset
  1724
    "
claus
parents: 329
diff changeset
  1725
     (16r12345678 digitAt:1) printStringRadix:16
claus
parents: 329
diff changeset
  1726
     (16r12345678 digitAt:3) printStringRadix:16
claus
parents: 329
diff changeset
  1727
     (16r12345678 digitAt:15) printStringRadix:16
claus
parents: 329
diff changeset
  1728
     (16r12345678 digitAt:0) printStringRadix:16
claus
parents: 329
diff changeset
  1729
     (16r12345678 digitAt:-10) printStringRadix:16
claus
parents: 329
diff changeset
  1730
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1731
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1732
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1733
digitByteAt:index
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1734
    "return 8 bits of my signed value, starting at byte index.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1735
     For positive receivers, this is the same as #digitAt:;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1736
     for negative ones, the actual bit representation is returned."
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1737
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1738
%{  /* NOCONTEXT */
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1739
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1740
    REGISTER INT val;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1741
    INT idx;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1742
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1743
    if (__isSmallInteger(index)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1744
	val = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1745
	switch (idx = __intVal(index)) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1746
	    case 1:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1747
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1748
	    case 2:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1749
		val = (val >> 8);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1750
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1751
	    case 3:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1752
		val = (val >> 16);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1753
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1754
	    case 4:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1755
		val = (val >> 24);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1756
		break;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1757
#if __POINTER_SIZE__ == 8
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1758
	    case 5:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1759
		val = (val >> 32);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1760
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1761
	    case 6:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1762
		val = (val >> 40);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1763
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1764
	    case 7:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1765
		val = (val >> 48);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1766
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1767
	    case 8:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1768
		val = (val >> 56);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1769
		break;
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1770
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1771
	    default:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1772
		if (idx < 1)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1773
		    goto bad;   /* sorry */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1774
		if (val < 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1775
		    RETURN (__mkSmallInteger(0xFF));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1776
		}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1777
		RETURN (__mkSmallInteger(0));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1778
	}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1779
	RETURN ( __mkSmallInteger( val & 0xFF) );
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1780
    }
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1781
  bad: ;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1782
%}.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1783
    index > 0 ifFalse:[
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1784
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1785
	 index less than 1 - not allowed
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1786
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1787
	^ self primitiveFailed
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1788
    ].
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1789
    ^ 0
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1790
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1791
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1792
     (10 digitByteAt:1) printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1793
     (10 digitByteAt:3) printStringRadix:16
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1794
     (-10 digitByteAt:1) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1795
     (-10 digitByteAt:3) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1796
    "
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1797
!
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1798
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1799
digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1800
    "return a byteArray filled with the receivers bits
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1801
     (8 bits of the absolute value per element),
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1802
     least significant byte is first"
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1803
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1804
    |absValue
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1805
     b1 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1806
     b2 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1807
     b3 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1808
     b4 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1809
     b5 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1810
     b6 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1811
     b7 "{ Class: SmallInteger }" digitByteArray|
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1812
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1813
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1814
     could have simply created a 4-byte largeinteger and normalize it.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1815
     The code below does the normalize right away, avoiding the
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1816
     overhead of producing any intermediate byte-arrays (and the scanning)
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1817
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1818
    self == 0 ifTrue: [
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1819
        ^ ByteArray with:0.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1820
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1821
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1822
    self < 0 ifTrue: [
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1823
        absValue := self negated
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1824
    ] ifFalse: [
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1825
        absValue := self.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1826
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1827
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1828
    b1 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1829
    absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1830
    absValue == 0 ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1831
        digitByteArray := ByteArray with:b1
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1832
    ] ifFalse:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1833
        b2 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1834
        absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1835
        absValue == 0 ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1836
            digitByteArray := ByteArray with:b1 with:b2
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1837
        ] ifFalse:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1838
            b3 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1839
            absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1840
            absValue == 0 ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1841
                digitByteArray := ByteArray with:b1 with:b2 with:b3
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1842
            ] ifFalse:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1843
                b4 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1844
                absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1845
                absValue == 0 ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1846
                    digitByteArray := ByteArray with:b1 with:b2 with:b3 with:b4
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1847
                ] ifFalse:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1848
                    b5 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1849
                    absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1850
                    absValue == 0 ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1851
                        digitByteArray := ByteArray new:5.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1852
                        digitByteArray at:1 put:b1.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1853
                        digitByteArray at:2 put:b2.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1854
                        digitByteArray at:3 put:b3.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1855
                        digitByteArray at:4 put:b4.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1856
                        digitByteArray at:5 put:b5.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1857
                    ] ifFalse:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1858
                        b6 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1859
                        absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1860
                        absValue == 0 ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1861
                            digitByteArray := ByteArray new:6.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1862
                            digitByteArray at:1 put:b1.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1863
                            digitByteArray at:2 put:b2.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1864
                            digitByteArray at:3 put:b3.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1865
                            digitByteArray at:4 put:b4.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1866
                            digitByteArray at:5 put:b5.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1867
                            digitByteArray at:6 put:b6.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1868
                        ] ifFalse:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1869
                            b7 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1870
                            absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1871
                            absValue == 0 ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1872
                                digitByteArray := ByteArray new:7.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1873
                                digitByteArray at:1 put:b1.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1874
                                digitByteArray at:2 put:b2.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1875
                                digitByteArray at:3 put:b3.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1876
                                digitByteArray at:4 put:b4.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1877
                                digitByteArray at:5 put:b5.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1878
                                digitByteArray at:6 put:b6.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1879
                                digitByteArray at:7 put:b7.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1880
                            ] ifFalse:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1881
                                digitByteArray := ByteArray new:8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1882
                                digitByteArray at:1 put:b1.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1883
                                digitByteArray at:2 put:b2.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1884
                                digitByteArray at:3 put:b3.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1885
                                digitByteArray at:4 put:b4.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1886
                                digitByteArray at:5 put:b5.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1887
                                digitByteArray at:6 put:b6.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1888
                                digitByteArray at:7 put:b7.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1889
                                digitByteArray at:8 put:absValue.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1890
                            ]
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1891
                        ]
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1892
                    ]
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1893
                ]
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1894
            ]
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1895
        ]
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1896
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1897
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1898
    ^ digitByteArray
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1899
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1900
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1901
      16r12 digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1902
      16r1234 digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1903
      16r12345678 digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1904
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1905
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1906
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1907
digitBytesMSB:msbFlag
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1908
    "return a byteArray filled with the receivers bits
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1909
     (8 bits of the absolute value per element),
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1910
     if msbflag = true, most significant byte is first,
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1911
     otherwise least significant byte is first"
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1912
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1913
    msbFlag ifTrue:[
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1914
        ^ self digitBytes reversed.  "digitBytes has been just created - reverse inplace"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1915
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1916
    ^ self digitBytes
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1917
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1918
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1919
      16r12 digitBytesMSB:true
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1920
      16r1234 digitBytesMSB:true
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1921
      16r1234 digitBytesMSB:false
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1922
      16r12345678 digitBytesMSB:true
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1923
      16r12345678 digitBytesMSB:false
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1924
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1925
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1926
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1927
digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1928
    "return the number bytes required to represent this Integer.
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1929
     For negative receivers, the digitLength of its absolute value
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1930
     is returned."
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1931
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1932
%{  /* NOCONTEXT */
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1933
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1934
    INT val = __intVal(self);
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1935
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1936
    if (val < 0) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1937
	val = -val;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1938
    }
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1939
#if __POINTER_SIZE__ == 8
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1940
    if (val & 0xFFFFFFFF00000000L) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1941
	if (val & 0xFFFF000000000000L) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1942
	    if (val & 0xFF00000000000000L) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1943
		RETURN ( __mkSmallInteger(8));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1944
	    } else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1945
		RETURN ( __mkSmallInteger(7));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1946
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1947
	} else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1948
	    if (val & 0x0000FF0000000000L) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1949
		RETURN ( __mkSmallInteger(6));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1950
	    } else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1951
		RETURN ( __mkSmallInteger(5));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1952
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1953
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1954
    }
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1955
#endif
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1956
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1957
    if (val & 0xFFFF0000) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1958
	if (val & 0xFF000000) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1959
	    RETURN ( __mkSmallInteger(4));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1960
	} else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1961
	    RETURN ( __mkSmallInteger(3));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1962
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1963
    } else {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1964
	if (val & 0x0000FF00) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1965
	    RETURN ( __mkSmallInteger(2));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1966
	} else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1967
	    RETURN ( __mkSmallInteger(1));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1968
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1969
    }
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1970
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1971
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1972
    ^ self abs highBit - 1 // 8 + 1
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1973
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1974
    "
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1975
     16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1976
     -16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1977
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1978
     16rFF000000 digitLength
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1979
     16rFF0000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1980
     16rFF00 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1981
     16rFF digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1982
     -16rFF000000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1983
     -16rFF0000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1984
     -16rFF00 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1985
     -16rFF digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  1986
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1987
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1988
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1989
!SmallInteger methodsFor:'catching messages'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1990
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1991
basicAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1992
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1993
     defined here since basicAt: in Object ommits the SmallInteger check."
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
    self notIndexed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1996
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1997
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1998
basicAt:index put:anObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1999
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2000
     defined here since basicAt:put: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2001
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2002
    self notIndexed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2003
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2004
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2005
basicSize
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2006
    "return the number of indexed instvars - SmallIntegers have none.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2007
     Defined here since basicSize in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2008
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2009
    ^ 0
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
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2012
size
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2013
    "return the number of indexed instvars - SmallIntegers have none."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2014
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2015
    ^ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2016
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2017
5240
2a91958ba1f1 categories
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  2018
!SmallInteger methodsFor:'coercing & converting'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2019
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2020
asCharacter
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2021
    "Return a character with the receiver as ascii value"
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  2022
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2023
    ^ Character value:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2024
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2025
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2026
asFloat
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  2027
    "return a Float with same value as receiver.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  2028
     Redefined for performance (machine can do it faster)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2029
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2030
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2031
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2032
    OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2033
    double dVal = (double)__intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2034
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  2035
    __qMKFLOAT(newFloat, dVal);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2036
    RETURN ( newFloat );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2037
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2038
    ^ self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2039
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2040
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2041
asLargeInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2042
    "return a LargeInteger with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2043
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2044
    ^ LargeInteger value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2045
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2046
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2047
asShortFloat
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  2048
    "return a ShortFloat with same value as receiver.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  2049
     Redefined for performance (machine can do it faster)"
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2050
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2051
%{  /* NOCONTEXT */
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2052
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2053
    OBJ dummy = @global(ShortFloat);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2054
    OBJ newFloat;
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2055
    float fVal = (float)__intVal(self);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2056
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  2057
    __qMKSFLOAT(newFloat, fVal);
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2058
    RETURN ( newFloat );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2059
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2060
    ^ self primitiveFailed
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2061
!
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2062
8408
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2063
codePoint
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2064
    "for compatibility with Characters.
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2065
     (Allows for integers to be stored into U16/U32 strings)"
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2066
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2067
    ^ self
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2068
!
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2069
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2070
coerce:aNumber
11718
1128a869a77a comment
Claus Gittinger <cg@exept.de>
parents: 11666
diff changeset
  2071
    "convert the argument aNumber into an instance of the receivers class and return it."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2072
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2073
    ^ aNumber asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2074
!
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
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2077
    "return the generality value - see ArithmeticValue>>retry:coercing:"
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
    ^ 20
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2080
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2081
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2082
signExtended24BitValue
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2083
    "return a smallInteger from sign-extending the 24'th bit.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2084
     May be useful for communication interfaces"
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2085
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2086
%{  /* NOCONTEXT */
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2087
    INT i = __intVal(self);
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2088
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2089
    if (i & 0x800000) {
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2090
        i = i | ~0xFFFFFFL;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2091
    } else {
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2092
        i = i & 0x7FFFFF;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2093
    }
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2094
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2095
    RETURN (__mkSmallInteger(i));
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2096
%}.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2097
    ^ self primitiveFailed
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2098
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2099
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2100
     16rFFFFFF signExtended24BitValue
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2101
     16r800000 signExtended24BitValue
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2102
     16r7FFFFF signExtended24BitValue
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2103
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2104
!
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2105
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2106
signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2107
    "return a smallInteger from sign-extending the 8'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2108
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2109
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2110
%{  /* NOCONTEXT */
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  2111
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2112
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2113
    if (i & 0x80) {
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2114
        i = i | ~0xFFL;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2115
    } else {
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2116
        i = i & 0x7F;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2117
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2118
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2119
    RETURN (__mkSmallInteger(i));
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2120
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2121
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2122
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2123
    "
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2124
     16rFF signExtendedByteValue 
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2125
     16r80 signExtendedByteValue 
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2126
     16r7F signExtendedByteValue 
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2127
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2128
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2129
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2130
signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2131
    "return a smallInteger from sign-extending the 16'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2132
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2133
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2134
%{  /* NOCONTEXT */
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  2135
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2136
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2137
    if (i & 0x8000) {
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2138
        i = i | ~0xFFFFL;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2139
    } else {
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2140
        i = i & 0x7FFF;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2141
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2142
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2143
    RETURN (__mkSmallInteger(i));
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2144
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2145
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2146
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2147
    "
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2148
     16rFFFF signExtendedShortValue 
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2149
     16r8000 signExtendedShortValue 
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  2150
     16r7FFF signExtendedShortValue 
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2151
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2152
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2153
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2154
!SmallInteger methodsFor:'comparing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2155
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2156
< aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2157
    "return true, if the argument is greater than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2158
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2159
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2160
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2161
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2162
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2163
	RETURN ( (__intVal(self) < __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2164
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2165
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2166
	RETURN ( ((INT)self < (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2167
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2168
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2169
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2170
	RETURN ( ((double)__intVal(self) < __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2171
    }
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2172
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2173
    ^ aNumber lessFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2174
    "^ self retry:#< coercing:aNumber"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2175
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2176
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2177
<= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2178
    "return true, if the argument is greater or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2179
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2180
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2181
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2182
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2183
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2184
	RETURN ( (__intVal(self) <= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2185
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2186
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2187
	RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2188
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2189
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2190
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2191
	RETURN ( ((double)__intVal(self) <= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2192
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2193
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2194
    ^ (self > aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2195
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2196
    "Modified: / 31.7.2002 / 10:07:17 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2197
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2198
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2199
= aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2200
    "return true, if the argument represents the same numeric value
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2201
     as the receiver, false otherwise"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2202
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2203
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2204
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2205
    if (aNumber == self) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2206
	RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2207
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2208
    if (! __isNonNilObject(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2209
	/* a smallint or nil */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2210
	RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2211
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2212
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2213
    if (__qIsFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2214
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2215
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2216
    if (__qIsShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2217
	RETURN ( ((double)__intVal(self) == __shortFloatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2218
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2219
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2220
    ^ aNumber equalFromInteger:self
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2221
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2222
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2223
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2224
    "return true, if the argument is less than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2225
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2226
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2227
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2228
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2229
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2230
	RETURN ( (__intVal(self) > __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2231
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2232
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2233
	RETURN ( ((INT)self > (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2234
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2235
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2236
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2237
	RETURN ( ((double)__intVal(self) > __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2238
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2239
%}.
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2240
    ^ (aNumber < self)
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2241
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2242
    "Modified: / 31.7.2002 / 10:07:05 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2243
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2244
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2245
>= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2246
    "return true, if the argument is less or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2247
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2248
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2249
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2250
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2251
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2252
	RETURN ( (__intVal(self) >= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2253
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2254
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2255
	RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2256
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2257
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2258
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2259
	RETURN ( ((double)__intVal(self) >= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2260
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2261
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2262
    ^ (self < aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2263
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2264
    "Modified: / 31.7.2002 / 10:07:11 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2265
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2266
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2267
hash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2268
    "return an integer useful for hashing on value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2269
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2270
    self >= 0 ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2271
    ^ self negated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2272
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2273
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2274
identityHash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2275
    "return an integer useful for hashing on identity"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2276
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  2277
     self >= 0 ifTrue:[^ self].
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  2278
     ^ self negated
1963
ea26c7b9ca1d experimental: new hash value for smallInts
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2279
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  2280
    "Modified: 11.11.1996 / 18:42:14 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2281
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2282
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2283
max:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2284
    "return the receiver or the argument, whichever is greater"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2285
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2286
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2287
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2288
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2289
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2290
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2291
	if ((INT)(self) > (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2292
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2293
	if (__intVal(self) > __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2294
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2295
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2296
	    RETURN ( self );
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
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2299
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2300
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2301
	if ( (double)__intVal(self) > __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2302
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2303
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2304
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2305
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2306
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2307
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2308
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2309
    (self > aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2310
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2311
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2312
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2313
min:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2314
    "return the receiver or the argument, whichever is smaller"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2315
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2316
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2317
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2318
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2319
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2320
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2321
	if ((INT)(self) < (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2322
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2323
	if (__intVal(self) < __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2324
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2325
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2326
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2327
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2328
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2329
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2330
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2331
	if ( (double)__intVal(self) < __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2332
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2333
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2334
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2335
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2336
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2337
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2338
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2339
    (self < aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2340
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2341
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2342
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2343
~= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2344
    "return true, if the arguments value is not equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2345
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2346
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2347
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2348
    if (aNumber == self) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2349
	RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2350
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2351
    if (! __isNonNilObject(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2352
	/* a smallint or nil */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2353
	RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2354
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2355
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2356
    if (__qIsFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2357
	RETURN ( ((double)__intVal(self) != __floatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2358
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2359
    if (__qIsShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2360
	RETURN ( ((double)__intVal(self) != __shortFloatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2361
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2362
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2363
    ^ (self = aNumber) not
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2364
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2365
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2366
!SmallInteger methodsFor:'copying'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2367
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2368
deepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2369
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2370
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2371
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2372
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2373
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2374
10947
e01ba2c3533f deepCopy change
ab
parents: 10487
diff changeset
  2375
deepCopyUsing:aDictionary postCopySelector:postCopySelector
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2376
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2377
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2378
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2379
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2380
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2381
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2382
shallowCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2383
    "return a shallow copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2384
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2385
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2386
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2387
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2388
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2389
simpleDeepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2390
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2391
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2392
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2393
    ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2394
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2395
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2396
!SmallInteger methodsFor:'iteration'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2397
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2398
timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  2399
    "evaluate the argument, aBlock self times.
claus
parents: 329
diff changeset
  2400
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2401
357
claus
parents: 329
diff changeset
  2402
%{
claus
parents: 329
diff changeset
  2403
    REGISTER INT tmp;
claus
parents: 329
diff changeset
  2404
    static struct inlineCache blockVal = __ILC0(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2405
357
claus
parents: 329
diff changeset
  2406
    tmp = __intVal(self);
claus
parents: 329
diff changeset
  2407
    if (tmp > 0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2408
	if (__isBlockLike(aBlock)
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2409
	 && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(0))) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2410
	    {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2411
		REGISTER OBJFUNC codeVal;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2412
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2413
		/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2414
		 * specially tuned version for compiled blocks,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2415
		 * (the most common case)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2416
		 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2417
		if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2418
#ifdef PARANOIA
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2419
		 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2420
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2421
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2422
357
claus
parents: 329
diff changeset
  2423
#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
  2424
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2425
#                   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
  2426
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2427
#else
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
#                   define BLOCK_ARG  rHome
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2430
		    REGISTER OBJ rHome;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2431
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2432
		    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2433
		     * home on stack - no need to refetch
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2434
		     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2435
		    rHome = __BlockInstPtr(aBlock)->b_home;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2436
		    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
  2437
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2438
		    {
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2439
#ifdef __UNROLL_LOOPS__
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2440
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2441
			/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2442
			 * you are not supposed to program like this - I know what I do
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2443
			 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2444
			while (tmp > 8) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2445
			    if (InterruptPending != nil) goto interrupted0;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2446
	continue0:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2447
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2448
			    if (InterruptPending != nil) goto interrupted1;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2449
	continue1:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2450
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2451
			    if (InterruptPending != nil) goto interrupted2;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2452
	continue2:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2453
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2454
			    if (InterruptPending != nil) goto interrupted3;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2455
	continue3:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2456
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2457
			    if (InterruptPending != nil) goto interrupted4;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2458
	continue4:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2459
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2460
			    if (InterruptPending != nil) goto interrupted5;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2461
	continue5:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2462
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2463
			    if (InterruptPending != nil) goto interrupted6;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2464
	continue6:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2465
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2466
			    if (InterruptPending != nil) goto interrupted7;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2467
	continue7:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2468
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2469
			    tmp -= 8;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2470
			}
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2471
#endif /* __UNROLL_LOOPS__ */
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2472
			do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2473
			    if (InterruptPending != nil) goto interruptedX;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2474
	continueX:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2475
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2476
			} while(--tmp);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2477
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2478
			RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2479
			if (0) {
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2480
#ifdef __UNROLL_LOOPS__
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2481
			    interrupted0:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2482
						__interruptL(@line); goto continue0;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2483
			    interrupted1:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2484
						__interruptL(@line); goto continue1;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2485
			    interrupted2:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2486
						__interruptL(@line); goto continue2;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2487
			    interrupted3:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2488
						__interruptL(@line); goto continue3;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2489
			    interrupted4:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2490
						__interruptL(@line); goto continue4;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2491
			    interrupted5:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2492
						__interruptL(@line); goto continue5;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2493
			    interrupted6:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2494
						__interruptL(@line); goto continue6;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2495
			    interrupted7:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2496
						__interruptL(@line); goto continue7;
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2497
#endif /* __UNROLL_LOOPS__ */
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2498
			    interruptedX:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2499
						__interruptL(@line); goto continueX;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2500
			}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2501
		    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2502
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2503
	    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  2504
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2505
#           undef BLOCK_ARG
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  2506
400
claus
parents: 394
diff changeset
  2507
#ifdef NEW_BLOCK_CALL
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2508
#           define BLOCK_ARG  aBlock
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2509
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  2510
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2511
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2512
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  2513
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  2514
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2515
	    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2516
	     * sorry - must check for the blocks code within the loops;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2517
	     * it could be recompiled or flushed (in the interrupt)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2518
	     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2519
	    do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2520
		REGISTER OBJFUNC codeVal;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2521
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2522
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2523
		    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2524
		     * arg is a compiled block with code -
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2525
		     * directly call it without going through Block>>value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2526
		     * however, if there is an interrupt, refetch the code pointer.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2527
		     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2528
		    /* stay here, while no interrupts are pending ... */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2529
		    do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2530
			(*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2531
			if (InterruptPending != nil) goto outerLoop;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2532
		    } while (--tmp);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2533
		    RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2534
		} else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2535
		    if (InterruptPending != nil) __interruptL(@line);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2536
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2537
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2538
			/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2539
			 * arg is a compiled block with bytecode -
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2540
			 * directly call interpreter without going through Block>>value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2541
			 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2542
			__interpret(aBlock, 0, nil, IBLOCK_ARG, nil, nil);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2543
		    } else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2544
			/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2545
			 * arg is something else - call it with #value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2546
			 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2547
			(*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2548
		    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2549
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2550
    outerLoop: ;
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2551
	    } while (--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2552
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2553
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2554
#           undef IBLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2555
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2556
	    RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2557
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2558
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2559
	/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2560
	 * not a block-like thingy - call it with #value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2561
	 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2562
	do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2563
	    if (InterruptPending != nil) __interruptL(@line);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2564
	    (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2565
	} while(--tmp);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2566
	RETURN (self);
357
claus
parents: 329
diff changeset
  2567
    }
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2568
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2569
    ^ super timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  2570
claus
parents: 329
diff changeset
  2571
"/    |count "{ Class: SmallInteger }" |
claus
parents: 329
diff changeset
  2572
"/
claus
parents: 329
diff changeset
  2573
"/    count := self.
claus
parents: 329
diff changeset
  2574
"/    [count > 0] whileTrue:[
claus
parents: 329
diff changeset
  2575
"/        aBlock value.
claus
parents: 329
diff changeset
  2576
"/        count := count - 1
claus
parents: 329
diff changeset
  2577
"/    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2578
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2579
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2580
to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2581
    "reimplemented as primitive for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2582
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2583
%{
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2584
    REGISTER INT tmp, step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2585
    REGISTER INT final;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2586
    static struct inlineCache blockVal = __ILC1(0);
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2587
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2588
    if (__bothSmallInteger(incr, stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2589
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2590
	final = __intVal(stop);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2591
	step = __intVal(incr);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2592
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2593
	if (__isBlockLike(aBlock)
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2594
	 && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2595
	    {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2596
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2597
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2598
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2599
		 * specially tuned version for static compiled blocks, called with
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2600
		 * home on the stack (the most common case)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2601
		 */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2602
		if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2603
#ifdef PARANOIA
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2604
		 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2605
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2606
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2607
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2608
#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
  2609
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2610
#                   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
  2611
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2612
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2613
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2614
#                   define BLOCK_ARG  rHome
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2615
		    REGISTER OBJ rHome;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2616
		    rHome = __BlockInstPtr(aBlock)->b_home;
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2617
		    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
  2618
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2619
#endif
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2620
		    {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2621
			if (step < 0) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2622
			    if (step == -1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2623
				while (tmp >= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2624
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2625
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2626
				    tmp--;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2627
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2628
			    } else {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2629
				while (tmp >= final) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2630
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2631
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2632
				    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2633
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2634
			    }
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2635
			} else {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2636
			    if (step == 1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2637
				while (tmp <= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2638
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2639
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2640
				    tmp++;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2641
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2642
			    } else {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2643
				while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2644
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2645
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2646
				    tmp += step;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2647
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2648
			    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2649
			}
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2650
			RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2651
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2652
		}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2653
	    }
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2654
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2655
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2656
	     * 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
  2657
	     * 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
  2658
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2659
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2660
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2661
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2662
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2663
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2664
#           define IBLOCK_ARG nil
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2665
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2666
#           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
  2667
#           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
  2668
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2669
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2670
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2671
		while (tmp >= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2672
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2673
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2674
		    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
  2675
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2676
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2677
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2678
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2679
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2680
			 */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2681
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2682
		    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2683
			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
  2684
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2685
			     * 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
  2686
			     * 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
  2687
			     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2688
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2689
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2690
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2691
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2692
				idx = __mkSmallInteger(tmp);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2693
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2694
			    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2695
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2696
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2697
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2698
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2699
			} else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2700
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2701
			     * arg is something else - call it with #value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2702
			     */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2703
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2704
			}
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2705
		    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2706
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2707
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2708
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2709
		while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2710
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2711
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2712
		    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
  2713
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2714
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2715
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2716
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2717
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2718
			 */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2719
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2720
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2721
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2722
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2723
			     * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2724
			     * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2725
			     */
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2726
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2727
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2728
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2729
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2730
				idx = __mkSmallInteger(tmp);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2731
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2732
			    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2733
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2734
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2735
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2736
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2737
			} else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2738
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2739
			     * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2740
			     */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2741
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2742
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2743
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2744
		    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2745
		}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2746
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2747
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2748
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2749
#           undef IBLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2750
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2751
	} else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2752
	    /*
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2753
	     * arg is something else - call it with #value:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2754
	     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2755
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2756
		while (tmp >= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2757
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2758
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2759
		    (*blockVal.ilc_func)(aBlock,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2760
					 @symbol(value:),
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  2761
					 nil, &blockVal,
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2762
					 __mkSmallInteger(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2763
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2764
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2765
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2766
		while (tmp <= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2767
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2768
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2769
		    (*blockVal.ilc_func)(aBlock,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2770
					 @symbol(value:),
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  2771
					 nil, &blockVal,
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2772
					 __mkSmallInteger(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2773
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2774
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2775
	    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2776
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2777
	RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2778
    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  2779
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2780
    "/
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2781
    "/ 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
  2782
    "/ pass on to super ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2783
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2784
    ^ super to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2785
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2786
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2787
     1 to:10 by:3 do:[:i | i printNewline]
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2788
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2789
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2790
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2791
to:stop do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2792
    "evaluate aBlock for every integer between (and including) the receiver
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2793
     and the argument, stop.
357
claus
parents: 329
diff changeset
  2794
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2795
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2796
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2797
    REGISTER INT tmp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2798
    INT final;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  2799
    static struct inlineCache blockVal = __ILC1(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2800
252
  2801
    if (__isSmallInteger(stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2802
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2803
	final = __intVal(stop);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2804
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2805
	if (__isBlockLike(aBlock)
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2806
	 && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2807
	    {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2808
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2809
		 * 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
  2810
		 * where called with home on the stack
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2811
		 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2812
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2813
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2814
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2815
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2816
#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
  2817
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2818
#                   define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2819
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2820
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2821
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2822
#                   define BLOCK_ARG  rHome
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2823
		    REGISTER OBJ rHome;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2824
		    rHome = __BlockInstPtr(aBlock)->b_home;
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2825
		    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
  2826
#endif
400
claus
parents: 394
diff changeset
  2827
		    {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2828
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2829
#ifdef PARANOIA
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2830
			if (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2831
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2832
			{
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2833
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2834
			     * static compiled blocks ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2835
			     */
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2836
#ifdef __UNROLL_LOOPS__
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2837
			    /*
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2838
			     * 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
  2839
			     *  - taken branches only if interrupts are pending
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2840
			     *  - 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
  2841
			     *  - unrolled the loop
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2842
			     *
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2843
			     * 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
  2844
			     */
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2845
# if TAG_INT==1
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2846
			    INT t8 = (INT)(__mkSmallInteger(tmp+8));
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2847
			    tmp = (INT)(__mkSmallInteger(tmp));
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2848
			    final = (INT)(__mkSmallInteger(final));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2849
# else
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2850
			    INT t8 = tmp+8;
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2851
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2852
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2853
			    for (;;) {
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2854
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2855
				while (t8 <= final) {
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2856
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2857
				    t8 += (INT)(__MASKSMALLINT(8));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2858
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2859
				    t8 += 8;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2860
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2861
				    if (InterruptPending != nil) goto interrupted0;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2862
	continue0:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2863
# if TAG_INT==1
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2864
				    (*codeVal)(BLOCK_ARG, tmp);
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2865
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2866
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2867
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2868
				    if (InterruptPending != nil) goto interrupted1;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2869
	continue1:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2870
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2871
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(1)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2872
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2873
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+1));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2874
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2875
				    if (InterruptPending != nil) goto interrupted2;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2876
	continue2:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2877
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2878
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(2)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2879
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2880
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+2));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2881
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2882
				    if (InterruptPending != nil) goto interrupted3;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2883
	continue3:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2884
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2885
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(3)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2886
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2887
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+3));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2888
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2889
				    if (InterruptPending != nil) goto interrupted4;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2890
	continue4:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2891
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2892
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(4)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2893
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2894
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+4));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2895
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2896
				    if (InterruptPending != nil) goto interrupted5;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2897
	continue5:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2898
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2899
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(5)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2900
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2901
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+5));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2902
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2903
				    if (InterruptPending != nil) goto interrupted6;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2904
	continue6:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2905
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2906
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(6)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2907
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2908
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+6));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2909
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2910
				    if (InterruptPending != nil) goto interrupted7;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2911
	continue7:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2912
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2913
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(7)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2914
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2915
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+7));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2916
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2917
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2918
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2919
				    tmp += (INT)(__MASKSMALLINT(8));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2920
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2921
				    tmp += 8;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2922
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2923
				}
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2924
				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
  2925
				    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
  2926
	continueX:
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2927
# if TAG_INT==1
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2928
				    (*codeVal)(BLOCK_ARG, tmp);
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  2929
				    tmp += (INT)(__MASKSMALLINT(1));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2930
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2931
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2932
				    tmp++;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2933
# endif
4167
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
				RETURN (self);
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  2936
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2937
				if (0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2938
				    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2939
				     * no discussion about those gotos ...
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2940
				     * ... its better for your CPU's pipelines
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2941
				     * (if you dont understand why, just dont argue).
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2942
				     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2943
				    interrupted7:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2944
						    __interruptL(@line); goto continue7;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2945
				    interrupted6:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2946
						    __interruptL(@line); goto continue6;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2947
				    interrupted5:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2948
						    __interruptL(@line); goto continue5;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2949
				    interrupted4:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2950
						    __interruptL(@line); goto continue4;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2951
				    interrupted3:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2952
						    __interruptL(@line); goto continue3;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2953
				    interrupted2:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2954
						    __interruptL(@line); goto continue2;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2955
				    interrupted1:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2956
						    __interruptL(@line); goto continue1;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2957
				    interrupted0:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2958
						    __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
  2959
				    interruptedX:
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  2960
						    __interruptL(@line); goto continueX;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2961
				}
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2962
			    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  2963
#else
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2964
			    while (tmp <= final) {
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2965
				if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2966
				(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2967
				tmp ++;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2968
			    }
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  2969
			    RETURN (self);
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2970
#endif /* __UNROLL_LOOPS__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2971
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2972
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2973
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2974
			 * mhmh - seems to be a block with dynamic code
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2975
			 * must refetch, to allow dynamic recompilation or code flush.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2976
			 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2977
			while (tmp <= final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2978
			    if (InterruptPending != nil) __interruptL(@line);
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2979
			    if ((codeVal = __BlockInstPtr(aBlock)->b_code) == (OBJFUNC)nil) break;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2980
			    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2981
			    tmp ++;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2982
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2983
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2984
			if (tmp > final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2985
			    RETURN (self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2986
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2987
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2988
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2989
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2990
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2991
#           undef BLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2992
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2993
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2994
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2995
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  2996
#else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2997
#           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
  2998
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  2999
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3000
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3001
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3002
	     * 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
  3003
	     * 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
  3004
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3005
	    while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3006
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3007
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3008
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3009
		    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3010
		     * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3011
		     * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3012
		     */
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3013
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3014
		    /* stay here, while no interrupts are pending ... */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3015
		    do {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3016
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3017
			if (InterruptPending != nil) goto outerLoop;
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3018
			tmp++;
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3019
		    } while (tmp <= final);
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3020
		    RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3021
		} else {
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3022
		    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3023
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3024
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3025
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3026
			 * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3027
			 * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3028
			 */
400
claus
parents: 394
diff changeset
  3029
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3030
			{
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3031
			    OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3032
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3033
			    idx = __mkSmallInteger(tmp);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3034
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3035
			}
400
claus
parents: 394
diff changeset
  3036
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3037
			__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
400
claus
parents: 394
diff changeset
  3038
#endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3039
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3040
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3041
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3042
			 * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3043
			 */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3044
			(*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3045
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3046
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3047
	    outerLoop: ;
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3048
		tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3049
	    }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3050
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3051
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3052
#           undef IBLOCK_ARG
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3053
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3054
	    RETURN (self);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3055
	}
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3056
	/*
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3057
	 * arg is something else - call it with #value:
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3058
	 */
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3059
	while (tmp <= final) {
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3060
	    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3061
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3062
	    (*blockVal.ilc_func)(aBlock,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3063
					 @symbol(value:),
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3064
					 nil, &blockVal,
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3065
					 __mkSmallInteger(tmp));
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3066
	    tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3067
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3068
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3069
    }
400
claus
parents: 394
diff changeset
  3070
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3071
400
claus
parents: 394
diff changeset
  3072
    "/
claus
parents: 394
diff changeset
  3073
    "/ 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
  3074
    "/ pass on to super ...
400
claus
parents: 394
diff changeset
  3075
    "/
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3076
    ^ super to:stop do:aBlock
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3077
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3078
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3079
     1 to:10 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3080
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3081
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3082
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3083
!SmallInteger methodsFor:'misc math'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3084
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3085
bernoulli
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3086
    "returns the nth Bernoulli number.
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3087
     The series runs this:
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3088
	 1/6, 1/30, 1/42, 1/30, 5/66, 691/2730, etc
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3089
     Uses a table of the first 20 bernoulli numbers.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3090
     So bernoulli(42) will fail for now.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3091
     Used with taylor series for tan"
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3092
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3093
    |table p|
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3094
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3095
    table := #(
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3096
		(1 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3097
		(-1 30)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3098
		(1 42)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3099
		(-1 30)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3100
		(5 66)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3101
		(-691 2730)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3102
		(7 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3103
		(-3617 510)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3104
		(43867 798)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3105
		(-174611 330)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3106
		(854513 138)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3107
		(-236364091 2730)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3108
		(8553103 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3109
		(-23749461029 870)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3110
		(8615841276005 14322)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3111
		(-7709321041217 510)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3112
		(2577687858367 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3113
		(-26315271553053477373 1919190)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3114
		(2929993913841559 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3115
		(-261082718496449122051 13530)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3116
	      ).
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3117
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3118
    self even ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3119
	self == 0 ifTrue:[^1].
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3120
	p := table at:(self / 2).
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3121
	^ Fraction numerator:(p first) denominator:(p second).
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3122
    ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3123
    self == 1 ifTrue:[ ^ (1 / 2) ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3124
    ^ 0.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3125
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3126
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3127
     0 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3128
     1 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3129
     2 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3130
     3 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3131
     4 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3132
     5 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3133
     6 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3134
     8 bernoulli
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3135
     38 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3136
     40 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3137
     41 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3138
     42 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3139
    "
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3140
!
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3141
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3142
divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3143
    "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
  3144
     self \\ aNumber.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3145
     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
  3146
     argument."
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3147
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3148
%{  /* NOCONTEXT */
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3149
    INT val, div, mod, mySelf;
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3150
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
  3151
    if (__isSmallInteger(aNumber) &&
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3152
	(val = __intVal(aNumber)) > 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3153
	mySelf = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3154
	div = mySelf / val;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3155
	mod = mySelf % val;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3156
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3157
	RETURN (__ARRAY_WITH2( __mkSmallInteger(div),
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3158
			       __mkSmallInteger(mod)));
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3159
    }
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3160
%}.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3161
    ^ super divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3162
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3163
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3164
     10 // 3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3165
     10 \\ 3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3166
     10 divMod:3
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3167
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3168
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3169
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3170
gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3171
    "return the greatest common divisor (Euclid's algorithm).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3172
     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
  3173
     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
  3174
     some code. (thanx to MessageTally)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3175
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3176
%{  /* NOCONTEXT */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3177
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3178
    if (__isSmallInteger(anInteger)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3179
	INT orgArg, ttt, selfInt, orgSelfInt, temp;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3180
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3181
	ttt = orgArg = __intVal(anInteger);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3182
	if (ttt) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3183
	    selfInt = orgSelfInt = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3184
	    while (ttt != 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3185
		temp = selfInt % ttt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3186
		selfInt = ttt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3187
		ttt = temp;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3188
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3189
	    /*
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3190
	     * 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
  3191
	     * a modulus result is when the arg is negative,
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3192
	     * change it explicitely here ...
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3193
	     */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3194
	    if (orgArg < 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3195
		/* result should be negative */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3196
		if (orgSelfInt > 0) selfInt = -selfInt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3197
	    } else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3198
		/* result should be positive */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3199
		if (orgSelfInt < 0) selfInt = -selfInt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3200
	    }
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3201
	    RETURN ( __mkSmallInteger(selfInt) );
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3202
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3203
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3204
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3205
.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3206
    ^ super gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3207
!
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3208
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3209
gcd_helper:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3210
    "same as gcd - see knuth & Integer>>gcd:"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3211
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3212
    ^ self gcd:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3213
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3214
    "Created: 1.3.1997 / 16:58:01 / cg"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3215
!
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3216
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3217
intlog10
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3218
    "return the truncation of log10 of the receiver -
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3219
     stupid implementation; used to find out the number of digits needed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3220
     to print a number/and for conversion to a LargeInteger.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3221
     Implemented that way, to allow for tiny systems (PDAs) without a Float class
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3222
     (i.e. without log)."
2
claus
parents: 1
diff changeset
  3223
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3224
    self <= 0 ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3225
	^ self class
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3226
	    raise:#domainErrorSignal
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3227
	    receiver:self
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3228
	    selector:#intlog10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3229
	    arguments:#()
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3230
	    errorString:'logarithm of negative integer'
2
claus
parents: 1
diff changeset
  3231
    ].
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3232
    self < 10 ifTrue:[^ 0].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3233
    self < 100 ifTrue:[^ 1].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3234
    self < 1000 ifTrue:[^ 2].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3235
    self < 10000 ifTrue:[^ 3].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3236
    self < 100000 ifTrue:[^ 4].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3237
    self < 1000000 ifTrue:[^ 5].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3238
    self < 10000000 ifTrue:[^ 6].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3239
    self < 100000000 ifTrue:[^ 7].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3240
    self < 1000000000 ifTrue:[^ 8].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3241
    ^ 9
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3242
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3243
    "
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3244
      99 intlog10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3245
      100 intlog10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3246
      120 intlog10
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  3247
      -1 intlog10
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  3248
    "
2
claus
parents: 1
diff changeset
  3249
! !
claus
parents: 1
diff changeset
  3250
3135
8c0f47cf59e3 Fix typo.
Stefan Vogel <sv@exept.de>
parents: 3131
diff changeset
  3251
!SmallInteger methodsFor:'modulo arithmetic'!
2
claus
parents: 1
diff changeset
  3252
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3253
plus32:aNumber
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3254
    "return the sum of the receiver and the argument, as SmallInteger.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3255
     The argument must be another SmallInteger.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3256
     If the result overflows the 32 bit range, the value modulo 16rFFFFFFFF is returned.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3257
     This is of course not always correct, but allows for C/Java behavior to be emulated."
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3258
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3259
%{  /* NOCONTEXT */
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3260
    INT sum;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3261
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3262
    sum =  __unsignedLongIntVal(self) + __unsignedLongIntVal(aNumber);
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3263
#if __POINTER_SIZE__ == 8
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3264
    sum &= 0xFFFFFFFFL;
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3265
#endif
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3266
    RETURN ( __MKUINT(sum));
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3267
%}.
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3268
    self primitiveFailed
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3269
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3270
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3271
     16r7FFFFFFF + 1          2147483648
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3272
     16r7FFFFFFF plus32: 1    
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3273
    "
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3274
!
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3275
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3276
plus:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3277
    "return the sum of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3278
     The argument must be another SmallInteger.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3279
     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
  3280
     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
  3281
     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
  3282
     and can therefore speed things up by not going through LargeIntegers."
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  3283
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3284
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3285
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3286
    if (__isSmallInteger(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3287
	INT sum;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3288
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3289
	sum =  __intVal(self) + __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3290
	if (!__ISVALIDINTEGER(sum)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3291
	    /* keep the sign */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3292
	    sum %= _MAX_INT;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3293
	}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3294
	RETURN ( __mkSmallInteger(sum));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3295
    }
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  3296
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3297
    self primitiveFailed
8498
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3298
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3299
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3300
	5 plus:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3301
	5 plus:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3302
	1 plus:-5
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3303
	self maxVal plus:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3304
	self maxVal + 1
8498
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3305
    "
2
claus
parents: 1
diff changeset
  3306
!
claus
parents: 1
diff changeset
  3307
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3308
subtract:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3309
    "return the difference of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3310
     The argument must be another SmallInteger.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3311
     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
  3312
     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
  3313
     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
  3314
     and can therefore speed things up by not going through LargeIntegers."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3315
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3316
%{  /* NOCONTEXT */
2
claus
parents: 1
diff changeset
  3317
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3318
    if (__isSmallInteger(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3319
	INT diff;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3320
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3321
	diff = __intVal(self) - __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3322
	if (!__ISVALIDINTEGER(diff)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3323
	    /* keep the sign */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3324
	    diff %= _MAX_INT;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3325
	}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3326
	RETURN ( __mkSmallInteger(diff));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3327
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3328
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3329
    self primitiveFailed
8498
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3330
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3331
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3332
	-1 subtract:5
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3333
	5 subtract:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3334
	1 subtract:-5
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3335
	self minVal subtract:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3336
	self minVal - 1
8498
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3337
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3338
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3339
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3340
times:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3341
    "return the product of the receiver and the argument, as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3342
     The argument must be another SmallInteger.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3343
     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
  3344
     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
  3345
     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
  3346
     and can therefore speed things up by not going through LargeIntegers."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3347
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3348
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3349
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3350
    INT myValue, otherValue;
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3351
    unsigned INT productLow, productHi;
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3352
    int negative;
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3353
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3354
#   define low16Bits(foo)  ((foo) & 0xFFFF)
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3355
#   define hi16Bits(foo)   ((foo) >> 16)
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3356
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3357
#   define hi32Bits(foo)   ((foo) >> 32)
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3358
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3359
    /*
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3360
     * can we use long long arithmetic ?
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3361
     *
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3362
     * long-long arithmetic seems to be buggy with some systems
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3363
     * (took me a while to find this out :-(
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3364
     * (try 10000 * 10000)
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3365
     */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3366
#if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3367
# define USE_LONGLONG_FOR_MUL
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3368
#endif
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3369
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3370
#if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3371
# define USE_LONGLONG_FOR_MUL
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3372
#endif
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3373
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3374
    if (__isSmallInteger(aNumber)) {
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3375
        myValue = __intVal(self);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3376
        otherValue = __intVal(aNumber);
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3377
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3378
#if defined(USE_LONGLONG_FOR_MUL)
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3379
        {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3380
# if defined(__alpha__) && !defined(__alpha64__)
8498
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3381
#  define LONGLONG      INT64
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3382
# else
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3383
#  define LONGLONG      long long
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3384
# endif
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3385
            LONGLONG product;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3386
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3387
            product = (LONGLONG)myValue * (LONGLONG)otherValue;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3388
            if (product < 0) {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3389
                RETURN ( __mkSmallInteger(-(INT)(-product & _MAX_INT)));
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3390
            }
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3391
            RETURN ( __mkSmallInteger((INT)(product & _MAX_INT)));
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3392
        }
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3393
#else /* no long-long */
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3394
        negative = 1;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3395
        if (myValue < 0) {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3396
            negative = -1;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3397
            myValue = -myValue;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3398
        }
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3399
        if (otherValue < 0) {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3400
            negative = -negative;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3401
            otherValue = -otherValue;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3402
        }
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3403
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3404
# if defined(__GNUC__) && defined(__mc68k__)
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3405
        asm ("mulu%.l %3,%1:%0"
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3406
                : "=d"  ((unsigned long)(productLow)),
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3407
                  "=d"  ((unsigned long)(productHi))
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3408
                : "%0"  ((unsigned long)(myValue)),
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3409
                  "dmi" ((unsigned long)(otherValue)));
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3410
# else
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3411
#  if defined (__GNUC__) && defined(__i386__)
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3412
        asm ("mull %3"
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3413
                : "=a"  ((unsigned long)(productLow)),
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3414
                  "=d"  ((unsigned long)(productHi))
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3415
                : "%0"  ((unsigned long)(myValue)),
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3416
                  "rm"  ((unsigned long)(otherValue)));
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3417
#  else
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  3418
#   if defined(WIN32) && defined(__BORLANDC__)
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3419
        asm {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3420
            mov   eax, myValue
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3421
            mov   edx, otherValue
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3422
            mul   edx
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3423
            mov   productLow, eax
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3424
            mov   productHi, edx
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3425
        }
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3426
#   else /* generic */
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3427
        {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3428
            unsigned INT pHH, pHL, pLH, pLL;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3429
            unsigned INT low1, low2, hi1, hi2;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3430
            unsigned INT t;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3431
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3432
            /* unsigned multiply myValue * otherValue -> productHi, productLow
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3433
             *
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3434
             * this is too slow:
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3435
             * since most machines can do 32*32 to 64 bit multiply,
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3436
             * (or at least 32*32 with Overflow check)
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3437
             * - need more assembler (inline) functions here
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3438
             */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3439
#    if __POINTER_SIZE__ == 8
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3440
            low1 = low32Bits((unsigned INT)myValue);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3441
            hi1 = hi32Bits((unsigned INT)myValue);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3442
            low2 = low32Bits((unsigned INT)otherValue);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3443
            hi2 = hi32Bits((unsigned INT)otherValue);
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3444
#     define LLMASK 0xC000000000000000L
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3445
#    else
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3446
            low1 = low16Bits((unsigned INT)myValue);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3447
            hi1 = hi16Bits((unsigned INT)myValue);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3448
            low2 = low16Bits((unsigned INT)otherValue);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3449
            hi2 = hi16Bits((unsigned INT)otherValue);
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3450
#     define LLMASK 0xC0000000
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3451
#    endif
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3452
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3453
            pLH = low1 * hi2;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3454
            pHL = hi1 * low2;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3455
            pLL = low1 * low2;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3456
            pHH = hi1 * hi2;
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3457
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3458
            /*
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3459
             * the common case ...
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3460
             */
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3461
            if ((pHL == 0)
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3462
             && (pLH == 0)
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3463
             && (pHH == 0)
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3464
             && ((pLL & LLMASK) == 0)) {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3465
                if (negative < 0) {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3466
                    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3467
                }
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3468
                RETURN ( __mkSmallInteger((INT)pLL) );
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3469
            }
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3470
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3471
            /*
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3472
             *   pHH |--------|--------|
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3473
             *   pLH          |--------|--------|
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3474
             *   pHL          |--------|--------|
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3475
             *   pLL                   |--------|--------|
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3476
             */
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3477
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3478
#    if __POINTER_SIZE__ == 8
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3479
            t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3480
            productLow = (t << 32) + low32Bits(pLL);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3481
            productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3482
#    else
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3483
            t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3484
            productLow = (t << 16) + low16Bits(pLL);
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3485
            productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3486
#    endif
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3487
        }
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3488
#   endif /* ! WIN32 */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3489
#  endif /* ! (__GNUC__ && __i386__) */
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  3490
# endif /* ! (__GNUC__ && __mc68k__) */
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3491
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3492
        if (negative < 0) {
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3493
            RETURN ( __mkSmallInteger(-(INT)(productLow & _MAX_INT)));
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3494
        }
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3495
        RETURN ( __mkSmallInteger((INT)(productLow & _MAX_INT)));
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3496
#endif /* ! USE_LONGLONG */
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3497
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3498
%}.
8506
ddd41df3dc0f Fix #times: for WIN32
Stefan Vogel <sv@exept.de>
parents: 8498
diff changeset
  3499
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3500
    self primitiveFailed
8498
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3501
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3502
    "
17754
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3503
        5 times:-1
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3504
        5 times:1
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3505
        self maxVal-1 times:2
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3506
        self maxVal-1 times:-2
5322906cdb6a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3507
        self maxVal-1 * 2  bitAnd:16r3fffffff
8498
854b2c98379e keep the sign when doing modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 8417
diff changeset
  3508
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3509
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3510
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3511
!SmallInteger methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3512
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3513
printOn:aStream
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3514
    "append my printstring (base 10) to aStream."
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3515
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3516
    aStream nextPutAll:(self printString)
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3517
!
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3518
17728
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3519
printOn:aStream base:base showRadix:showRadix
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3520
    "append a string representation of the receiver in the specified numberBase to aStream
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3521
     (if showRadix is true, with initial XXr)
17728
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3522
     The base argument should be between 2 and 36."
6144
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  3523
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3524
    showRadix ifTrue:[
17728
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3525
        base printOn:aStream.
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3526
        aStream nextPut:$r.
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3527
    ].
17728
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3528
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3529
    (base isInteger and:[ base between:2 and:36 ]) ifTrue:[ 
17728
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3530
        aStream nextPutAll:(self printStringRadix:base)
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3531
    ] ifFalse:[
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3532
        super printOn:aStream base:base showRadix:false.
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3533
    ].
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3534
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3535
    "Created: / 07-09-2001 / 13:54:40 / cg"
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3536
    "Modified: / 02-08-2010 / 12:25:20 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3537
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3538
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3539
printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3540
    "return my printstring (base 10)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3541
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3542
    "since this was heavily used in some applications,
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3543
     here is an exception to the rule of basing printString
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3544
     upon the printOn: method."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3545
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3546
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3547
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3548
    char buffer[30];
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3549
    char *cp;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3550
    OBJ newString = nil;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3551
    INT myValue;
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3552
    int negative = 0;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3553
    int len;
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3554
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3555
    myValue = __intVal(self);
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3556
    if (myValue == 0) {
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3557
        RETURN (__MKSTRING_L("0", 1));
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3558
    }
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3559
#ifdef SLOW_CODE
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3560
    /*
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3561
     * 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
  3562
     * (printf is soooo slow)
369
claus
parents: 357
diff changeset
  3563
     */
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3564
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3565
    /*
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3566
     * actually only needed on sparc: since thisContext is
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3567
     * in a global register, which gets destroyed by printf,
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3568
     * manually save it here - very stupid ...
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3569
     */
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3570
    __BEGIN_PROTECT_REGISTERS__
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3571
    len = snprintf(buffer, sizeof(buffer), "%ld", (long)myValue);
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3572
    __END_PROTECT_REGISTERS__
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3573
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3574
    if (len >= 0 && len <= sizeof(buffer)) {
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3575
        newString = __MKSTRING_L(buffer, len);
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3576
    }
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3577
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3578
#else
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3579
    if (myValue < 0) {
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3580
        negative = 1;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3581
        myValue = -myValue;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3582
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3583
    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
  3584
    *cp-- = '\0';
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3585
    while (myValue != 0) {
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3586
        *cp = '0' + (myValue % 10);
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3587
        myValue = myValue / 10;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3588
        cp--;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3589
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3590
    if (negative) {
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3591
        *cp-- = '-';
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3592
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3593
    newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3594
#endif
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3595
    if (newString != nil) {
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3596
        RETURN (newString);
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3597
    }
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3598
%}.
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3599
    "/ only arrive here,
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3600
    "/  when having memory problems (i.e. no space for string) ...
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3601
    ^ super printString
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3602
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3603
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3604
     1234 printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3605
     0    printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3606
     -100 printString
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3607
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3608
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3609
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3610
printStringRadix:base
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3611
    "return my printstring (optimized for bases 16, 10 and 8)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3612
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3613
    |s|
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3614
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3615
%{
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3616
    char buffer[64+3];  /* for alpha, base 2 plus sign */
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3617
    char *cp;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3618
    OBJ newString;
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3619
    INT myValue;
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3620
    int negative = 0;
3706
6cd714580176 avoid name conflict.
Claus Gittinger <cg@exept.de>
parents: 3705
diff changeset
  3621
    INT __base;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3622
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3623
    if (__isSmallInteger(base)) {
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3624
        myValue = __intVal(self);
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3625
        if (myValue == 0) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3626
            RETURN (__MKSTRING_L("0", 1));
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3627
        }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3628
        __base = __intVal(base);
3706
6cd714580176 avoid name conflict.
Claus Gittinger <cg@exept.de>
parents: 3705
diff changeset
  3629
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3630
#ifdef SLOW_CODE
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3631
        switch (__base) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3632
            case 10:
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3633
                format = "%ld";
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3634
                break;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3635
            case 16:
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3636
                format = "%lx";
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3637
                break;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3638
            case 8:
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3639
                format = "%lo";
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3640
                break;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3641
        }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3642
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3643
        if (format) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3644
            /*
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3645
             * actually only needed on sparc: since thisContext is
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3646
             * in a global register, which gets destroyed by printf,
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3647
             * manually save it here - very stupid ...
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3648
             */
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3649
            __BEGIN_PROTECT_REGISTERS__
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3650
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3651
            len = snprintf(buffer, sizeof(buffer), format, (long)myValue);
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3652
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3653
            __END_PROTECT_REGISTERS__
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3654
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3655
            if (len > 0 && len <= sizeof(buffer)) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3656
                newString = __MKSTRING_L(buffer, len);
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3657
                if (newString != nil) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3658
                    RETURN (newString);
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3659
                }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3660
            }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3661
        }
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3662
#else
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3663
        if ((__base <= 36) && (__base > 1)) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3664
            if (myValue < 0) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3665
                negative = 1;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3666
                myValue = -myValue;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3667
            }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3668
            cp = buffer + sizeof(buffer) - 1;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3669
            *cp-- = '\0';
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3670
            while (myValue != 0) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3671
                int digit;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3672
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3673
                digit = myValue % __base;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3674
                if (digit <= 9) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3675
                    *cp = '0' + digit;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3676
                } else {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3677
                    *cp = 'A' + digit - 10;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3678
                }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3679
                myValue = myValue / __base;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3680
                cp--;
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3681
            }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3682
            if (negative) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3683
                *cp-- = '-';
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3684
            }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3685
            newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3686
            if (newString != nil) {
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3687
                RETURN (newString);
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3688
            }
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17754
diff changeset
  3689
        }
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3690
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3691
    }
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3692
%}.
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3693
    "/ arrive here, for bad base,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3694
    "/ or when having memory problems (i.e. no space for string) ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3695
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3696
    "/
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3697
    "/ fall back for seldom used bases
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3698
    "/ Notice: cannt use super>>printStringRadix: here,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3699
    "/ since that would lead to endless recursion ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3700
    "/ (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
  3701
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3702
    s := WriteStream on:(String new:10).
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3703
    super printOn:s base:base.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3704
    ^ s contents.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3705
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3706
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3707
      127 printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3708
      123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3709
      123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3710
      123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3711
      123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3712
      123 printStringRadix:2
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3713
      123 printStringRadix:1
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3714
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3715
      -127 printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3716
      -123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3717
      -123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3718
      -123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3719
      -123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3720
      -123 printStringRadix:2
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3721
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3722
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3723
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3724
printfPrintString:formatString
7746
4a4208ef7699 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7471
diff changeset
  3725
    "non-standard, but sometimes useful.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3726
     return a printed representation of the receiver
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3727
     as specified by formatString, which is defined by the C-
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3728
     function 'printf'.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3729
     No checking for string overrun - the resulting string
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3730
     must be shorter than 256 chars or else ...
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3731
     This method is NONSTANDARD and may be removed without notice;
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3732
     it is provided to allow special conversions in very special
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3733
     situaltions.
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3734
     Notice that a conversion may not be portable; for example,
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3735
     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
  3736
     while other systems may be happy with a %d ...
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3737
     Use at your own risk (if at all).
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3738
     WARNNG: this goes directly to the C-printf function and may therefore me inherently unsafe.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3739
     Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3740
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3741
%{  /* STACK: 400 */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3742
    char buffer[256];
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3743
    OBJ s;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3744
    int len;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3745
17735
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17732
diff changeset
  3746
    if (__isStringLike(formatString)) {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3747
        /*
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3748
         * actually only needed on sparc: since thisContext is
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3749
         * in a global register, which gets destroyed by printf,
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3750
         * manually save it here - very stupid ...
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3751
         */
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3752
        __BEGIN_PROTECT_REGISTERS__
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3753
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3754
        len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __intVal(self));
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3755
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3756
        __END_PROTECT_REGISTERS__
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3757
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3758
        if (len < 0) goto fail;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3759
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3760
        s = __MKSTRING_L(buffer, len);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3761
        if (s != nil) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3762
            RETURN (s);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3763
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3764
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3765
fail: ;
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3766
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3767
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3768
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3769
    "
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3770
        123 printfPrintString:'%%d -> %d'
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3771
        123 printfPrintString:'%%6d -> %6d'
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3772
        123 printfPrintString:'%%x -> %x'
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3773
        123 printfPrintString:'%%4x -> %4x'
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3774
        123 printfPrintString:'%%04x -> %04x'
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3775
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3776
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3777
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3778
!SmallInteger methodsFor:'private'!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3779
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3780
sign:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3781
    "private: for protocol completeness with LargeIntegers"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3782
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3783
    |absVal|
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3784
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3785
    absVal := self abs.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3786
    aNumber < 0 ifTrue:[
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3787
	^ absVal negated
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3788
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3789
    aNumber == 0 ifTrue:[^ 0].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3790
    ^ absVal
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3791
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3792
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3793
     -4 sign:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3794
     -4 sign:0
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3795
     -4 sign:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3796
     -4 sign:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3797
     -4 sign:0
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3798
     -4 sign:1
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3799
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3800
! !
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3801
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3802
!SmallInteger methodsFor:'testing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3803
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3804
between:min and:max
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3805
    "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
  3806
     and greater than or equal to the argument min.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3807
     - reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3808
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3809
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3810
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3811
    if (__bothSmallInteger(min, max)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3812
	REGISTER INT selfVal;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3813
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3814
	selfVal = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3815
	if (selfVal < __intVal(min)) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3816
	     RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3817
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3818
	if (selfVal > __intVal(max)) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3819
	     RETURN ( false );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3820
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3821
	RETURN ( true );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3822
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3823
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3824
    (self < min) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3825
    (self > max) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3826
    ^ true
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3827
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3828
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3829
even
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3830
    "return true, if the receiver is even"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3831
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3832
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3833
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3834
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3835
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3836
    ^ super even
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3837
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3838
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3839
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3840
    "return true, if the receiver is less than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3841
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3842
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3843
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3844
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3845
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3846
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3847
    RETURN ( ((INT)(self) < 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3848
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3849
    RETURN ( (__intVal(self) < 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3850
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3851
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3852
    ^ self < 0
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3853
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3854
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3855
odd
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3856
    "return true, if the receiver is odd"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3857
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3858
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3859
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3860
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3861
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3862
    ^ super odd
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3863
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3864
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3865
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3866
positive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3867
    "return true, if the receiver is not negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3868
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3869
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3870
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3871
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3872
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3873
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3874
    RETURN ( ((INT)(self) >= 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3875
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3876
    RETURN ( (__intVal(self) >= 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3877
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3878
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3879
    ^ super positive
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3880
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3881
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3882
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3883
sign
7471
c5d4bd612d9f comments
Claus Gittinger <cg@exept.de>
parents: 7438
diff changeset
  3884
    "return the sign of the receiver (-1, 0 or 1).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3885
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3886
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3887
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3888
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3889
    INT val = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3890
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3891
    if (val < 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3892
	RETURN ( __mkSmallInteger(-1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3893
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3894
    if (val > 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3895
	RETURN ( __mkSmallInteger(1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3896
    }
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3897
    RETURN ( __mkSmallInteger(0) );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3898
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3899
    ^ super sign
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3900
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3901
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3902
strictlyPositive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3903
    "return true, if the receiver is greater than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3904
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3905
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3906
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3907
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3908
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3909
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3910
    RETURN ( ((INT)(self) > 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3911
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3912
    RETURN ( (__intVal(self) > 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3913
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3914
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3915
    ^ super strictlyPositive
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3916
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3917
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3918
!SmallInteger class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3919
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3920
version
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3921
    ^ '$Id: SmallInteger.st 10564 2010-08-10 08:55:15Z vranyj1 $'
17735
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17732
diff changeset
  3922
!
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17732
diff changeset
  3923
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17732
diff changeset
  3924
version_CVS
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3925
    ^ 'Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.186 2010/08/02 10:33:35 cg Exp '
17761
b0e5971141bc Added Lookup and BuiltinLookup classes
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17759
diff changeset
  3926
!
b0e5971141bc Added Lookup and BuiltinLookup classes
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17759
diff changeset
  3927
b0e5971141bc Added Lookup and BuiltinLookup classes
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17759
diff changeset
  3928
version_SVN
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3929
    ^ '$Id: SmallInteger.st 10564 2010-08-10 08:55:15Z vranyj1 $'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3930
! !
17763
019bb9c842c5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17761
diff changeset
  3931
17767
a4a32df3aa5e merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17763
diff changeset
  3932
17772
6e0b3c06c364 Method reverted to r10532
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17767
diff changeset
  3933
17780
b6e42c92eba0 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17772
diff changeset
  3934
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3935