SmallInteger.st
author Claus Gittinger <cg@exept.de>
Tue, 18 Nov 2014 17:16:00 +0100
changeset 17070 713e0328c7d0
parent 17036 ef45fc0336fc
child 17247 e4e29302c10a
permissions -rw-r--r--
class: ProjectDefinition comment/format in: #stcOptimizationOptions #stcWarningOptions
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:''
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
    16
	classVariableNames:'ZeroString'
1036
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
14755
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    21
!SmallInteger primitiveDefinitions!
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    22
%{
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    23
#include <stdio.h>
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    24
%}
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    25
! !
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    26
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    27
!SmallInteger class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    28
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
 COPYRIGHT (c) 1988 by Claus Gittinger
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
    32
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    43
documentation
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    44
"
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    45
    SmallIntegers are Integers in the range of at least +/- 2^30
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
    46
    (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
    47
     if the system was configured for 64bit mode).
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    49
    These are no real objects - they have no instances (not even storage !!)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    50
    and cannot be subclassed.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    51
    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
    52
    SmallIntegers in the system. SmallInts are marked by having the TAG_INT
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    53
    bit set, in contrast to all other objects which do not.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    54
    Since this knowledge is hardwired into the system (and there is no
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    55
    class-field stored with SmallIntegers) there can be no subclass of
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    56
    SmallInteger (sorry).
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    57
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    58
    If you really need this kind of thing, create a subclass of Integer,
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    59
    with an instance variable holding the value.
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    60
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    61
    [author:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    62
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    63
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    64
    [see also:]
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    65
	Number
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    66
	Float Fraction FixedPoint
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
    67
	LargeInteger
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    68
"
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    69
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    71
!SmallInteger class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
basicNew:size
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    82
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    87
!SmallInteger class methodsFor:'bit mask constants'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    88
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    89
bitMaskFor:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    90
    "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
    91
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    92
    (index between:1 and:SmallInteger maxBits) ifFalse:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    93
	^ SubscriptOutOfBoundsSignal
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    94
		raiseRequestWith:index
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    95
		errorString:'index out of bounds'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    96
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    97
    ^ 1 bitShift:(index - 1)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    98
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    99
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   100
!SmallInteger class methodsFor:'class initialization'!
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   101
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   102
initialize
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   103
    ZeroString := '0'
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   104
! !
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   105
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   106
!SmallInteger class methodsFor:'constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
a27a279701f8 Initial revision
claus
parents:
diff changeset
   108
maxBits
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   109
    "return the number of bits in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   110
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   111
a27a279701f8 Initial revision
claus
parents:
diff changeset
   112
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   113
    RETURN ( __mkSmallInteger(N_INT_BITS) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
%}
2
claus
parents: 1
diff changeset
   115
claus
parents: 1
diff changeset
   116
    "SmallInteger maxBits"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
maxBytes
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   120
    "return the number of bytes in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   121
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   122
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   124
    RETURN ( __mkSmallInteger(N_INT_BITS / 8 + 1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
%}
2
claus
parents: 1
diff changeset
   126
3684
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   127
    "
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   128
     SmallInteger maxBytes
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   129
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   130
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
a27a279701f8 Initial revision
claus
parents:
diff changeset
   132
maxVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   133
    "return the largest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   134
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   135
a27a279701f8 Initial revision
claus
parents:
diff changeset
   136
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   137
    RETURN ( __mkSmallInteger(_MAX_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   138
%}
2
claus
parents: 1
diff changeset
   139
claus
parents: 1
diff changeset
   140
    "SmallInteger maxVal"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   141
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   142
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   143
minVal
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   144
    "return the smallest Integer representable as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   145
     For very special uses only - not constant across implementations"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   146
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   147
%{  /* NOCONTEXT */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   148
    RETURN ( __mkSmallInteger(_MIN_INT) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   149
%}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   150
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   151
    "SmallInteger minVal"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   153
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   154
!SmallInteger class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   155
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   156
canBeSubclassed
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   157
    "return true, if its allowed to create subclasses of the receiver.
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   158
     Return false here - since it is NOT possible for SmallInteger
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   159
     (due to the tagged representation of SmallIntegers)"
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   160
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   161
    ^ false
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   162
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   163
    "Modified: / 5.11.1998 / 16:11:27 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   164
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   165
2672
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   166
hasImmediateInstances
4661
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   167
    "return true if this class has immediate instances
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   168
     i.e. if the instances are represented in the pointer itself and
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   169
     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
   170
     Redefined from Behavior"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   171
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   172
    ^ true
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   173
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   174
    "Created: 3.6.1997 / 12:01:26 / cg"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   175
!
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   176
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   177
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   178
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   179
     Here, true is returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
    ^ true
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   182
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   183
    "Modified: 23.4.1996 / 16:00:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   184
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   185
a27a279701f8 Initial revision
claus
parents:
diff changeset
   186
!SmallInteger methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   187
a27a279701f8 Initial revision
claus
parents:
diff changeset
   188
* aNumber
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   189
    "return the product of the receiver and the argument"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
a27a279701f8 Initial revision
claus
parents:
diff changeset
   191
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   192
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   193
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   194
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   195
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   196
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   197
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   198
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   199
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   200
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   201
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   202
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   203
    INT myValue, otherValue;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   204
    unsigned INT productLow, productHi;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   205
    int negative;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   206
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   207
#   define low16Bits(foo)  ((foo) & 0xFFFF)
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   208
#   define hi16Bits(foo)   ((foo) >> 16)
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   209
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   210
#   define hi32Bits(foo)   ((foo) >> 32)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   211
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   212
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   213
     * can we use long long arithmetic ?
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   214
     *
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   215
     * long-long arithmetic seems to be buggy with some systems
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   216
     * (took me a while to find this out :-(
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   217
     * (try 10000 * 10000)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   218
     */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   219
#if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   220
# define USE_LONGLONG_FOR_MUL
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   221
#endif
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   222
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   223
#if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   224
# define USE_LONGLONG_FOR_MUL
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   225
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   226
252
   227
    if (__isSmallInteger(aNumber)) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   228
	myValue = __intVal(self);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   229
	otherValue = __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   230
4184
c7ee6f329db2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4183
diff changeset
   231
#if defined(USE_LONGLONG_FOR_MUL)
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   232
	{
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   233
# if defined(__alpha__) && !defined(__alpha64__)
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   234
#  define LONGLONG      INT64
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   235
# else
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   236
#  define LONGLONG      long long
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   237
# endif
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   238
	    LONGLONG product;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   239
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   240
	    product = (LONGLONG)myValue * (LONGLONG)otherValue;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   241
	    if ((product >= (LONGLONG)_MIN_INT)
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   242
	     && (product <= (LONGLONG)_MAX_INT)) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   243
		RETURN ( __mkSmallInteger((INT)product) );
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   244
	    }
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   245
	    if (product < 0) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   246
		negative = -1;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   247
		product = -product;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   248
	    } else {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   249
		negative = 1;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   250
	    }
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   251
	    productHi = product >> 32;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   252
	    productLow = product & 0xFFFFFFFFL;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   253
	}
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   254
#else /* no long-long */
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   255
	negative = 1;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   256
	if (myValue < 0) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   257
	    negative = -1;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   258
	    myValue = -myValue;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   259
	}
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   260
	if (otherValue < 0) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   261
	    negative = -negative;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   262
	    otherValue = -otherValue;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   263
	}
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   264
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   265
# if defined(__GNUC__) && defined(__mc68k__)
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   266
	asm ("mulu%.l %3,%1:%0"
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   267
		: "=d"  ((unsigned long)(productLow)),
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   268
		  "=d"  ((unsigned long)(productHi))
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   269
		: "%0"  ((unsigned long)(myValue)),
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   270
		  "dmi" ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   271
# else
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   272
#  if defined (__GNUC__) && defined(__i386__)
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   273
	asm ("mull %3"
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   274
		: "=a"  ((unsigned long)(productLow)),
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   275
		  "=d"  ((unsigned long)(productHi))
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   276
		: "%0"  ((unsigned long)(myValue)),
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   277
		  "rm"  ((unsigned long)(otherValue)));
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   278
#  else
10342
58ce3aabaa4b Visual-C support
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
   279
#   if defined(WIN32) && defined(__BORLANDC__)
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   280
	asm {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   281
	    mov   eax, myValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   282
	    mov   edx, otherValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   283
	    mul   edx
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   284
	    mov   productLow, eax
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   285
	    mov   productHi, edx
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   286
	}
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   287
#   else /* generic */
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   288
	{
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   289
	    unsigned INT pHH, pHL, pLH, pLL;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   290
	    unsigned INT low1, low2, hi1, hi2;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   291
	    unsigned INT t;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   292
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   293
	    /* unsigned multiply myValue * otherValue -> productHi, productLow
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   294
	     *
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   295
	     * this is too slow:
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   296
	     * since most machines can do 32*32 to 64 bit multiply,
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   297
	     * (or at least 32*32 with Overflow check)
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   298
	     * - need more assembler (inline) functions here
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   299
	     */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   300
#    if __POINTER_SIZE__ == 8
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   301
	    low1 = low32Bits((unsigned INT)myValue);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   302
	    hi1 = hi32Bits((unsigned INT)myValue);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   303
	    low2 = low32Bits((unsigned INT)otherValue);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   304
	    hi2 = hi32Bits((unsigned INT)otherValue);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   305
#     define LLMASK 0xC000000000000000L
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   306
#    else
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   307
	    low1 = low16Bits((unsigned INT)myValue);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   308
	    hi1 = hi16Bits((unsigned INT)myValue);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   309
	    low2 = low16Bits((unsigned INT)otherValue);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   310
	    hi2 = hi16Bits((unsigned INT)otherValue);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   311
#     define LLMASK 0xC0000000
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   312
#    endif
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   313
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   314
	    pLH = low1 * hi2;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   315
	    pHL = hi1 * low2;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   316
	    pLL = low1 * low2;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   317
	    pHH = hi1 * hi2;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   318
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   319
	    /*
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   320
	     * the common case ...
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   321
	     */
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   322
	    if ((pHL == 0)
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   323
	     && (pLH == 0)
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   324
	     && (pHH == 0)
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   325
	     && ((pLL & LLMASK) == 0)) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   326
		if (negative < 0) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   327
		    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   328
		}
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   329
		RETURN ( __mkSmallInteger((INT)pLL) );
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   330
	    }
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   331
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   332
	    /*
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   333
	     *   pHH |--------|--------|
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   334
	     *   pLH          |--------|--------|
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   335
	     *   pHL          |--------|--------|
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   336
	     *   pLL                   |--------|--------|
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   337
	     */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   338
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   339
#    if __POINTER_SIZE__ == 8
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   340
	    t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   341
	    productLow = (t << 32) + low32Bits(pLL);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   342
	    productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   343
#    else
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   344
	    t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   345
	    productLow = (t << 16) + low16Bits(pLL);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   346
	    productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   347
#    endif
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   348
	}
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   349
#   endif /* ! WIN32 */
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   350
#  endif /* ! (__GNUC__ && __i386__) */
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   351
# endif /* ! (__GNUC__ && __mc68k__) */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   352
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   353
	if (productHi == 0) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   354
	    if (negative < 0) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   355
		if (productLow <= -(_MIN_INT)) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   356
		    RETURN ( __mkSmallInteger(-((INT)productLow)) );
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   357
		}
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   358
	    } else {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   359
		if (productLow <= _MAX_INT) {
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   360
		    RETURN ( __mkSmallInteger(productLow) );
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   361
		}
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   362
	    }
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   363
	}
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   364
#endif /* ! USE_LONGLONG */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   365
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
   366
#if __POINTER_SIZE__ == 8
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   367
	RETURN (__MKLARGEINT128(negative, productLow, productHi));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   368
#else
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   369
	RETURN (__MKLARGEINT64(negative, productLow, productHi));
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   370
#endif
283
a897d331b4c1 *** empty log message ***
claus
parents: 282
diff changeset
   371
    } else if (__isFloatLike(aNumber)) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   372
	OBJ newFloat;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   373
	double val = (double)__intVal(self) * __floatVal(aNumber);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   374
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   375
	__qMKFLOAT(newFloat, val);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   376
	RETURN ( newFloat );
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   377
    } else if (__isShortFloat(aNumber)) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   378
	OBJ newFloat;
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   379
	float val = (float)__intVal(self) * __shortFloatVal(aNumber);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   380
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   381
	__qMKSFLOAT(newFloat, val);
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   382
	RETURN ( newFloat );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   383
    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
   384
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   385
    ^ aNumber productFromInteger:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   386
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   387
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   388
+ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   389
    "return the sum of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   390
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   391
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   392
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   393
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   394
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   395
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   396
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   397
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   398
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   399
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   400
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   401
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   402
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   403
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   404
#ifdef _ADD_IO_IO
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   405
	RETURN ( _ADD_IO_IO(self, aNumber) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   406
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   407
	REGISTER INT sum;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   408
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   409
	sum =  __intVal(self) + __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   410
	if (__ISVALIDINTEGER(sum)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   411
	    RETURN ( __mkSmallInteger(sum) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   412
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   413
	RETURN ( __MKLARGEINT(sum) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   414
#endif
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   415
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   416
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   417
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   418
	double val = (double)__intVal(self) + __floatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   419
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   420
	__qMKFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   421
	RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   422
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   423
    if (__isShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   424
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   425
	float val = (float)__intVal(self) + __shortFloatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   426
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   427
	__qMKSFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   428
	RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   429
    }
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   430
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   431
    ^ aNumber sumFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   432
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   433
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   434
- aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   435
    "return the difference of the receivers value and the arguments value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   436
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   437
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   438
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   439
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   440
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   441
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   442
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   443
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   444
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   445
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   446
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   447
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   448
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   449
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   450
#ifdef _SUB_IO_IO
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   451
	RETURN ( _SUB_IO_IO(self, aNumber) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   452
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   453
	REGISTER INT diff;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   454
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   455
	diff =  __intVal(self) - __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   456
	if (__ISVALIDINTEGER(diff)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   457
	    RETURN ( __mkSmallInteger(diff) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   458
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   459
	RETURN ( __MKLARGEINT(diff) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   460
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   461
    }
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   462
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   463
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   464
	double val = (double)__intVal(self) - __floatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   465
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   466
	__qMKFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   467
	RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   468
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   469
    if (__isShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   470
	OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   471
	float val = (float)__intVal(self) - __shortFloatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   472
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   473
	__qMKSFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   474
	RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   475
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   476
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   477
    ^ aNumber differenceFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   478
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   479
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   480
/ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   481
    "return the quotient of the receivers value and the arguments value"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   482
a27a279701f8 Initial revision
claus
parents:
diff changeset
   483
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   484
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   485
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   486
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   487
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   488
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   489
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   490
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   491
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   492
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   493
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   494
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   495
    INT me, t, val;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   496
    double dval;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   497
252
   498
    if (__isSmallInteger(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   499
	val = __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   500
	if (val != 0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   501
	    me = __intVal(self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   502
	    t = me / val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   503
#ifdef GOOD_OPTIMIZER
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   504
	    if (me % val == 0) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   505
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   506
	    /* this is stupid - all I want is to look for a remainder ...
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   507
	       but most compilers are too stupid and generate an extra modulus
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   508
	       instruction for "if (me % val)".
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   509
	       Even if most divide instructions already leave the remainder in
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   510
	       some register.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   511
	       Therefore I use a multiplication which is faster than a modulo
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   512
	       on most machines. Hint to GNU people :-)
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
	    if ((t * val) == me) {
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   515
#endif
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   516
		RETURN ( __mkSmallInteger(t) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   517
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   518
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   519
    } else {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   520
	if (__isFloatLike(aNumber)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   521
	    dval = __floatVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   522
	    if (dval != 0.0) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   523
		OBJ newFloat;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   524
		double val = (double)__intVal(self) / dval;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   525
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   526
		__qMKFLOAT(newFloat, val);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   527
		RETURN ( newFloat );
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   528
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   529
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   530
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   531
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   532
    aNumber isInteger ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   533
	aNumber == 0 ifTrue:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   534
	    ^ ZeroDivide raiseRequestWith:thisContext.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   535
	].
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   536
	^ Fraction numerator:self denominator:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   537
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   538
    ^ aNumber quotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   539
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   540
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   541
     8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   542
     9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   543
     9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   544
     9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   545
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   546
     -8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   547
     -9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   548
     -9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   549
     -9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   550
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   551
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   552
2
claus
parents: 1
diff changeset
   553
// aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   554
    "return the integer part of the quotient of the receivers value
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   555
     and the arguments value. 
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   556
     The result is truncated toward negative infinity
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   557
     and will be negative, if the operands signs differ.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   558
     The following is always true:
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   559
        (receiver // aNumber) * aNumber + (receiver \\ aNumber) = receiver
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   560
14795
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   561
     Be careful with negative results: 9 // 4 -> 2, while -9 // 4 -> -3.
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   562
     Especially surprising:     
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   563
        -1 // 10 -> -1 (because -(1/10) is truncated towards next smaller integer, which is -1.
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   564
        -10 // 3 -> -4 (because -(10/3) is truncated towards next smaller integer, which is -4.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   565
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   566
     See #quo: which returns -2 in the above case and #rem: which is the corresponding remainder."
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   567
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   568
%{  /* NOCONTEXT */
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   569
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   570
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   571
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   572
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   573
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   574
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   575
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   576
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   577
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   578
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   579
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   580
    INT dividend, divisor, rslt;
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   581
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   582
    if (__isSmallInteger(aNumber)) {
14795
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   583
        divisor = __intVal(aNumber);
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   584
        if (divisor != 0) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   585
            dividend = __intVal(self);
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   586
            rslt = dividend / divisor;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   587
            /*
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   588
             * Optimized to speed up positive result
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   589
             */
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   590
            if (rslt <= 0) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   591
                if (rslt == 0) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   592
                    if ((dividend ^ divisor) < 0) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   593
                        /*
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   594
                         * result (negative) has been truncated toward 0.
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   595
                         * Return -1, because we truncate toward negative inf.
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   596
                         */
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   597
                         rslt = -1;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   598
                    }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   599
                } else {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   600
                    /*
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   601
                     * If result (negative) has been truncated toward 0,
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   602
                     * subtract 1, because we truncate toward negative inf.
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   603
                     */
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   604
                    if (divisor > 0) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   605
                        if (rslt * divisor > dividend) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   606
                            rslt--;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   607
                        }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   608
                    } else {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   609
                        if (rslt * divisor < dividend) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   610
                            rslt--;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   611
                        }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   612
                    }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   613
                }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   614
            }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   615
            RETURN ( __mkSmallInteger(rslt) );
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   616
        }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   617
    } else {
14795
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   618
        if (__isFraction(aNumber)) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   619
            OBJ t;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   620
            INT num, den;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   621
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   622
            t = __FractionInstPtr(aNumber)->f_numerator;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   623
            if (__isSmallInteger(t)) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   624
                num = __intVal(t);
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   625
                t = __FractionInstPtr(aNumber)->f_denominator;
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   626
                if (__isSmallInteger(t)) {
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   627
                    den = __intVal(t);
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   628
                    RETURN ( __mkSmallInteger(__intVal(self) * den / num ));
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   629
                }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   630
            }
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   631
        }
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
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   634
    (aNumber = 0) ifTrue:[
14795
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   635
        ^ ZeroDivide raiseRequestWith:thisContext.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   636
    ].
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   637
    ^ aNumber integerQuotientFromInteger:self
927
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
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   640
     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
   641
     -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
   642
     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
   643
     -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
   644
     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
   645
     -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
   646
     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
   647
     -1 // -2   ~~ 0 ifTrue:[self halt].
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   648
     10000 // 3600000 ~~ 0 ifTrue:[self halt].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   649
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   650
     9 quo:4   => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   651
     -9 quo:4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   652
     9 quo:-4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   653
     -9 quo:-4 => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   654
    "
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   655
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   656
    "Modified: / 09-08-2010 / 19:50:23 / cg"
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   657
!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   658
2
claus
parents: 1
diff changeset
   659
\\ aNumber
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   660
    "Answer the integer remainder m defined by division with truncation toward
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   661
     negative infinity. 
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   662
     m < |aNumber| AND there is an integer k with (k * aNumber + m) = self
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   663
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   664
     The returned remainder has the same sign as aNumber.
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   665
     The following is always true:
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   666
        (receiver // aNumber) * aNumber + (receiver \\ aNumber) = receiver
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   667
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   668
     Be careful with negative results: 9 // 4 -> 2, while -9 // 4 -> -3.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   669
     Especially surprising:     
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   670
        -1 \\ 10 -> 9  (because -(1/10) is truncated towards next smaller integer, which is -1,
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   671
                        and -1 multiplied by 10 gives -10, so we have to add 9 to get the original -1).
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   672
        -10 \\ 3 -> 2 (because -(10/3) is truncated towards next smaller integer, which is -4,
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   673
                        and -4 * 4 gives -12, so we need to add 2 to get the original -10.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   674
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   675
     See #rem: which is the corresponding remainder for division via #quo:.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   676
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   677
     Redefined here for speed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   678
a27a279701f8 Initial revision
claus
parents:
diff changeset
   679
%{  /* NOCONTEXT */
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   680
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   681
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   682
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   683
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   684
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   685
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   686
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   687
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   688
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   689
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   690
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   691
    INT dividend, divisor, rem;
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   692
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   693
    if (__isSmallInteger(aNumber)
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   694
        && (divisor = __intVal(aNumber)) != 0) {
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   695
        /*
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   696
         * Note that the sign of something modulo a negative number is undefined
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   697
         * in C!
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   698
         */
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   699
        dividend = __intVal(self);
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   700
        rem = dividend % divisor;
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   701
        if (rem) {
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   702
            if ((rem ^ divisor) < 0) {
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   703
                /* sign of remainder is different from sign of divisor */
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   704
                rem = -rem;
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   705
            }
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   706
            if ((dividend ^ divisor) < 0) {
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   707
                /* different signs, so division would have returned a
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   708
                 * negative number.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   709
                 * C rounds toward zero, this code will simulate
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   710
                 * rounding towards negative infinity.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   711
                 */
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   712
                rem = divisor - rem;
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   713
            }
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   714
        }
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   715
        RETURN ( __mkSmallInteger(rem) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   716
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   717
%}.
2
claus
parents: 1
diff changeset
   718
    (aNumber = 0) ifTrue:[
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   719
        ^ ZeroDivide raiseRequestWith:thisContext.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   720
    ].
14003
727df70aa9f5 changed: #\\
Claus Gittinger <cg@exept.de>
parents: 13991
diff changeset
   721
    ^ aNumber moduloFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   722
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   723
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   724
     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
   725
     -9 \\ 4 == 3 ifFalse:[self halt].
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   726
     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
   727
     -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
   728
     (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
   729
     (-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
   730
     1000 \\ 3600000 == 1000 ifFalse:[self halt]
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   731
    "
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   732
14003
727df70aa9f5 changed: #\\
Claus Gittinger <cg@exept.de>
parents: 13991
diff changeset
   733
    "Modified: / 12-02-2012 / 20:43:40 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   734
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   735
a27a279701f8 Initial revision
claus
parents:
diff changeset
   736
abs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   737
    "return the absolute value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   738
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   739
a27a279701f8 Initial revision
claus
parents:
diff changeset
   740
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   741
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   742
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   743
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   744
    if (val >= 0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   745
	RETURN (self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   746
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   747
    if (val != _MIN_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   748
	RETURN ( __mkSmallInteger(-val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   749
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   750
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   751
    RETURN( __MKLARGEINT(-_MIN_INT));
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   752
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   753
    ^ super abs
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   754
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   755
a27a279701f8 Initial revision
claus
parents:
diff changeset
   756
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   757
    "return the negative value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   758
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   759
a27a279701f8 Initial revision
claus
parents:
diff changeset
   760
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   761
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   762
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   763
a27a279701f8 Initial revision
claus
parents:
diff changeset
   764
    if (val != _MIN_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   765
	RETURN ( __mkSmallInteger(- val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   766
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   767
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   768
    RETURN (__MKLARGEINT( -_MIN_INT));
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   769
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   770
    ^ 0 - self
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   771
"/    "only reached for minVal"
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   772
"/    ^ (LargeInteger value:(SmallInteger maxVal)) + 1
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   773
!
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   774
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   775
quo:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   776
    "return the integer part of the quotient of the receivers value
1884
abd423adeb94 commentary
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
   777
     and the arguments value. The result is truncated towards zero
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   778
     and negative, if the operands signs differ..
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   779
     The following is always true:
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   780
	(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
   781
     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
   782
     for negative results, the remainder is ignored.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   783
     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
   784
     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
   785
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   786
%{  /* NOCONTEXT */
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   787
    INT val;
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   788
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   789
    if (__isSmallInteger(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   790
	val = __intVal(aNumber);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   791
	if (val != 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   792
	    RETURN ( __mkSmallInteger(__intVal(self) / val) );
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   793
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   794
    } else {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   795
	if (__isFraction(aNumber)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   796
	    OBJ t;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   797
	    INT num, den;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   798
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   799
	    t = __FractionInstPtr(aNumber)->f_numerator;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   800
	    if (__isSmallInteger(t)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   801
		num = __intVal(t);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   802
		t = __FractionInstPtr(aNumber)->f_denominator;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   803
		if (__isSmallInteger(t)) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   804
		    den = __intVal(t);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   805
		    RETURN ( __mkSmallInteger(__intVal(self) * den / num ));
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   806
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   807
	    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   808
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   809
    }
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   810
%}.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   811
    (aNumber = 0) ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   812
	^ ZeroDivide raiseRequestWith:thisContext.
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   813
    ].
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   814
    ^ self retry:#quo: coercing:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   815
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   816
    "
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   817
     9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   818
     -9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   819
     9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   820
     -9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   821
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   822
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   823
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   824
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   825
!SmallInteger methodsFor:'bit operators'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   826
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   827
bitAnd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   828
    "return the bitwise-and of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   829
a27a279701f8 Initial revision
claus
parents:
diff changeset
   830
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   831
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   832
    /* anding the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   833
    if (__isSmallInteger(anInteger)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   834
	RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   835
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   836
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   837
    anInteger class == LargeInteger ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   838
	^ anInteger bitAnd:self
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   839
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   840
    ^ self retry:#bitAnd: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   841
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   842
    "(2r001010100 bitAnd:2r00001111) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   843
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   844
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   845
bitAt:anIntegerIndex
11500
6afe4d6e867c changed #bitAt:
Claus Gittinger <cg@exept.de>
parents: 11493
diff changeset
   846
    "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
   847
     Notice: the result of bitAt: on negative receivers is not
15557
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   848
             defined in the language standard (since the implementation
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   849
             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
   850
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   851
%{  /* NOCONTEXT */
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   852
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   853
    if (__isSmallInteger(anIntegerIndex)) {
15557
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   854
        INT idx = __smallIntegerVal(anIntegerIndex);
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   855
        if (idx > 0) {
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   856
            if (idx > N_INT_BITS) {
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   857
                RETURN(__mkSmallInteger(0));
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   858
            }
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   859
            RETURN((__smallIntegerVal(self) & (1 << (idx-1))) ? __mkSmallInteger(1) : __mkSmallInteger(0));
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   860
        }
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   861
    }
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   862
%}.
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   863
15557
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   864
    ^ SubscriptOutOfBoundsError
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   865
            raiseRequestWith:anIntegerIndex
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   866
            errorString:'index out of bounds'
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   867
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   868
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   869
     16r00000001 bitAt:0
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   870
     16r00000001 bitAt:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   871
     16r00000001 bitAt:2
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   872
     16r00008000 bitAt:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   873
     16r00800000 bitAt:24
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   874
     16r08000000 bitAt:28
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   875
     16r10000000 bitAt:29
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   876
     16r20000000 bitAt:30
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   877
     16r40000000 bitAt:31
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   878
     16r80000000 bitAt:32
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   879
     16r100000000 bitAt:33
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
   880
    "
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   881
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   882
" Smalltalk implementation:
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   883
    |mask|
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   884
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   885
    anIntegerIndex <= 0 ifTrue:[
15557
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   886
        ^ SubscriptOutOfBoundsSignal
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   887
                raiseRequestWith:anIntegerIndex
60453bc22ff6 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15432
diff changeset
   888
                errorString:'index out of bounds'
8334
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   889
    ].
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   890
    (anIntegerIndex > SmallInteger maxBits) ifTrue:[^ 0].
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   891
    mask := 1 bitShift:(anIntegerIndex - 1).
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   892
    ((self bitAnd:mask) == 0) ifTrue:[^ 0].
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   893
    ^ 1
4466f66d1f9a Define #bitAt:
Stefan Vogel <sv@exept.de>
parents: 7746
diff changeset
   894
"
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   895
!
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
   896
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   897
bitClear:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   898
    "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
   899
     returning the receiver with bits of the argument cleared."
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   900
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   901
%{  /* NOCONTEXT */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   902
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   903
    /* anding the tags doesn't change it */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   904
    if (__isSmallInteger(anInteger)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   905
	RETURN ( ((OBJ) (((INT)self & ~(INT)anInteger) | TAG_INT)) );
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   906
    }
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   907
%}.
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   908
    ^ self retry:#bitClear: coercing:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   909
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   910
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   911
     (2r001010100 bitClear:2r00001111) radixPrintStringRadix:2
5458
2aa89d4fad64 example
Claus Gittinger <cg@exept.de>
parents: 5447
diff changeset
   912
     (2r111111111 bitClear:2r00001000) radixPrintStringRadix:2
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   913
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   914
!
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   915
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   916
bitCount
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   917
    "return the number of 1-bits in the receiver"
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   918
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   919
%{  /* NOCONTEXT */
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   920
    unsigned int _cnt;
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   921
    unsigned INT _self = __intVal(self);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   922
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   923
# define ALGORIHTM_3
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   924
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   925
# ifdef ALGORITHM_1
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   926
    // old k&r code; might be better if only one or two bits are set
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   927
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   928
    _cnt = 0;
11666
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
   929
    while (_self) {
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   930
        _cnt++;
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   931
        _self = _self & (_self - 1);
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   932
    }
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   933
# else
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   934
#  ifdef ALGORITHM_2
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   935
    // seems to be faster on the average (and has better worst case)
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   936
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   937
    static unsigned char table[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4 };
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   938
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   939
    _cnt = 0;
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   940
    while (_self) {
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   941
        _cnt += table[ _self & 0x0F ];
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   942
        _self >>= 4;
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   943
    }
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   944
#  else
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   945
#   ifdef ALGORIHTM_3
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   946
    // the fastest, but hard (impossible) to understand (google for fastest bit count)
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   947
#    if __POINTER_SIZE__ == 8
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   948
    unsigned int _v1, _v2;
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   949
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   950
    _v1 = _self & 0xFFFFFFFF;
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   951
    _v1 = _v1 - ((_v1 >> 1) & 0x55555555);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   952
    _v1 = (_v1 & 0x33333333) + ((_v1 >> 2) & 0x33333333);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   953
    _v1 = ((_v1 + (_v1 >> 4)) & 0x0F0F0F0F);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   954
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   955
    _v2 = (unsigned int)(_self >> 32);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   956
    _v2 = _v2 - ((_v2 >> 1) & 0x55555555);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   957
    _v2 = (_v2 & 0x33333333) + ((_v2 >> 2) & 0x33333333);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   958
    _v2 = ((_v2 + (_v2 >> 4)) & 0x0F0F0F0F);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   959
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   960
    _cnt = ((_v1 * 0x01010101) >> 24) + ((_v2 * 0x01010101) >> 24);
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   961
#    else
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   962
    _cnt = _self - ((_self >> 1) & 0x55555555);
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   963
    _cnt = (_cnt & 0x33333333) + ((_cnt >> 2) & 0x33333333);
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   964
    _cnt = ((_cnt + (_cnt >> 4)) & 0x0F0F0F0F);
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
   965
    _cnt = (_cnt * 0x01010101) >> 24;
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   966
#    endif
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   967
#   else
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   968
     error error error
15309
6154eb7935b5 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15275
diff changeset
   969
#   endif
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   970
#  endif
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   971
# endif
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   972
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   973
    RETURN ( __MKSMALLINT(_cnt));
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   974
%}
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   975
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   976
    "
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   977
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   978
     1 to:1000000 do:[:n |
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   979
        self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
13909
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
   980
     ].
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
   981
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
   982
     #(
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   983
        16r00010000 16r00100000 16r01000000 16r10000000
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   984
        16r00020000 16r00200000 16r02000000 16r20000000
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   985
        16r00040000 16r00400000 16r04000000 16r40000000
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   986
        16r00080000 16r00800000 16r08000000 16r80000000
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   987
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   988
        16rFFFFFFFF 16r7FFFFFFF 16r3FFFFFFF 16r1FFFFFFF
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   989
        16rEEEEEEEE 16r7EEEEEEE 16r3EEEEEEE 16r1EEEEEEE
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   990
        16rDDDDDDDD 16r7DDDDDDD 16r3DDDDDDD 16r1DDDDDDD
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   991
        16rCCCCCCCC 16r7CCCCCCC 16r3CCCCCCC 16r1CCCCCCC
13909
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
   992
     ) do:[:n |
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   993
        self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   994
     ]
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   995
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   996
     1 to:10000000 do:[:n |
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
   997
        (n bitCount)
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   998
     ]
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
   999
    "
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1000
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1001
    "Modified: / 09-01-2012 / 19:12:41 / cg"
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1002
!
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1003
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1004
bitInvert
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1005
    "return the value of the receiver with all bits inverted"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1006
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1007
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1008
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1009
    /* invert anything except tag bits */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1010
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1011
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1012
    ^ self primitiveFailed
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1013
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1014
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1015
bitOr:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1016
    "return the bitwise-or of the receiver and the argument, anInteger"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1017
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1018
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1019
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1020
    /* oring the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1021
    if (__isSmallInteger(anInteger)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1022
	RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1023
    }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1024
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1025
    ^ self retry:#bitOr: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1026
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1027
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1028
     (2r000000100 bitOr:2r00000011) radixPrintStringRadix:2
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1029
     (0 bitOr:16r20000000) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1030
     (0 bitOr:16r40000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1031
     (0 bitOr:16r80000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1032
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1033
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1034
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1035
bitShift:shiftCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1036
    "return the value of the receiver shifted by shiftCount bits;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1037
     leftShift if shiftCount > 0; rightShift otherwise.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1038
     Notice: the result of bitShift: on negative receivers is not
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1039
             defined in the language standard (since the implementation
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1040
             is free to choose any internal representation for integers).
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1041
             However, ST/X preserves the sign."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1042
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1043
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1044
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1045
    INT bits, count;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1046
252
  1047
    if (__isSmallInteger(shiftCount)) {
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1048
        bits = __intVal(self);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1049
        if (bits == 0) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1050
            RETURN (self);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1051
        }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1052
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1053
        count = __intVal(shiftCount);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1054
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1055
        if (count > 0) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1056
            /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1057
             * a left shift
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1058
             */
4183
4a745f6f47b6 oops - longlong shift fails with i386,GCC
Claus Gittinger <cg@exept.de>
parents: 4177
diff changeset
  1059
#if defined(USE_LONGLONG_FOR_SHIFT)
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1060
            if (count <= N_INT_BITS) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1061
                unsigned LONGLONG result;
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1062
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1063
                result = (unsigned LONGLONG)bits;
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1064
                result <<= count;
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1065
                if (result <= _MAX_INT) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1066
                    RETURN ( __mkSmallInteger(result) );
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1067
                }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1068
                {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1069
                    RETURN (__MKLARGEINT64(1, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1070
                }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1071
            }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1072
#else
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1073
            /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1074
             * check for overflow
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1075
             */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1076
            if (count < (N_INT_BITS-1)) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1077
                if (! (bits >> (N_INT_BITS - 1 - count))) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1078
                    RETURN ( __mkSmallInteger(bits << count) );
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1079
                }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1080
                /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1081
                 * so, there is an overflow ...
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1082
                 * handle it as largeInteger
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1083
                 */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1084
                /* FALL THROUGH */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1085
            }
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
  1086
#endif
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1087
        } else {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1088
            if (count == 0) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1089
                RETURN (self);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1090
            }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1091
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1092
            /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1093
             * right shifts cannot overflow
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1094
             *
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1095
             * some machines ignore shifts bigger than
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1096
             * the number of bits in an int ...
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1097
             */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1098
            count = -count;
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1099
            if (count > (N_INT_BITS-1)) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1100
                RETURN (__mkSmallInteger(0));
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1101
            }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1102
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1103
            RETURN ( __mkSmallInteger(bits >> count) );
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1104
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1105
    }
85
claus
parents: 77
diff changeset
  1106
%}.
claus
parents: 77
diff changeset
  1107
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1108
        ^ (LargeInteger value:self) bitShift:shiftCount
85
claus
parents: 77
diff changeset
  1109
    ].
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1110
    ^ self bitShift:shiftCount asInteger   "/ is this a good idea ?
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1111
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1112
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1113
bitTest:aMask
5782
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1114
    "return true, if any bit from aMask is set in the receiver.
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1115
     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
  1116
     is non-0, false otherwise."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1117
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1118
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1119
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1120
    /* and all bits except tag */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1121
    if (__isSmallInteger(aMask)) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1122
	RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1123
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1124
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1125
    aMask class == LargeInteger ifTrue:[
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1126
	^ (aMask bitAnd:self) ~~ 0
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1127
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1128
    ^ self retry:#bitTest: coercing:aMask
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1129
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1130
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1131
     2r10001 bitTest:2r00001
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1132
     2r10001 bitTest:2r00010
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1133
     2r10001 bitTest:2r00100
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1134
     2r10001 bitTest:2r01000
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1135
     2r10001 bitTest:2r10000
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1136
     2r10001 bitTest:2r10001
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1137
     2r10001 bitTest:2r10010
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1138
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1139
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1140
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1141
bitXor:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1142
    "return the bitwise-exclusive-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1143
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1144
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1145
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1146
    /* xoring the tags turns it off - or it in again */
252
  1147
    if (__isSmallInteger(anInteger)) {
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  1148
	RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1149
    }
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1150
%}.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1151
    ^ self retry:#bitXor: coercing:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1152
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1153
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1154
clearBit:anInteger
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8919
diff changeset
  1155
    "return a new integer where the specified bit is off.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1156
     Bits are counted from 1 starting with the least significant.
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1157
     The methods name may be misleading: the receiver is not changed,
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1158
     but a new number is returned. Should be named #withBitCleared:"
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1159
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1160
%{  /* NOCONTEXT */
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1161
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1162
    if (__isSmallInteger(anInteger)) {
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1163
        int index = __intVal(anInteger);
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1164
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1165
        if (index > 0) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1166
#if __POINTER_SIZE__ == 8
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1167
            if (index <= 62)
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1168
#else
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1169
            if (index <= 30)
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1170
#endif
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1171
            {
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1172
                INT mask = __MASKSMALLINT(1 << (index-1));
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1173
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1174
                RETURN ( ((OBJ) ((INT)self & ~(INT)mask)) );
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1175
            }
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1176
            RETURN (self);  /* nothing to do ... */
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1177
        }
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1178
    }
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1179
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1180
    ^ super clearBit:anInteger
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1181
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1182
    "
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1183
     (16r401 clearBit:1     ) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1184
     (16r401 clearBit:0     ) hexPrintString
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1185
     (16r3fffffff clearBit:1) hexPrintString
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1186
     (16r3fffffff clearBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1187
     (16r3fffffff clearBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1188
     (16r3fffffff clearBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1189
     (16r3fffffff bitAt:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1190
     (16r3fffffff bitAt:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1191
     (16r3fffffff bitAt:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1192
     (16r40000001 clearBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1193
     (16rF0000001 clearBit:29) hexPrintString
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1194
     (16rF0000001 clearBit:30) hexPrintString
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1195
     (16rF0000001 clearBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1196
     (16rF0000001 clearBit:32) hexPrintString
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1197
    "
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1198
!
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3532
diff changeset
  1199
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1200
highBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1201
    "return the bitIndex of the highest bit set. The returned bitIndex
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1202
     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
  1203
     Returns 0 if no bit is set."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1204
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1205
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1206
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1207
    unsigned INT bits;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1208
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1209
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1210
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1211
    if (bits == 0) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1212
	RETURN ( __mkSmallInteger(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1213
    }
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  1214
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1215
#ifdef __BSR
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1216
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1217
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1218
     * 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
  1219
     * (but saves a few code-bytes, though)
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1220
     */
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1221
    index = __BSR(bits);
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1222
#else
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1223
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1224
    index = 0;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1225
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1226
# if __POINTER_SIZE__ == 8
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1227
    if (bits & 0xFFFFFFFF00000000L) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1228
	index += 32; bits = bits >> 32;
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1229
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1230
# endif
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1231
    if (bits & 0xFFFF0000L) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1232
	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
  1233
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1234
    if (bits & 0xFF00) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1235
	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
  1236
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1237
    if (bits & 0xF0) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1238
	index += 4; bits = bits >> 4;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1239
    }
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1240
    if (bits & 0xC) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1241
	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
  1242
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1243
    if (bits & 0x2) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1244
	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
  1245
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1246
#endif /* no BSR instruction */
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1247
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1248
    RETURN ( __mkSmallInteger(index+1) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1249
%}
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1250
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1251
     2r0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1252
     2r1 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1253
     2r10 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1254
     2r100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1255
     2r1000 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1256
     2r100000000000 highBit
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1257
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1258
     ((0 to:64) collect:[:s | 1 bitShift:s])
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1259
	collect:[:n | n highBit]
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1260
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1261
     (((0 to:64) collect:[:s | 1 bitShift:s])
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1262
	collect:[:n | n highBit]) = (1 to:65)
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1263
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1264
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
     Time millisecondsToRun:[
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1267
	1000000 timesRepeat:[
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1268
	    2r1 highBit
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1269
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1270
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1271
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1272
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1273
     Time millisecondsToRun:[
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1274
	1000000 timesRepeat:[
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1275
	    2r1111 highBit
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1276
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1277
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1278
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1279
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1280
     Time millisecondsToRun:[
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1281
	1000000 timesRepeat:[
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1282
	    2r11111111111111 highBit
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1283
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1284
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1285
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1286
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1287
     Time millisecondsToRun:[
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1288
	1000000 timesRepeat:[
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1289
	    2r11111111111111111111111111 highBit
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1290
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1291
     ]
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1292
    "
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1293
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1294
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1295
     2r000100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1296
     2r010100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1297
     2r000001 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1298
     0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1299
     SmallInteger maxVal highBit
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1300
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1301
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1302
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1303
invertBit:anInteger
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1304
    "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
  1305
     Bits are counted from 1 starting with the least significant.
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1306
     The methods name may be misleading: the receiver is not changed,
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1307
     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
  1308
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1309
%{  /* NOCONTEXT */
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1310
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1311
    if (__isSmallInteger(anInteger)) {
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1312
        int index = __intVal(anInteger);
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1313
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1314
        if (index > 0) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1315
#if __POINTER_SIZE__ == 8
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1316
            if (index <= 62)
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1317
#else
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1318
            if (index <= 30)
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1319
#endif
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1320
            {
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1321
                INT mask = __MASKSMALLINT(1 << (index-1));
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1322
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1323
                RETURN ( ((OBJ) ((INT)self ^ (INT)mask)) );
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1324
            }
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1325
        }
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1326
    }
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1327
%}.
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1328
    ^ super invertBit:anInteger
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1329
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1330
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1331
     (16r401 invertBit:2     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1332
     (16r401 invertBit:1     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1333
     (16r30000000 invertBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1334
     (16r40000000 invertBit:0) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1335
     (16r0 invertBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1336
     (16r0 invertBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1337
     (16r0 invertBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1338
     (16r0 invertBit:32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1339
     (16r0 invertBit:33) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1340
     (16r0 invertBit:100) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1341
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1342
!
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1343
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1344
lowBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1345
    "return the bitIndex of the lowest bit set. The returned bitIndex
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1346
     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
  1347
     Returns 0 if no bit is set."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1348
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1349
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1350
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1351
    unsigned INT bits;
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1352
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1353
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1354
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1355
    if (bits == 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1356
	RETURN ( __mkSmallInteger(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1357
    }
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1358
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1359
#ifdef __BSF
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1360
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1361
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1362
     * 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
  1363
     * (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
  1364
     * but saves a few code-bytes, though.
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1365
     */
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1366
    index = __BSF(bits);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1367
    RETURN ( __mkSmallInteger(index + 1) );
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1368
#else
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1369
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1370
    index = 1;
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1371
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1372
# if __POINTER_SIZE__ == 8
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1373
    if ((bits<<32) == 0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1374
	index += 32; bits >>= 32;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1375
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1376
# endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1377
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1378
    if ((bits & 0xFFFF)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1379
	index += 16; bits >>= 16;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1380
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1381
    if ((bits & 0xFF)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1382
	index += 8; bits >>= 8;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1383
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1384
    if ((bits & 0xF)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1385
	index += 4; bits >>= 4;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1386
    }
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1387
    if ((bits & 0x3)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1388
	index += 2; bits >>= 2;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1389
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1390
    if ((bits & 0x1)==0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1391
	index += 1;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1392
    }
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1393
#endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1394
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1395
    RETURN ( __mkSmallInteger(index) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1396
%}
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1397
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1398
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1399
     0 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1400
     2r0001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1401
     2r0010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1402
     2r0100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1403
     2r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1404
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1405
     2r000100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1406
     2r010010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1407
     2r100001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1408
     16r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1409
     16r1000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1410
     16r1000000000000000 lowBit
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1411
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1412
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1413
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1414
	    2r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1415
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1416
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1417
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1418
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1419
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1420
	    2r11110000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1421
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1422
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1423
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1424
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1425
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1426
	    2r1000000000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1427
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1428
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1429
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1430
     Time millisecondsToRun:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1431
	1000000 timesRepeat:[
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1432
	    2r1000000000000000000000000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1433
	]
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1434
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1435
    "
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1436
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1437
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1438
rightShift:shiftCount
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1439
    "return the value of the receiver shifted by shiftCount bits;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1440
     right shift if shiftCount > 0; left shift  otherwise.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1441
     Notice: the result of bitShift: on negative receivers is not
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1442
             defined in the language standard (since the implementation
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1443
             is free to choose any internal representation for integers).
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1444
             However, ST/X preserves the sign."
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1445
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1446
%{  /* NOCONTEXT */
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1447
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1448
    INT bits, count;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1449
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1450
    if (__isSmallInteger(shiftCount)) {
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1451
        bits = __intVal(self);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1452
        if (bits == 0) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1453
            RETURN (self);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1454
        }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1455
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1456
        count = __intVal(shiftCount);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1457
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1458
        if (count < 0) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1459
            /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1460
             * a left shift
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1461
             */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1462
            count = -count;
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1463
#if defined(USE_LONGLONG_FOR_SHIFT)
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1464
            if (count <= N_INT_BITS) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1465
                unsigned LONGLONG result;
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1466
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1467
                result = (unsigned LONGLONG)bits;
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1468
                result <<= count;
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1469
                if (result <= _MAX_INT) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1470
                    RETURN ( __mkSmallInteger(result) );
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1471
                }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1472
                {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1473
                    RETURN (__MKLARGEINT64(1, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1474
                }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1475
            }
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1476
#else
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1477
            /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1478
             * check for overflow
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1479
             */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1480
            if (count < (N_INT_BITS-1)) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1481
                if (! (bits >> (N_INT_BITS - 1 - count))) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1482
                    RETURN ( __mkSmallInteger(bits << count) );
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1483
                }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1484
                /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1485
                 * so, there is an overflow ...
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1486
                 * handle it as largeInteger
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1487
                 */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1488
                /* FALL THROUGH */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1489
            }
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1490
#endif
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1491
        } else {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1492
            if (count == 0) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1493
                RETURN (self);
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1494
            }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1495
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1496
            /*
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1497
             * right shifts cannot overflow
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1498
             *
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1499
             * some machines ignore shifts bigger than
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1500
             * the number of bits in an int ...
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1501
             */
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1502
            if (count > (N_INT_BITS-1)) {
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1503
                RETURN (__mkSmallInteger(0));
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1504
            }
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1505
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1506
            RETURN ( __mkSmallInteger(bits >> count) );
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1507
        }
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1508
    }
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1509
%}.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1510
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1511
        ^ (LargeInteger value:self) rightShift:shiftCount
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1512
    ].
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1513
    ^ self rightShift:shiftCount asInteger   "/ is this a good idea ?
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1514
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1515
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1516
    "
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1517
        16 rightShift:2
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1518
         4 rightShift:-2
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1519
    "
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1520
!
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1521
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1522
setBit:anInteger
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8919
diff changeset
  1523
    "return a new integer where the specified bit is on.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1524
     Bits are counted from 1 starting with the least significant.
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1525
     The methods name may be misleading: the receiver is not changed,
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1526
     but a new number is returned. Should be named #withBitSet:"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1527
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1528
%{  /* NOCONTEXT */
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1529
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1530
    if (__isSmallInteger(anInteger)) {
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1531
        int index = __intVal(anInteger);
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1532
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1533
        if (index > 0) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1534
#if __POINTER_SIZE__ == 8
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1535
            if (index <= 62)
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1536
#else
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1537
            if (index <= 30)
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1538
#endif
15131
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1539
            {
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1540
                INT mask = __MASKSMALLINT(1 << (index-1));
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1541
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1542
                RETURN ( ((OBJ) ((INT)self | (INT)mask)) );
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1543
            }
7dbfd0376b30 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 15083
diff changeset
  1544
        }
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1545
    }
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1546
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1547
    ^ super setBit:anInteger
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1548
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1549
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1550
     (16r401 setBit:2     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1551
     (16r30000000 setBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1552
     (16r40000000 setBit:0) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1553
     (16r0 setBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1554
     (16r0 setBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1555
     (16r0 setBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1556
     (16r0 setBit:32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1557
     (16r0 setBit:33) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1558
     (16r0 setBit:100) hexPrintString
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1559
    "
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1560
! !
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  1561
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1562
!SmallInteger methodsFor:'byte access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1563
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1564
byteSwapped 
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1565
    "lsb -> msb;
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1566
     i.e. a.b.c.d -> d.c.b.a"
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1567
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1568
    SmallInteger maxBytes == 8 ifTrue:[
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1569
        ^ self byteSwapped64
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1570
    ] ifFalse:[
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1571
        ^ self byteSwapped32
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1572
    ].
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1573
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1574
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1575
     16r11223344 byteSwapped hexPrintString  
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1576
     16r44332211 byteSwapped hexPrintString   
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1577
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1578
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1579
    "Created: / 09-01-2012 / 23:01:33 / cg"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1580
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1581
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1582
byteSwapped16
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1583
    "for 16bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1584
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1585
     i.e. a.b -> b.a"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1586
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1587
%{  /* NOCONTEXT */
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1588
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1589
    unsigned INT swapped;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1590
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1591
    swapped = ((v>>8)&0xFF) | ((v & 0xFF)<<8);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1592
    RETURN (__mkSmallInteger(swapped));
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1593
%}.
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1594
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1595
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1596
     16r1122 byteSwapped16 hexPrintString   
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1597
     16r2211 byteSwapped16 hexPrintString   
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1598
     16r332211 byteSwapped16 hexPrintString   
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1599
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1600
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1601
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1602
byteSwapped32
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1603
    "for 32bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1604
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1605
     i.e. a.b.c.d -> d.c.b.a"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1606
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1607
%{  /* NOCONTEXT */
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1608
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1609
    unsigned INT swapped;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1610
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1611
#undef HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1612
#if __POINTER_SIZE__ == 4
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1613
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1614
# if defined(USE_BSWAP) && defined(__BORLANDC__)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1615
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1616
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1617
    _asm {
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1618
        mov eax, v
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1619
        bswap eax
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1620
        mov swapped, eax
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1621
    };
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1622
# endif
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1623
# if defined(USE_BSWAP) && defined(__VISUALC__)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1624
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1625
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1626
    _asm {
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1627
        mov eax, v
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1628
        xchg al, ah
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1629
        rol eax, 16
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1630
        xchg al, ah
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1631
        mov swapped, eax
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1632
    };
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1633
# endif
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1634
# if defined(USE_BSWAP) && defined(__GNUC__)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1635
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1636
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  1637
    asm("movl %1, %%eax \n\
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1638
         bswap %%eax    \n\
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  1639
         movl %%eax, %0 \n\
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1640
        "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1641
        : "=rm"  (swapped)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1642
        : "rm"   (v));
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1643
# endif
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1644
#endif /* __POINTER_SIZE__ == 4 */
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1645
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1646
#if __POINTER_SIZE__ == 8
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1647
    v &= 0xFFFFFFFF;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1648
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1649
# if defined(__x86_64__) && defined(__GNUC__)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1650
#   define HAVE_BSWAP
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  1651
    asm("movq %1, %%rax \n\
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1652
         bswap %%eax    \n\
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  1653
         movq %%rax, %0 \n\
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1654
        "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1655
        : "=rm"  (swapped)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1656
        : "rm"   (v));
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1657
# endif
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1658
#endif
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1659
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1660
#ifndef HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1661
    swapped = ((v>>24) | ((v>>8)&0xFF00) | ((v & 0xFF00)<<8) | ((v & 0xFF)<<24));
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1662
#endif
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1663
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1664
    RETURN (__MKUINT(swapped));
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1665
%}.
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1666
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1667
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1668
     16r11223344 byteSwapped32 hexPrintString  
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1669
     16r44332211 byteSwapped32 hexPrintString   
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1670
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1671
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1672
    "Created: / 09-01-2012 / 23:01:33 / cg"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1673
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1674
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1675
byteSwapped64
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1676
    "for 64bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1677
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1678
     i.e. a.b.c.d.e.f.g.h -> h.g.f.e.d.c.b.a"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1679
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1680
%{  /* NOCONTEXT */
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1681
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1682
    unsigned INT swapped;
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1683
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1684
#if __POINTER_SIZE__ == 4
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1685
    //   xxxxxxxx 00000000 00000000 00000000 -> 00000000 00000000 00000000 xxxxxxxx  
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1686
    //            xxxxxxxx                                        xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1687
    //                     xxxxxxxx                      xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1688
    //                              xxxxxxxx    xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1689
    swapped = (v>>24) | ((v>>8)&0xFF00) | ((v & 0xFF00)<<8) | ((v & 0xFF)<<24);
16521
dfd2f93a3045 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16519
diff changeset
  1690
    RETURN(__MKLARGEINT64(1, 0, swapped));
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1691
#else
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1692
    //   xxxxxxxx 00000000 00000000 00000000 -> 00000000 00000000 00000000 xxxxxxxx  
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1693
    //            xxxxxxxx                                        xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1694
    //                     xxxxxxxx                      xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1695
    //                              xxxxxxxx    xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1696
    swapped =  (v>>56) | ((v>>40)&0xFF00) | ((v>>24) & 0xFF0000) | ((v>>8) & 0xFF000000)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1697
                | ((v & 0xFF000000)<<8) | ((v & 0x00FF0000)<<24) | ((v & 0x0000FF00)<<40)
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1698
                | ((v & 0xFF)<<56);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1699
#endif
16521
dfd2f93a3045 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16519
diff changeset
  1700
    RETURN(__MKUINT( swapped ));
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1701
%}.
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1702
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1703
    "
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1704
     16r11223344 byteSwapped64 hexPrintString  
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  1705
     16r44332211 byteSwapped64 hexPrintString   
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1706
    "
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1707
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1708
    "Created: / 09-01-2012 / 23:01:33 / cg"
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1709
!
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  1710
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1711
digitAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1712
    "return 8 bits of value, starting at byte index"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1713
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1714
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1715
357
claus
parents: 329
diff changeset
  1716
    REGISTER INT val;
claus
parents: 329
diff changeset
  1717
    INT idx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1718
252
  1719
    if (__isSmallInteger(index)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1720
	val = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1721
	if (val < 0)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1722
	    val = -val;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1723
	switch (idx = __intVal(index)) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1724
	    case 1:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1725
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1726
	    case 2:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1727
		val = (val >> 8);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1728
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1729
	    case 3:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1730
		val = (val >> 16);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1731
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1732
	    case 4:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1733
		val = (val >> 24);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1734
		break;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1735
#if __POINTER_SIZE__ == 8
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1736
	    case 5:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1737
		val = (val >> 32);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1738
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1739
	    case 6:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1740
		val = (val >> 40);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1741
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1742
	    case 7:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1743
		val = (val >> 48);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1744
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1745
	    case 8:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1746
		val = (val >> 56);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1747
		break;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1748
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1749
	    default:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1750
		if (idx < 1)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1751
		    goto bad;   /* sorry */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1752
		RETURN (__mkSmallInteger(0));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1753
	}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1754
	RETURN ( __mkSmallInteger( val & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1755
    }
357
claus
parents: 329
diff changeset
  1756
  bad: ;
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1757
%}.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1758
    index > 0 ifFalse:[
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1759
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1760
	 index less than 1 - not allowed
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1761
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1762
	^ self primitiveFailed
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1763
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1764
    ^ 0
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1765
357
claus
parents: 329
diff changeset
  1766
    "
claus
parents: 329
diff changeset
  1767
     (16r12345678 digitAt:1) printStringRadix:16
claus
parents: 329
diff changeset
  1768
     (16r12345678 digitAt:3) printStringRadix:16
claus
parents: 329
diff changeset
  1769
     (16r12345678 digitAt:15) printStringRadix:16
claus
parents: 329
diff changeset
  1770
     (16r12345678 digitAt:0) printStringRadix:16
claus
parents: 329
diff changeset
  1771
     (16r12345678 digitAt:-10) printStringRadix:16
claus
parents: 329
diff changeset
  1772
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1773
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1774
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1775
digitByteAt:index
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1776
    "return 8 bits of my signed value, starting at byte index.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1777
     For positive receivers, this is the same as #digitAt:;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1778
     for negative ones, the actual bit representation is returned."
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1779
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1780
%{  /* NOCONTEXT */
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1781
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1782
    REGISTER INT val;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1783
    INT idx;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1784
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1785
    if (__isSmallInteger(index)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1786
	val = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1787
	switch (idx = __intVal(index)) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1788
	    case 1:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1789
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1790
	    case 2:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1791
		val = (val >> 8);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1792
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1793
	    case 3:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1794
		val = (val >> 16);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1795
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1796
	    case 4:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1797
		val = (val >> 24);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1798
		break;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  1799
#if __POINTER_SIZE__ == 8
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1800
	    case 5:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1801
		val = (val >> 32);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1802
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1803
	    case 6:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1804
		val = (val >> 40);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1805
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1806
	    case 7:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1807
		val = (val >> 48);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1808
		break;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1809
	    case 8:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1810
		val = (val >> 56);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1811
		break;
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1812
#endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1813
	    default:
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1814
		if (idx < 1)
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1815
		    goto bad;   /* sorry */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1816
		if (val < 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1817
		    RETURN (__mkSmallInteger(0xFF));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1818
		}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1819
		RETURN (__mkSmallInteger(0));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1820
	}
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1821
	RETURN ( __mkSmallInteger( val & 0xFF) );
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1822
    }
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1823
  bad: ;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1824
%}.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1825
    index > 0 ifFalse:[
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1826
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1827
	 index less than 1 - not allowed
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1828
	"
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  1829
	^ self primitiveFailed
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1830
    ].
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1831
    ^ 0
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1832
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1833
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1834
     (10 digitByteAt:1) printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1835
     (10 digitByteAt:3) printStringRadix:16
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1836
     (-10 digitByteAt:1) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1837
     (-10 digitByteAt:3) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1838
    "
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1839
!
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  1840
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1841
digitBytes
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1842
    "return a byteArray filled with the receivers bits
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1843
     (8 bits of the absolute value per element),
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1844
     least significant byte is first"
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1845
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1846
    |absValue
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1847
     b1 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1848
     b2 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1849
     b3 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1850
     b4 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1851
     b5 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1852
     b6 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1853
     b7 "{ Class: SmallInteger }" digitByteArray|
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1854
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1855
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1856
     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
  1857
     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
  1858
     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
  1859
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1860
    self == 0 ifTrue: [
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1861
        ^ ByteArray with:0.
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1862
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1863
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1864
    self < 0 ifTrue: [
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1865
        absValue := self negated
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1866
    ] ifFalse: [
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1867
        absValue := self.
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1868
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1869
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1870
    b1 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1871
    absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1872
    absValue == 0 ifTrue:[
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1873
        digitByteArray := ByteArray with:b1
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1874
    ] ifFalse:[
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1875
        b2 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1876
        absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1877
        absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1878
            digitByteArray := ByteArray with:b1 with:b2
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1879
        ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1880
            b3 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1881
            absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1882
            absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1883
                digitByteArray := ByteArray with:b1 with:b2 with:b3
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1884
            ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1885
                b4 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1886
                absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1887
                absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1888
                    digitByteArray := ByteArray with:b1 with:b2 with:b3 with:b4
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1889
                ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1890
                    b5 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1891
                    absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1892
                    absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1893
                        digitByteArray := ByteArray new:5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1894
                        digitByteArray at:1 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1895
                        digitByteArray at:2 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1896
                        digitByteArray at:3 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1897
                        digitByteArray at:4 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1898
                        digitByteArray at:5 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1899
                    ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1900
                        b6 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1901
                        absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1902
                        absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1903
                            digitByteArray := ByteArray new:6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1904
                            digitByteArray at:1 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1905
                            digitByteArray at:2 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1906
                            digitByteArray at:3 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1907
                            digitByteArray at:4 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1908
                            digitByteArray at:5 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1909
                            digitByteArray at:6 put:b6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1910
                        ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1911
                            b7 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1912
                            absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1913
                            absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1914
                                digitByteArray := ByteArray new:7.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1915
                                digitByteArray at:1 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1916
                                digitByteArray at:2 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1917
                                digitByteArray at:3 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1918
                                digitByteArray at:4 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1919
                                digitByteArray at:5 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1920
                                digitByteArray at:6 put:b6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1921
                                digitByteArray at:7 put:b7.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1922
                            ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1923
                                digitByteArray := ByteArray new:8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1924
                                digitByteArray at:1 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1925
                                digitByteArray at:2 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1926
                                digitByteArray at:3 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1927
                                digitByteArray at:4 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1928
                                digitByteArray at:5 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1929
                                digitByteArray at:6 put:b6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1930
                                digitByteArray at:7 put:b7.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1931
                                digitByteArray at:8 put:absValue.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1932
                            ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1933
                        ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1934
                    ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1935
                ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1936
            ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1937
        ]
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1938
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1939
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  1940
    ^ digitByteArray
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1941
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1942
    "
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1943
      16r12 digitBytes hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1944
      16r1234 digitBytes hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1945
      16r12345678 digitBytes hexPrintString
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1946
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1947
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1948
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1949
digitBytesMSB
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1950
    "return a byteArray filled with the receivers bits
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1951
     (8 bits of the absolute value per element),
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1952
     most significant byte is first"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1953
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1954
    |absValue
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1955
     b1 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1956
     b2 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1957
     b3 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1958
     b4 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1959
     b5 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1960
     b6 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1961
     b7 "{ Class: SmallInteger }" digitByteArray|
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1962
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  1963
    "
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1964
     could have simply created a 4-byte largeinteger and normalize it.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1965
     The code below does the normalize right away, avoiding the
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1966
     overhead of producing any intermediate byte-arrays (and the scanning)
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1967
    "
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1968
    self == 0 ifTrue: [
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1969
        ^ ByteArray with:0.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1970
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1971
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1972
    self < 0 ifTrue: [
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1973
        absValue := self negated
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1974
    ] ifFalse: [
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1975
        absValue := self.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1976
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1977
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1978
    b1 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1979
    absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1980
    absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1981
        digitByteArray := ByteArray with:b1
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1982
    ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1983
        b2 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1984
        absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1985
        absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1986
            digitByteArray := ByteArray with:b2 with:b1
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1987
        ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1988
            b3 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1989
            absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1990
            absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1991
                digitByteArray := ByteArray with:b3 with:b2 with:b1
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1992
            ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1993
                b4 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1994
                absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1995
                absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1996
                    digitByteArray := ByteArray with:b4 with:b3 with:b2 with:b1
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1997
                ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1998
                    b5 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  1999
                    absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2000
                    absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2001
                        digitByteArray := ByteArray new:5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2002
                        digitByteArray at:1 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2003
                        digitByteArray at:2 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2004
                        digitByteArray at:3 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2005
                        digitByteArray at:4 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2006
                        digitByteArray at:5 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2007
                    ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2008
                        b6 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2009
                        absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2010
                        absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2011
                            digitByteArray := ByteArray new:6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2012
                            digitByteArray at:1 put:b6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2013
                            digitByteArray at:2 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2014
                            digitByteArray at:3 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2015
                            digitByteArray at:4 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2016
                            digitByteArray at:5 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2017
                            digitByteArray at:6 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2018
                        ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2019
                            b7 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2020
                            absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2021
                            absValue == 0 ifTrue:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2022
                                digitByteArray := ByteArray new:7.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2023
                                digitByteArray at:1 put:b7.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2024
                                digitByteArray at:2 put:b6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2025
                                digitByteArray at:3 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2026
                                digitByteArray at:4 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2027
                                digitByteArray at:5 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2028
                                digitByteArray at:6 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2029
                                digitByteArray at:7 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2030
                            ] ifFalse:[
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2031
                                digitByteArray := ByteArray new:8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2032
                                digitByteArray at:1 put:absValue.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2033
                                digitByteArray at:2 put:b7.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2034
                                digitByteArray at:3 put:b6.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2035
                                digitByteArray at:4 put:b5.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2036
                                digitByteArray at:5 put:b4.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2037
                                digitByteArray at:6 put:b3.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2038
                                digitByteArray at:7 put:b2.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2039
                                digitByteArray at:8 put:b1.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2040
                            ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2041
                        ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2042
                    ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2043
                ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2044
            ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2045
        ]
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2046
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2047
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2048
    ^ digitByteArray
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2049
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2050
    "
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2051
      16r12 digitBytesMSB hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2052
      16r1234 digitBytesMSB hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2053
      16r12345678 digitBytesMSB hexPrintString
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2054
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2055
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2056
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2057
digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2058
    "return the number bytes required to represent this Integer.
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2059
     For negative receivers, the digitLength of its absolute value
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2060
     is returned."
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2061
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2062
%{  /* NOCONTEXT */
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2063
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2064
    INT val = __intVal(self);
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2065
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2066
    if (val < 0) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2067
	val = -val;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2068
    }
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8506
diff changeset
  2069
#if __POINTER_SIZE__ == 8
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2070
    if (val & 0xFFFFFFFF00000000L) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2071
	if (val & 0xFFFF000000000000L) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2072
	    if (val & 0xFF00000000000000L) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2073
		RETURN ( __mkSmallInteger(8));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2074
	    } else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2075
		RETURN ( __mkSmallInteger(7));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2076
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2077
	} else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2078
	    if (val & 0x0000FF0000000000L) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2079
		RETURN ( __mkSmallInteger(6));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2080
	    } else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2081
		RETURN ( __mkSmallInteger(5));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2082
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2083
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2084
    }
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2085
#endif
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2086
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2087
    if (val & 0xFFFF0000) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2088
	if (val & 0xFF000000) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2089
	    RETURN ( __mkSmallInteger(4));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2090
	} else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2091
	    RETURN ( __mkSmallInteger(3));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2092
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2093
    } else {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2094
	if (val & 0x0000FF00) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2095
	    RETURN ( __mkSmallInteger(2));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2096
	} else {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2097
	    RETURN ( __mkSmallInteger(1));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2098
	}
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2099
    }
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2100
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2101
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2102
    ^ self abs highBit - 1 // 8 + 1
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2103
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2104
    "
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2105
     16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2106
     -16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2107
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2108
     16rFF000000 digitLength
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2109
     16rFF0000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2110
     16rFF00 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2111
     16rFF digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2112
     -16rFF000000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2113
     -16rFF0000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2114
     -16rFF00 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2115
     -16rFF digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2116
    "
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2117
!
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2118
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2119
swapBytes
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2120
    "swap bytes pair-wise in a positive integer
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2121
     i.e. a.b.c.d -> b.a.d.c.
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2122
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2123
     Redefined here for speed.
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2124
     Swapping of negative integers is undefined and therefore not supported.
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2125
     This case is handled in the superclass."
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2126
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2127
%{  /* NOCONTEXT */
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2128
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2129
    unsigned INT v = __intVal(self);
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2130
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2131
    if ((INT)v >= 0) {
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2132
        unsigned INT swapped;
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2133
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2134
#if __POINTER_SIZE__ == 8
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2135
        swapped = ((v >> 8) & 0x00FF00FF00FF00FF) | ((v & 0x00FF00FF00FF00FF) << 8);
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2136
#else
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2137
        swapped = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2138
#endif /* __POINTER_SIZE__ */
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2139
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2140
        //if (__ISVALIDINTEGER(swapped)) {   // sorry, but this does not work here if (INT)swapped would be negative
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2141
        if (swapped <= _MAX_INT) {
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2142
            RETURN ( __mkSmallInteger(swapped) );
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2143
        }
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2144
        RETURN (__MKUINT(swapped));
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2145
    }
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2146
%}.
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2147
    ^ super swapBytes
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2148
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2149
    "
16873
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  2150
     -1 swapBytes hexPrintString   
15325
48feb23cd013 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15322
diff changeset
  2151
     16r11223344 swapBytes hexPrintString   
16873
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  2152
     16r44332211 swapBytes hexPrintString 
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  2153
     self maxVal swapBytes hexPrintString
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  2154
     self maxVal swapBytes swapBytes hexPrintString
15325
48feb23cd013 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15322
diff changeset
  2155
     16r1122334455667788 swapBytes hexPrintString   
48feb23cd013 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15322
diff changeset
  2156
     16r11223344556677889900 swapBytes hexPrintString   
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2157
    "
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2158
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2159
    "Created: / 09-01-2012 / 23:01:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2160
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2161
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2162
!SmallInteger methodsFor:'catching messages'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2163
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2164
basicAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2165
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2166
     defined here since basicAt: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2167
14540
84fc4b759ad8 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14492
diff changeset
  2168
    ^ self notIndexed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2169
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2170
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2171
basicAt:index put:anObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2172
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2173
     defined here since basicAt:put: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2174
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2175
    self notIndexed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2176
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2177
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2178
basicSize
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2179
    "return the number of indexed instvars - SmallIntegers have none.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2180
     Defined here since basicSize in Object ommits the SmallInteger check."
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
    ^ 0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2183
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2184
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2185
size
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2186
    "return the number of indexed instvars - SmallIntegers have none."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2187
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2188
    ^ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2189
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2190
5240
2a91958ba1f1 categories
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  2191
!SmallInteger methodsFor:'coercing & converting'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2192
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2193
asCharacter
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2194
    "Return a character with the receiver as ascii value"
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  2195
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2196
    ^ Character value:self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2197
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2198
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2199
asFloat
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  2200
    "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
  2201
     Redefined for performance (machine can do it faster)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2202
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2203
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2204
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2205
    OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2206
    double dVal = (double)__intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2207
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  2208
    __qMKFLOAT(newFloat, dVal);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2209
    RETURN ( newFloat );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2210
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2211
    ^ self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2212
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2213
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2214
asLargeInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2215
    "return a LargeInteger with same value as receiver"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2216
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2217
    ^ LargeInteger value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2218
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2219
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2220
asShortFloat
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  2221
    "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
  2222
     Redefined for performance (machine can do it faster)"
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2223
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2224
%{  /* NOCONTEXT */
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2225
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2226
    OBJ dummy = @global(ShortFloat);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2227
    OBJ newFloat;
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2228
    float fVal = (float)__intVal(self);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2229
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  2230
    __qMKSFLOAT(newFloat, fVal);
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2231
    RETURN ( newFloat );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2232
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2233
    ^ self primitiveFailed
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2234
!
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2235
8408
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2236
codePoint
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2237
    "for compatibility with Characters.
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2238
     (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
  2239
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2240
    ^ self
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2241
!
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2242
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2243
coerce:aNumber
11718
1128a869a77a comment
Claus Gittinger <cg@exept.de>
parents: 11666
diff changeset
  2244
    "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
  2245
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2246
    ^ aNumber asInteger
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
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2249
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2250
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2251
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2252
    ^ 20
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2253
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2254
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2255
signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2256
    "return a smallInteger from sign-extending the 24'th bit.
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2257
     May be useful for communication interfaces"
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2258
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2259
%{  /* NOCONTEXT */
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2260
    INT i = __intVal(self);
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2261
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2262
    if (i & 0x800000) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2263
	i = i | ~0xFFFFFFL;
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2264
    } else {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2265
	i = i & 0x7FFFFF;
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2266
    }
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2267
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2268
    RETURN (__mkSmallInteger(i));
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2269
%}.
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2270
    ^ self primitiveFailed
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2271
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2272
    "
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2273
     16rFFFFFF signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2274
     16r800000 signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2275
     16r7FFFFF signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2276
    "
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2277
!
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2278
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2279
signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2280
    "return a smallInteger from sign-extending the 8'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2281
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2282
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2283
%{  /* NOCONTEXT */
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  2284
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2285
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2286
    if (i & 0x80) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2287
	i = i | ~0xFFL;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2288
    } else {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2289
	i = i & 0x7F;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2290
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2291
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2292
    RETURN (__mkSmallInteger(i));
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2293
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2294
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2295
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2296
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2297
     16rFF signExtendedByteValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2298
     16r80 signExtendedByteValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2299
     16r7F signExtendedByteValue
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2300
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2301
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2302
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2303
signExtendedLongValue
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2304
    "return a smallInteger from sign-extending the 32'th bit.
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2305
     May be useful for communication interfaces"
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2306
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2307
%{  /* NOCONTEXT */
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2308
    INT i = __intVal(self);
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2309
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2310
    if (i & 0x80000000) {
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2311
        i = i | ~0xFFFFFFFFL;
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2312
    } else {
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2313
        i = i & 0x7FFFFFFF;
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2314
    }
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2315
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2316
    RETURN (__mkSmallInteger(i));
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2317
%}.
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2318
    ^ self primitiveFailed
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2319
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2320
    "
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2321
     16rFFFFFFFF signExtendedLongValue
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2322
     16r80000000 signExtendedLongValue
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2323
     16r7FFFFFFF signExtendedLongValue
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2324
    "
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2325
!
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2326
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2327
signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2328
    "return a smallInteger from sign-extending the 16'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2329
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2330
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2331
%{  /* NOCONTEXT */
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  2332
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2333
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2334
    if (i & 0x8000) {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2335
	i = i | ~0xFFFFL;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2336
    } else {
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2337
	i = i & 0x7FFF;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2338
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2339
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2340
    RETURN (__mkSmallInteger(i));
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2341
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2342
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2343
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2344
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2345
     16rFFFF signExtendedShortValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2346
     16r8000 signExtendedShortValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2347
     16r7FFF signExtendedShortValue
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2348
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2349
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2350
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2351
!SmallInteger methodsFor:'comparing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2352
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2353
< aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2354
    "return true, if the argument is greater than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2355
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2356
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2357
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2358
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2359
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2360
	RETURN ( (__intVal(self) < __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2361
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2362
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2363
	RETURN ( ((INT)self < (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2364
#endif
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
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2367
	RETURN ( ((double)__intVal(self) < __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2368
    }
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2369
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2370
    ^ aNumber lessFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2371
    "^ self retry:#< coercing:aNumber"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2372
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2373
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2374
<= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2375
    "return true, if the argument is greater or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2376
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2377
%{  /* NOCONTEXT */
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
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2380
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2381
	RETURN ( (__intVal(self) <= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2382
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2383
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2384
	RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2385
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2386
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2387
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2388
	RETURN ( ((double)__intVal(self) <= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2389
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2390
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2391
    ^ (self > aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2392
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2393
    "Modified: / 31.7.2002 / 10:07:17 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2394
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2395
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2396
= aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2397
    "return true, if the argument represents the same numeric value
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2398
     as the receiver, false otherwise"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2399
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2400
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2401
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2402
    if (aNumber == self) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2403
	RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2404
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2405
    if (! __isNonNilObject(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2406
	/* a smallint or nil */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2407
	RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2408
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2409
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2410
    if (__qIsFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2411
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2412
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2413
    if (__qIsShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2414
	RETURN ( ((double)__intVal(self) == __shortFloatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2415
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2416
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2417
    ^ aNumber equalFromInteger:self
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2418
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2419
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2420
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2421
    "return true, if the argument is less than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2422
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2423
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2424
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2425
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2426
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2427
	RETURN ( (__intVal(self) > __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2428
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2429
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2430
	RETURN ( ((INT)self > (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2431
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2432
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2433
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2434
	RETURN ( ((double)__intVal(self) > __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2435
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2436
%}.
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2437
    ^ (aNumber < self)
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2438
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2439
    "Modified: / 31.7.2002 / 10:07:05 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2440
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2441
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2442
>= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2443
    "return true, if the argument is less or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2444
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2445
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2446
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2447
    if (__isSmallInteger(aNumber)) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2448
#ifdef POSITIVE_ADDRESSES
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2449
	RETURN ( (__intVal(self) >= __intVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2450
#else
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2451
	/* tag bit does not change ordering */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2452
	RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2453
#endif
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2454
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2455
    if (__isFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2456
	RETURN ( ((double)__intVal(self) >= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2457
    }
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2458
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  2459
    ^ (self < aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2460
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2461
    "Modified: / 31.7.2002 / 10:07:11 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2462
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2463
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2464
hash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2465
    "return an integer useful for hashing on value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2466
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2467
    self >= 0 ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2468
    ^ self negated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2469
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2470
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2471
identityHash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2472
    "return an integer useful for hashing on identity"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2473
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  2474
     self >= 0 ifTrue:[^ self].
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  2475
     ^ self negated
1963
ea26c7b9ca1d experimental: new hash value for smallInts
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2476
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  2477
    "Modified: 11.11.1996 / 18:42:14 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2478
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2479
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2480
max:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2481
    "return the receiver or the argument, whichever is greater"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2482
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2483
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2484
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2485
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2486
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2487
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2488
	if ((INT)(self) > (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2489
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2490
	if (__intVal(self) > __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2491
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2492
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2493
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2494
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2495
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2496
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2497
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2498
	if ( (double)__intVal(self) > __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2499
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2500
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2501
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2502
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2503
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2504
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2505
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2506
    (self > aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2507
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2508
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2509
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2510
min:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2511
    "return the receiver or the argument, whichever is smaller"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2512
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2513
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2514
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2515
    if (__isSmallInteger(aNumber)) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2516
#if TAG_INT == 1
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2517
	/* tag bit does not change ordering */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2518
	if ((INT)(self) < (INT)(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2519
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2520
	if (__intVal(self) < __intVal(aNumber))
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2521
#endif
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2522
	{
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2523
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2524
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2525
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2526
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2527
    if (__isFloatLike(aNumber)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2528
	if ( (double)__intVal(self) < __floatVal(aNumber) ) {
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2529
	    RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2530
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2531
	RETURN ( aNumber );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2532
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2533
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2534
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2535
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2536
    (self < aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2537
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2538
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2539
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2540
~= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2541
    "return true, if the arguments value is not equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2542
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2543
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2544
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2545
    if (aNumber == self) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2546
	RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2547
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2548
    if (! __isNonNilObject(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2549
	/* a smallint or nil */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2550
	RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2551
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2552
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2553
    if (__qIsFloatLike(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2554
	RETURN ( ((double)__intVal(self) != __floatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2555
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2556
    if (__qIsShortFloat(aNumber)) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2557
	RETURN ( ((double)__intVal(self) != __shortFloatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2558
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2559
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  2560
    ^ (self = aNumber) not
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2561
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2562
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2563
!SmallInteger methodsFor:'copying'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2564
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2565
deepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2566
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2567
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2568
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2569
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2570
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2571
10947
e01ba2c3533f deepCopy change
ab
parents: 10487
diff changeset
  2572
deepCopyUsing:aDictionary postCopySelector:postCopySelector
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2573
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2574
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2575
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2576
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2577
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2578
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2579
shallowCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2580
    "return a shallow copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2581
     - reimplemented here since smallintegers are unique"
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
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2584
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2585
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2586
simpleDeepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2587
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2588
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2589
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2590
    ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2591
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2592
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  2593
!SmallInteger methodsFor:'iteration'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2594
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2595
timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  2596
    "evaluate the argument, aBlock self times.
claus
parents: 329
diff changeset
  2597
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2598
357
claus
parents: 329
diff changeset
  2599
%{
claus
parents: 329
diff changeset
  2600
    REGISTER INT tmp;
claus
parents: 329
diff changeset
  2601
    static struct inlineCache blockVal = __ILC0(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2602
357
claus
parents: 329
diff changeset
  2603
    tmp = __intVal(self);
claus
parents: 329
diff changeset
  2604
    if (tmp > 0) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2605
	if (__isBlockLike(aBlock)
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2606
	 && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(0))) {
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2607
	    {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2608
		REGISTER OBJFUNC codeVal;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2609
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2610
		/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2611
		 * specially tuned version for compiled blocks,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2612
		 * (the most common case)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2613
		 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2614
		if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2615
#ifdef PARANOIA
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2616
		 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2617
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2618
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2619
357
claus
parents: 329
diff changeset
  2620
#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
  2621
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2622
#                   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
  2623
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2624
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2625
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2626
#                   define BLOCK_ARG  rHome
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2627
		    REGISTER OBJ rHome;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2628
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2629
		    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2630
		     * home on stack - no need to refetch
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2631
		     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2632
		    rHome = __BlockInstPtr(aBlock)->b_home;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2633
		    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
  2634
#endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2635
		    {
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2636
#ifdef __UNROLL_LOOPS__
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2637
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2638
			/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2639
			 * 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
  2640
			 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2641
			while (tmp > 8) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2642
			    if (InterruptPending != nil) goto interrupted0;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2643
	continue0:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2644
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2645
			    if (InterruptPending != nil) goto interrupted1;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2646
	continue1:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2647
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2648
			    if (InterruptPending != nil) goto interrupted2;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2649
	continue2:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2650
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2651
			    if (InterruptPending != nil) goto interrupted3;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2652
	continue3:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2653
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2654
			    if (InterruptPending != nil) goto interrupted4;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2655
	continue4:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2656
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2657
			    if (InterruptPending != nil) goto interrupted5;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2658
	continue5:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2659
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2660
			    if (InterruptPending != nil) goto interrupted6;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2661
	continue6:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2662
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2663
			    if (InterruptPending != nil) goto interrupted7;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2664
	continue7:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2665
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2666
			    tmp -= 8;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2667
			}
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2668
#endif /* __UNROLL_LOOPS__ */
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2669
			do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2670
			    if (InterruptPending != nil) goto interruptedX;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2671
	continueX:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2672
			    (*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2673
			} while(--tmp);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2674
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2675
			RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2676
			if (0) {
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2677
#ifdef __UNROLL_LOOPS__
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2678
			    interrupted0:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2679
						__interruptL(@line); goto continue0;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2680
			    interrupted1:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2681
						__interruptL(@line); goto continue1;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2682
			    interrupted2:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2683
						__interruptL(@line); goto continue2;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2684
			    interrupted3:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2685
						__interruptL(@line); goto continue3;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2686
			    interrupted4:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2687
						__interruptL(@line); goto continue4;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2688
			    interrupted5:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2689
						__interruptL(@line); goto continue5;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2690
			    interrupted6:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2691
						__interruptL(@line); goto continue6;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2692
			    interrupted7:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2693
						__interruptL(@line); goto continue7;
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2694
#endif /* __UNROLL_LOOPS__ */
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2695
			    interruptedX:
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2696
						__interruptL(@line); goto continueX;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2697
			}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2698
		    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2699
		}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2700
	    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  2701
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2702
#           undef BLOCK_ARG
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  2703
400
claus
parents: 394
diff changeset
  2704
#ifdef NEW_BLOCK_CALL
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2705
#           define BLOCK_ARG  aBlock
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2706
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  2707
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2708
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2709
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  2710
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  2711
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2712
	    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2713
	     * sorry - must check for the blocks code within the loops;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2714
	     * it could be recompiled or flushed (in the interrupt)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2715
	     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2716
	    do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2717
		REGISTER OBJFUNC codeVal;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2718
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2719
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2720
		    /*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2721
		     * arg is a compiled block with code -
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2722
		     * directly call it without going through Block>>value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2723
		     * however, if there is an interrupt, refetch the code pointer.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2724
		     */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2725
		    /* stay here, while no interrupts are pending ... */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2726
		    do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2727
			(*codeVal)(BLOCK_ARG);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2728
			if (InterruptPending != nil) goto outerLoop;
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2729
		    } while (--tmp);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2730
		    RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2731
		} else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2732
		    if (InterruptPending != nil) __interruptL(@line);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2733
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2734
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2735
			/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2736
			 * arg is a compiled block with bytecode -
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2737
			 * directly call interpreter without going through Block>>value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2738
			 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2739
			__interpret(aBlock, 0, nil, IBLOCK_ARG, nil, nil);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2740
		    } else {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2741
			/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2742
			 * arg is something else - call it with #value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2743
			 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2744
			(*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2745
		    }
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2746
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  2747
    outerLoop: ;
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2748
	    } while (--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2749
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2750
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2751
#           undef IBLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2752
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2753
	    RETURN (self);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2754
	}
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2755
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2756
	/*
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2757
	 * not a block-like thingy - call it with #value
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2758
	 */
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2759
	do {
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2760
	    if (InterruptPending != nil) __interruptL(@line);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2761
	    (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2762
	} while(--tmp);
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2763
	RETURN (self);
357
claus
parents: 329
diff changeset
  2764
    }
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2765
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2766
    ^ super timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  2767
claus
parents: 329
diff changeset
  2768
"/    |count "{ Class: SmallInteger }" |
claus
parents: 329
diff changeset
  2769
"/
claus
parents: 329
diff changeset
  2770
"/    count := self.
claus
parents: 329
diff changeset
  2771
"/    [count > 0] whileTrue:[
claus
parents: 329
diff changeset
  2772
"/        aBlock value.
claus
parents: 329
diff changeset
  2773
"/        count := count - 1
claus
parents: 329
diff changeset
  2774
"/    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2775
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2776
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2777
to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2778
    "reimplemented as primitive for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2779
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2780
%{
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2781
    REGISTER INT tmp, step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2782
    REGISTER INT final;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2783
    static struct inlineCache blockVal = __ILC1(0);
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2784
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2785
    if (__bothSmallInteger(incr, stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2786
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2787
	final = __intVal(stop);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2788
	step = __intVal(incr);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2789
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2790
	if (__isBlockLike(aBlock)
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2791
	 && (__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
  2792
	    {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2793
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2794
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2795
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2796
		 * specially tuned version for static compiled blocks, called with
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2797
		 * home on the stack (the most common case)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2798
		 */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2799
		if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2800
#ifdef PARANOIA
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2801
		 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2802
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  2803
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2804
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2805
#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
  2806
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2807
#                   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
  2808
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2809
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2810
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2811
#                   define BLOCK_ARG  rHome
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2812
		    REGISTER OBJ rHome;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2813
		    rHome = __BlockInstPtr(aBlock)->b_home;
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2814
		    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
  2815
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2816
#endif
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2817
		    {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2818
			if (step < 0) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2819
			    if (step == -1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2820
				while (tmp >= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2821
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2822
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2823
				    tmp--;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2824
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2825
			    } else {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2826
				while (tmp >= final) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2827
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2828
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2829
				    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2830
				}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2831
			    }
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2832
			} else {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2833
			    if (step == 1) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2834
				while (tmp <= final) {
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2835
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2836
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2837
				    tmp++;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2838
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2839
			    } else {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  2840
				while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2841
				    if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2842
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2843
				    tmp += step;
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2844
				}
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2845
			    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2846
			}
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2847
			RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2848
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2849
		}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2850
	    }
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2851
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
	     * 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
  2854
	     * 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
  2855
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2856
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2857
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2858
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2859
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2860
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2861
#           define IBLOCK_ARG nil
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2862
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2863
#           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
  2864
#           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
  2865
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2866
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2867
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2868
		while (tmp >= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2869
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2870
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2871
		    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
  2872
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2873
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2874
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2875
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2876
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2877
			 */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2878
			(*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
  2879
		    } else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2880
			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
  2881
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2882
			     * 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
  2883
			     * 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
  2884
			     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2885
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2886
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2887
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2888
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2889
				idx = __mkSmallInteger(tmp);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2890
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2891
			    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2892
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2893
			    __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
  2894
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2895
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2896
			} else {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2897
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2898
			     * arg is something else - call it with #value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2899
			     */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2900
			    (*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
  2901
			}
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2902
		    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2903
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2904
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2905
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2906
		while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2907
		    REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2908
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2909
		    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
  2910
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  2911
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2912
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2913
			 * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2914
			 * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2915
			 */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2916
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2917
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2918
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2919
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2920
			     * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2921
			     * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2922
			     */
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2923
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2924
			    {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2925
				OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2926
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2927
				idx = __mkSmallInteger(tmp);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2928
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2929
			    }
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2930
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2931
			    __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
  2932
#endif
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2933
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2934
			} else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2935
			    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2936
			     * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2937
			     */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2938
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2939
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2940
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2941
		    tmp += step;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  2942
		}
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2943
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2944
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2945
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2946
#           undef IBLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2947
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2948
	} else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2949
	    /*
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2950
	     * arg is something else - call it with #value:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2951
	     */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2952
	    if (step < 0) {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2953
		while (tmp >= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2954
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2955
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2956
		    (*blockVal.ilc_func)(aBlock,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2957
					 @symbol(value:),
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  2958
					 nil, &blockVal,
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2959
					 __mkSmallInteger(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2960
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2961
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2962
	    } else {
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2963
		while (tmp <= final) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2964
		    if (InterruptPending != nil) __interruptL(@line);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2965
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2966
		    (*blockVal.ilc_func)(aBlock,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2967
					 @symbol(value:),
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1672
diff changeset
  2968
					 nil, &blockVal,
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2969
					 __mkSmallInteger(tmp));
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2970
		    tmp += step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2971
		}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2972
	    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2973
	}
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2974
	RETURN ( self );
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2975
    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  2976
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2977
    "/
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2978
    "/ 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
  2979
    "/ pass on to super ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  2980
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2981
    ^ super to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2982
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2983
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2984
     1 to:10 by:3 do:[:i | i printNewline]
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2985
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2986
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2987
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2988
to:stop do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2989
    "evaluate aBlock for every integer between (and including) the receiver
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2990
     and the argument, stop.
357
claus
parents: 329
diff changeset
  2991
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2992
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2993
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2994
    REGISTER INT tmp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2995
    INT final;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  2996
    static struct inlineCache blockVal = __ILC1(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2997
252
  2998
    if (__isSmallInteger(stop)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2999
	tmp = __intVal(self);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3000
	final = __intVal(stop);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3001
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3002
	if (__isBlockLike(aBlock)
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3003
	 && (__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
  3004
	    {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3005
		/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3006
		 * 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
  3007
		 * where called with home on the stack
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3008
		 */
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3009
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3010
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3011
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3012
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3013
#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
  3014
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3015
#                   define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3016
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3017
#else
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3018
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3019
#                   define BLOCK_ARG  rHome
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3020
		    REGISTER OBJ rHome;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3021
		    rHome = __BlockInstPtr(aBlock)->b_home;
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3022
		    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
  3023
#endif
400
claus
parents: 394
diff changeset
  3024
		    {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3025
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  3026
#ifdef PARANOIA
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3027
			if (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
2678
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  3028
#endif
37eec0043bdb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2672
diff changeset
  3029
			{
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3030
			    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3031
			     * static compiled blocks ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3032
			     */
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  3033
#ifdef __UNROLL_LOOPS__
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3034
			    /*
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3035
			     * 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
  3036
			     *  - taken branches only if interrupts are pending
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3037
			     *  - 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
  3038
			     *  - unrolled the loop
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3039
			     *
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3040
			     * 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
  3041
			     */
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3042
# if TAG_INT==1
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3043
			    INT t8 = (INT)(__mkSmallInteger(tmp+8));
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3044
			    tmp = (INT)(__mkSmallInteger(tmp));
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3045
			    final = (INT)(__mkSmallInteger(final));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3046
# else
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3047
			    INT t8 = tmp+8;
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3048
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3049
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3050
			    for (;;) {
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3051
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3052
				while (t8 <= final) {
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3053
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3054
				    t8 += (INT)(__MASKSMALLINT(8));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3055
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3056
				    t8 += 8;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3057
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3058
				    if (InterruptPending != nil) goto interrupted0;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3059
	continue0:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3060
# if TAG_INT==1
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3061
				    (*codeVal)(BLOCK_ARG, tmp);
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3062
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3063
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3064
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3065
				    if (InterruptPending != nil) goto interrupted1;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3066
	continue1:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3067
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3068
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(1)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3069
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3070
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+1));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3071
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3072
				    if (InterruptPending != nil) goto interrupted2;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3073
	continue2:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3074
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3075
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(2)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3076
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3077
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+2));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3078
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3079
				    if (InterruptPending != nil) goto interrupted3;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3080
	continue3:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3081
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3082
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(3)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3083
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3084
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+3));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3085
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3086
				    if (InterruptPending != nil) goto interrupted4;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3087
	continue4:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3088
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3089
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(4)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3090
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3091
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+4));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3092
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3093
				    if (InterruptPending != nil) goto interrupted5;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3094
	continue5:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3095
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3096
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(5)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3097
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3098
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+5));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3099
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3100
				    if (InterruptPending != nil) goto interrupted6;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3101
	continue6:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3102
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3103
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(6)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3104
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3105
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+6));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3106
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3107
				    if (InterruptPending != nil) goto interrupted7;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3108
	continue7:
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3109
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3110
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(7)) );
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3111
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3112
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+7));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3113
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3114
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3115
# if TAG_INT==1
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3116
				    tmp += (INT)(__MASKSMALLINT(8));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3117
# else
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3118
				    tmp += 8;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3119
# endif
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3120
				}
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3121
				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
  3122
				    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
  3123
	continueX:
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3124
# if TAG_INT==1
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3125
				    (*codeVal)(BLOCK_ARG, tmp);
2770
7c4ab842329f alpha changes
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
  3126
				    tmp += (INT)(__MASKSMALLINT(1));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3127
# else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3128
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3129
				    tmp++;
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3130
# endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3131
				}
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3132
				RETURN (self);
2693
8ffe0f4374d6 10% speedup in to:do:
Claus Gittinger <cg@exept.de>
parents: 2678
diff changeset
  3133
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3134
				if (0) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3135
				    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3136
				     * no discussion about those gotos ...
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3137
				     * ... its better for your CPU's pipelines
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3138
				     * (if you dont understand why, just dont argue).
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3139
				     */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3140
				    interrupted7:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3141
						    __interruptL(@line); goto continue7;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3142
				    interrupted6:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3143
						    __interruptL(@line); goto continue6;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3144
				    interrupted5:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3145
						    __interruptL(@line); goto continue5;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3146
				    interrupted4:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3147
						    __interruptL(@line); goto continue4;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3148
				    interrupted3:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3149
						    __interruptL(@line); goto continue3;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3150
				    interrupted2:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3151
						    __interruptL(@line); goto continue2;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3152
				    interrupted1:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3153
						    __interruptL(@line); goto continue1;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3154
				    interrupted0:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3155
						    __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
  3156
				    interruptedX:
5295fc0fddb7 oops - right shift by int-size did not work on some machines
Claus Gittinger <cg@exept.de>
parents: 2815
diff changeset
  3157
						    __interruptL(@line); goto continueX;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3158
				}
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  3159
			    }
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
  3160
#else
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  3161
			    while (tmp <= final) {
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  3162
				if (InterruptPending != nil) __interruptL(@line);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3163
				(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  3164
				tmp ++;
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3165
			    }
2640
99fe7b8d2b86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2604
diff changeset
  3166
			    RETURN (self);
8919
707a9ff7f9b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  3167
#endif /* __UNROLL_LOOPS__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3168
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3169
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3170
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3171
			 * mhmh - seems to be a block with dynamic code
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3172
			 * must refetch, to allow dynamic recompilation or code flush.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3173
			 */
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3174
			while (tmp <= final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3175
			    if (InterruptPending != nil) __interruptL(@line);
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3176
			    if ((codeVal = __BlockInstPtr(aBlock)->b_code) == (OBJFUNC)nil) break;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3177
			    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3178
			    tmp ++;
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3179
			}
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3180
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3181
			if (tmp > final) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3182
			    RETURN (self);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3183
			}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3184
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3185
		}
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3186
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3187
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3188
#           undef BLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3189
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3190
#ifdef NEW_BLOCK_CALL
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3191
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3192
#           define IBLOCK_ARG nil
400
claus
parents: 394
diff changeset
  3193
#else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3194
#           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
  3195
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
400
claus
parents: 394
diff changeset
  3196
#endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3197
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3198
	    /*
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3199
	     * 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
  3200
	     * 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
  3201
	     */
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3202
	    while (tmp <= final) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3203
		REGISTER OBJFUNC codeVal;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3204
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3205
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3206
		    /*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3207
		     * arg is a compiled block with code -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3208
		     * directly call it without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3209
		     */
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3210
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3211
		    /* stay here, while no interrupts are pending ... */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3212
		    do {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3213
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3214
			if (InterruptPending != nil) goto outerLoop;
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3215
			tmp++;
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3216
		    } while (tmp <= final);
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3217
		    RETURN (self);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3218
		} else {
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3219
		    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3220
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3221
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3222
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3223
			 * arg is a compiled block with bytecode -
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3224
			 * directly call interpreter without going through Block>>value
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3225
			 */
400
claus
parents: 394
diff changeset
  3226
#ifdef PASS_ARG_POINTER
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3227
			{
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3228
			    OBJ idx;
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3229
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3230
			    idx = __mkSmallInteger(tmp);
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3231
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3232
			}
400
claus
parents: 394
diff changeset
  3233
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3234
			__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
400
claus
parents: 394
diff changeset
  3235
#endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3236
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3237
		    } else {
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3238
			/*
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3239
			 * arg is something else - call it with #value:
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3240
			 */
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3241
			(*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3242
		    }
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3243
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3244
	    outerLoop: ;
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3245
		tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3246
	    }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3247
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3248
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3249
#           undef IBLOCK_ARG
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3250
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3251
	    RETURN (self);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3252
	}
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3253
	/*
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3254
	 * arg is something else - call it with #value:
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3255
	 */
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3256
	while (tmp <= final) {
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3257
	    if (InterruptPending != nil) __interruptL(@line);
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3258
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3259
	    (*blockVal.ilc_func)(aBlock,
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3260
					 @symbol(value:),
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3261
					 nil, &blockVal,
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3262
					 __mkSmallInteger(tmp));
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3263
	    tmp++;
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3264
	}
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3265
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3266
    }
400
claus
parents: 394
diff changeset
  3267
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3268
400
claus
parents: 394
diff changeset
  3269
    "/
claus
parents: 394
diff changeset
  3270
    "/ 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
  3271
    "/ pass on to super ...
400
claus
parents: 394
diff changeset
  3272
    "/
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3273
    ^ super to:stop do:aBlock
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3274
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3275
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3276
     1 to:10 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3277
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3278
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3279
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3280
!SmallInteger methodsFor:'misc math'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3281
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3282
bernoulli
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3283
    "returns the nth Bernoulli number.
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3284
     The series runs this:
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3285
	 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
  3286
     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
  3287
     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
  3288
     Used with taylor series for tan"
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3289
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3290
    |table p|
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3291
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3292
    table := #(
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3293
		(1 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3294
		(-1 30)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3295
		(1 42)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3296
		(-1 30)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3297
		(5 66)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3298
		(-691 2730)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3299
		(7 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3300
		(-3617 510)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3301
		(43867 798)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3302
		(-174611 330)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3303
		(854513 138)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3304
		(-236364091 2730)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3305
		(8553103 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3306
		(-23749461029 870)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3307
		(8615841276005 14322)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3308
		(-7709321041217 510)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3309
		(2577687858367 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3310
		(-26315271553053477373 1919190)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3311
		(2929993913841559 6)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3312
		(-261082718496449122051 13530)
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3313
	      ).
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3314
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3315
    self even ifTrue:[
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3316
	self == 0 ifTrue:[^1].
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3317
	p := table at:(self / 2).
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3318
	^ 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
  3319
    ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3320
    self == 1 ifTrue:[ ^ (1 / 2) ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3321
    ^ 0.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3322
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3323
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3324
     0 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3325
     1 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3326
     2 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3327
     3 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3328
     4 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3329
     5 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3330
     6 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3331
     8 bernoulli
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3332
     38 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3333
     40 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3334
     41 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3335
     42 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3336
    "
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3337
!
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3338
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3339
divMod:aNumber
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3340
    "return an array filled with 
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3341
        (self // aNumber) and (self \\ aNumber).
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3342
     The returned remainder has the same sign as aNumber.
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3343
     The following is always true:
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3344
        (receiver // something) * something + (receiver \\ something) = receiver
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3345
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3346
     Be careful with negative results: 9 // 4 -> 2, while -9 // 4 -> -3.
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3347
     Especially surprising:     
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3348
        -1 \\ 10 -> 9  (because -(1/10) is truncated towards next smaller integer, which is -1,
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3349
                        and -1 multiplied by 10 gives -10, so we have to add 9 to get the original -1).
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3350
        -10 \\ 3 -> 2 (because -(10/3) is truncated towards next smaller integer, which is -4,
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3351
                        and -4 * 4 gives -12, so we need to add 2 to get the original -10.
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3352
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3353
     This is redefined here for more performance"
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3354
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3355
%{  /* NOCONTEXT */
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3356
    INT val, div, mod, mySelf;
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3357
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3358
    if (__isSmallInteger(aNumber)
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3359
     && ((val = __intVal(aNumber)) > 0)
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3360
     && ((mySelf = __intVal(self)) >= 0)) {
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3361
        div = mySelf / val;
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3362
        mod = mySelf % val;
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3363
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3364
        RETURN (__ARRAY_WITH2( __mkSmallInteger(div), __mkSmallInteger(mod)));
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3365
    }
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3366
%}.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3367
    ^ super divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3368
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3369
    "
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3370
     10 // 3           -> 3
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3371
     10 \\ 3           -> 1
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3372
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3373
     10 // -3          -> -4
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3374
     10 \\ -3          -> -2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3375
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3376
     -10 // 3          -> -4
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3377
     -10 \\ 3          -> 2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3378
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3379
     -10 // -3         -> 3
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3380
     -10 \\ -3         -> -1
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3381
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3382
     -78 \\ 10         2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3383
     -78 // 10         -8
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3384
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3385
     10 divMod:3       -> #(3 1)   because 3*3 + 1 = 10
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3386
     10 divMod:-3      -> #(-4 -2) because -4*-3 + (-2) = 10
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3387
     -10 divMod:3      -> #(-4 2)  because -4*3 + 2 = -10   
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3388
     -10 divMod:-3     -> #(3 -1)  because -3*3 + (-1) = -10
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3389
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3390
     1000000000000000000000 divMod:3   -> #(333333333333333333333 1)
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3391
     1000000000000000000000 divMod:-3  -> #(-333333333333333333334 -2)
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3392
     -1000000000000000000000 divMod:3  -> #(-333333333333333333334 2)
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3393
     -1000000000000000000000 divMod:-3 -> #(333333333333333333333 -1)
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3394
     100 factorial divMod:103    
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3395
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3396
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3397
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3398
gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3399
    "return the greatest common divisor (Euclid's algorithm).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3400
     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
  3401
     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
  3402
     some code. (thanx to MessageTally)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3403
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3404
%{  /* NOCONTEXT */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3405
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3406
    if (__isSmallInteger(anInteger)) {
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3407
	INT orgArg, ttt, selfInt, orgSelfInt, temp;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3408
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3409
	ttt = orgArg = __intVal(anInteger);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3410
	if (ttt) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3411
	    selfInt = orgSelfInt = __intVal(self);
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3412
	    while (ttt != 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3413
		temp = selfInt % ttt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3414
		selfInt = ttt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3415
		ttt = temp;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3416
	    }
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3417
	    /*
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3418
	     * 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
  3419
	     * a modulus result is when the arg is negative,
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3420
	     * change it explicitely here ...
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3421
	     */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3422
	    if (orgArg < 0) {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3423
		/* result should be negative */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3424
		if (orgSelfInt > 0) selfInt = -selfInt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3425
	    } else {
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3426
		/* result should be positive */
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3427
		if (orgSelfInt < 0) selfInt = -selfInt;
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3428
	    }
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3429
	    RETURN ( __mkSmallInteger(selfInt) );
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
  3430
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3431
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3432
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3433
.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3434
    ^ super gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3435
!
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3436
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3437
gcd_helper:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3438
    "same as gcd - see knuth & Integer>>gcd:"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3439
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3440
    ^ self gcd:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3441
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3442
    "Created: 1.3.1997 / 16:58:01 / cg"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3443
!
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  3444
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3445
intlog10
14492
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  3446
    "return the truncation of log10 of the receiver.
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  3447
     The same as (self log:10) floor.
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  3448
     Stupid implementation, which is used to find out the number of digits needed
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3449
     to print a number/and for conversion to a LargeInteger.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3450
     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
  3451
     (i.e. without log)."
2
claus
parents: 1
diff changeset
  3452
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3453
    self > 0 ifTrue:[
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3454
        self < 10000 ifTrue:[
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3455
            self < 10 ifTrue:[^ 0].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3456
            self < 100 ifTrue:[^ 1].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3457
            self < 1000 ifTrue:[^ 2].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3458
            ^ 3
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3459
        ].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3460
        self < 100000000 ifTrue:[
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3461
            self < 100000 ifTrue:[^ 4].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3462
            self < 1000000 ifTrue:[^ 5].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3463
            self < 10000000 ifTrue:[^ 6].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3464
            ^ 7
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3465
        ].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3466
        self < 1000000000 ifTrue:[^ 8].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3467
        SmallInteger maxBytes == 4 ifTrue:[
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3468
            "/ on a 32 bit machine, SmallInt cannot be larger
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3469
            ^ 9
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3470
        ].
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3471
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3472
        "/ 64 bit machine
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3473
        self < 100000000000000 ifTrue:[
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3474
            self < 10000000000 ifTrue:[^ 9].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3475
            self < 100000000000 ifTrue:[^ 10].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3476
            self < 1000000000000 ifTrue:[^ 11].
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3477
            self < 10000000000000 ifTrue:[^ 12].
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3478
            ^ 13
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3479
        ].   
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3480
        self < 1000000000000000 ifTrue:[^ 14].
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3481
        self < 10000000000000000 ifTrue:[^ 15].
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3482
        self < 100000000000000000 ifTrue:[^ 16].
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3483
        self < 1000000000000000000 ifTrue:[^ 17].
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3484
        ^ 18.
14492
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  3485
    ].
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3486
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3487
    ^ self class
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3488
        raise:#domainErrorSignal
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3489
        receiver:self
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3490
        selector:#intlog10
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3491
        arguments:#()
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3492
        errorString:'logarithm of negative integer'
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3493
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3494
    "
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3495
      99 intlog10 
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  3496
      100 intlog10  
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3497
      101 intlog10
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3498
      (101 log:10) floor
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3499
      120 intlog10
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  3500
      -1 intlog10
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  3501
    "
2
claus
parents: 1
diff changeset
  3502
! !
claus
parents: 1
diff changeset
  3503
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3504
!SmallInteger methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3505
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3506
asBCD
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3507
    "return an integer which represents the BCD encoded value of the receiver;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3508
     that is: each digit of its decimal representation is placed into a nibble
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3509
     of the result. (aka 162 -> 0x162).
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3510
     This conversion is useful for some communication protocols,
16041
989a985b6f61 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16039
diff changeset
  3511
     or control systems, which represent numbers this way..."
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3512
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3513
%{  /* NOCONTEXT */
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3514
    int i;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3515
    INT _10000000s = 0, _1000000s = 0; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3516
    INT _100000s = 0, _10000s = 0, _1000s = 0;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3517
    INT _100s = 0, _10s = 0, _1s = 0;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3518
    INT b = __intVal(self);
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3519
    unsigned INT rslt;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3520
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3521
    if (b <= 99999999) {
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3522
        if (b <= 255) {
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3523
            // the most common case: convert bytes
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3524
            for (i=7; i>=0; i--) {
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3525
                if (_100s >= 5)       _100s += 3; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3526
                if (_10s >= 5)        _10s += 3;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3527
                if (_1s >= 5)         _1s += 3;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3528
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3529
                _100s    =    (_100s<<1)       | (_10s >> 3 & 1);       _100s &= 0xF;  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3530
                _10s     =    (_10s<<1)        | (_1s >> 3 & 1);        _10s &= 0xF; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3531
                _1s      =    (_1s<<1)         | (b >> 7 & 1);          _1s &= 0xF; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3532
                b <<= 1;      
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3533
            }
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3534
            rslt = (_100s<<8) | (_10s<<4) | _1s;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3535
            RETURN (__MKSMALLINT( rslt) );
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3536
        }
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3537
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3538
        for (i=26; i>=0; i--) {
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3539
            if (_10000000s >= 5)  _10000000s += 3; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3540
            if (_1000000s >= 5)   _1000000s += 3; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3541
            if (_100000s >= 5)    _100000s += 3; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3542
            if (_10000s >= 5)     _10000s += 3; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3543
            if (_1000s >= 5)      _1000s += 3; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3544
            if (_100s >= 5)       _100s += 3; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3545
            if (_10s >= 5)        _10s += 3;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3546
            if (_1s >= 5)         _1s += 3;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3547
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3548
            _10000000s =  (_10000000s<<1)  | (_1000000s >> 3 & 1);  _10000000s &= 0xF;  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3549
            _1000000s =   (_1000000s<<1)   | (_100000s >> 3 & 1);   _1000000s &= 0xF;  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3550
            _100000s =    (_100000s<<1)    | (_10000s >> 3 & 1);    _100000s &= 0xF;  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3551
            _10000s  =    (_10000s<<1)     | (_1000s >> 3 & 1);     _10000s &= 0xF;  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3552
            _1000s   =    (_1000s<<1)      | (_100s >> 3 & 1);      _1000s &= 0xF;  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3553
            _100s    =    (_100s<<1)       | (_10s >> 3 & 1);       _100s &= 0xF;  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3554
            _10s     =    (_10s<<1)        | (_1s >> 3 & 1);        _10s &= 0xF; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3555
            _1s      =    (_1s<<1)         | (b >> 26 & 1);         _1s &= 0xF; 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3556
            b <<= 1;      
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3557
        }
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3558
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3559
        rslt = (_10000000s<<28)
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3560
               | (_1000000s<<24) | (_100000s<<20) | (_10000s<<16) 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3561
               | (_1000s<<12) | (_100s<<8) | (_10s<<4) | _1s;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3562
        RETURN (__MKUINT( rslt) );
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3563
    }
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3564
%}.
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3565
    ^ super asBCD.
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3566
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3567
    "
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3568
      99999999 asBCD hexPrintString     
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3569
      12812345 asBCD hexPrintString     
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3570
      128123 asBCD hexPrintString   
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3571
      128901 asBCD hexPrintString   
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3572
      12890 asBCD hexPrintString    
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3573
      1289 asBCD hexPrintString    
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3574
      999 asBCD hexPrintString 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3575
      256 asBCD hexPrintString  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3576
      255 asBCD hexPrintString  
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3577
      128 asBCD hexPrintString 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3578
      162 asBCD hexPrintString 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3579
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3580
      999999999 asBCD hexPrintString     
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3581
      128123456 asBCD hexPrintString     
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3582
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3583
    "
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3584
!
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  3585
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3586
printOn:aStream
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3587
    "append my printstring (base 10) to aStream."
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3588
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3589
    aStream nextPutAll:(self printString)
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3590
!
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3591
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  3592
printOn:aStream base:base showRadix:showRadix
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3593
    "append a string representation of the receiver in the specified numberBase to aStream
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3594
     (if showRadix is true, with initial XXr)
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  3595
     The base argument should be between 2 and 36."
6144
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  3596
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3597
    showRadix ifTrue:[
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3598
	base printOn:aStream.
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3599
	aStream nextPut:$r.
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3600
    ].
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  3601
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3602
    (base isInteger and:[ base between:2 and:36 ]) ifTrue:[
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3603
	aStream nextPutAll:(self printStringRadix:base)
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  3604
    ] ifFalse:[
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3605
	super printOn:aStream base:base showRadix:false.
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  3606
    ].
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  3607
12977
fbf5437b15fb changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12876
diff changeset
  3608
    "Created: / 07-09-2001 / 13:54:40 / cg"
fbf5437b15fb changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12876
diff changeset
  3609
    "Modified: / 02-08-2010 / 12:25:20 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3610
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3611
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3612
printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3613
    "return my printstring (base 10)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3614
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3615
    "since this was heavily used in some applications,
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3616
     here is an exception to the rule of basing printString
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3617
     upon the printOn: method."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  3618
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3619
%{  /* NOCONTEXT */
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3620
    char buffer[30];    /* enough for 64 bit machines */
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3621
    char *cp;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3622
    OBJ newString = nil;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3623
    INT myValue;
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3624
    int negative = 0;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3625
    int len;
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3626
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3627
    if (self == __MKSMALLINT(0)) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3628
        RETURN (@global(ZeroString));
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3629
//        RETURN (__MKSTRING_L("0", 1));
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3630
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3631
    myValue = __intVal(self);
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3632
#ifdef SLOW_CODE
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3633
    /*
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3634
     * 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
  3635
     * (printf is soooo slow)
369
claus
parents: 357
diff changeset
  3636
     */
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3637
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3638
    /*
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3639
     * PROTECT_REGISTERS: 
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3640
     * 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
  3641
     * 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
  3642
     * 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
  3643
     */
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3644
    __BEGIN_PROTECT_REGISTERS__
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3645
    len = snprintf(buffer, sizeof(buffer), "%"_ld_"", myValue);
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3646
    __END_PROTECT_REGISTERS__
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3647
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3648
    if (len >= 0 && len <= sizeof(buffer)) {
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3649
        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
  3650
    }
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3651
#else
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3652
    if (myValue < 0) {
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3653
        negative = 1;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3654
        myValue = -myValue;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3655
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3656
    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
  3657
    *cp-- = '\0';
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3658
    while (myValue != 0) {
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3659
        *cp = '0' + (myValue % 10);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3660
        myValue = myValue / 10;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3661
        cp--;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3662
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3663
    if (negative) {
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3664
        *cp-- = '-';
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3665
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3666
    newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3667
#endif
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3668
    if (newString != nil) {
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3669
        RETURN (newString);
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3670
    }
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3671
%}.
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3672
    "/ only arrive here,
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3673
    "/  when having memory problems (i.e. no space for string) ...
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  3674
    ^ super printString
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3675
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3676
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3677
     1234 printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3678
     0    printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3679
     -100 printString
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3680
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3681
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 123456789012 printString ]] 180 180 180 170 180
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3682
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 12345678 printString ]]     140 150 140 150 140
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3683
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 1234 printString ]]         130 140 130 130 130
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3684
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 12 printString ]]           130 120 120 120 110
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3685
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 5 printString ]]            110 110 100 110 90
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3686
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 0 printString ]]             60 
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  3687
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3688
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3689
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3690
printStringRadix:base
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3691
    "return my printstring (optimized for bases 16, 10 and 8)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3692
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3693
    |s|
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3694
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3695
%{
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3696
    char buffer[64+3];  /* for 64bit machines, base 2, plus sign, plus 0-byte */
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3697
    char *cp;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3698
    OBJ newString;
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3699
    INT myValue;
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3700
    int negative = 0;
3706
6cd714580176 avoid name conflict.
Claus Gittinger <cg@exept.de>
parents: 3705
diff changeset
  3701
    INT __base;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3702
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3703
    if (__isSmallInteger(base)) {
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3704
        if (self == __MKSMALLINT(0)) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3705
            RETURN (__MKSTRING_L("0", 1));
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3706
        }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3707
        myValue = __intVal(self);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3708
        __base = __intVal(base);
3706
6cd714580176 avoid name conflict.
Claus Gittinger <cg@exept.de>
parents: 3705
diff changeset
  3709
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3710
#ifdef SLOW_CODE
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3711
        /* disabled, because printf is slower than the code below */
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3712
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3713
        switch (__base) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3714
            case 10:
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3715
                format = "%"_ld_"";
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3716
                break;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3717
            case 16:
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3718
                format = "%"_lx_"";
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3719
                break;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3720
            case 8:
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3721
                format = "%"_lo_"";
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3722
                break;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3723
        }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3724
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3725
        if (format) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3726
            /*
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3727
             * actually only needed on sparc: since thisContext is
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3728
             * in a global register, which gets destroyed by printf,
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3729
             * manually save it here - very stupid ...
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3730
             */
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3731
            __BEGIN_PROTECT_REGISTERS__
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3732
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3733
            len = snprintf(buffer, sizeof(buffer), format, (long)myValue);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3734
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3735
            __END_PROTECT_REGISTERS__
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3736
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3737
            if (len > 0 && len <= sizeof(buffer)) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3738
                newString = __MKSTRING_L(buffer, len);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3739
                if (newString != nil) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3740
                    RETURN (newString);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3741
                }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3742
            }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3743
        }
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3744
#else
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3745
        if ((__base <= 36) && (__base > 1)) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3746
            if (myValue < 0) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3747
                negative = 1;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3748
                myValue = -myValue;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3749
            }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3750
            cp = buffer + sizeof(buffer) - 1;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3751
            *cp-- = '\0';
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3752
            while (myValue != 0) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3753
                int digit;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3754
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3755
                digit = myValue % __base;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3756
                if (digit <= 9) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3757
                    *cp = '0' + digit;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3758
                } else {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3759
                    *cp = 'A' + digit - 10;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3760
                }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3761
                myValue = myValue / __base;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3762
                cp--;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3763
            }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3764
            if (negative) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3765
                *cp-- = '-';
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3766
            }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3767
            newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3768
            if (newString != nil) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3769
                RETURN (newString);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3770
            }
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3771
        }
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3772
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3773
    }
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3774
%}.
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3775
    "/ arrive here, for bad base,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3776
    "/ or when having memory problems (i.e. no space for string) ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3777
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3778
    "/
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3779
    "/ fall back for seldom used bases
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3780
    "/ Notice: cannt use super>>printStringRadix: here,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3781
    "/ since that would lead to endless recursion ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3782
    "/ (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
  3783
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3784
    s := WriteStream on:(String new:10).
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3785
    super printOn:s base:base.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3786
    ^ s contents.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3787
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3788
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3789
      127 printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3790
      123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3791
      123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3792
      123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3793
      123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3794
      123 printStringRadix:2
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3795
      123 printStringRadix:1
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  3796
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3797
      -127 printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3798
      -123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3799
      -123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3800
      -123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3801
      -123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3802
      -123 printStringRadix:2
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  3803
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3804
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3805
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3806
printfPrintString:formatString
7746
4a4208ef7699 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7471
diff changeset
  3807
    "non-standard, but sometimes useful.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3808
     return a printed representation of the receiver
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3809
     as specified by formatString, which is defined by the C-function 'printf'.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3810
     No checking for string overrun - the resulting string
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3811
     must be shorter than 256 chars or else ...
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3812
     This method is NONSTANDARD and may be removed without notice;
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3813
     it is provided to allow special conversions in very special situations.
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3814
     Notice that a conversion may not be portable; for example,
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3815
     to correctly convert an int on a 64-bit alpha, a %ld is required,
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3816
     on 64bit mingw or visualc, %lld is required,
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3817
     while other systems may be happy with a %d.
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3818
     You cannot use lld unconditionally, because some (old) c printfs do not support it!!)
11923
bf02cbdab69f changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11792
diff changeset
  3819
     Use at your own risk (if at all).
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3820
     WARNNG: this goes directly to the C-printf function and may therefore be inherently unsafe.
11923
bf02cbdab69f changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11792
diff changeset
  3821
     Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3822
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  3823
%{  /* STACK: 400 */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3824
    char buffer[256];
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3825
    OBJ s;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3826
    int len;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3827
12482
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  3828
    if (__isStringLike(formatString)) {
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3829
        /*
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3830
         * actually only needed on sparc: since thisContext is
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3831
         * in a global register, which gets destroyed by printf,
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3832
         * manually save it here - very stupid ...
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3833
         */
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3834
        __BEGIN_PROTECT_REGISTERS__
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3835
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3836
        len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __intVal(self));
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3837
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3838
        __END_PROTECT_REGISTERS__
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3839
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3840
        if (len < 0) goto fail;
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3841
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3842
        s = __MKSTRING_L(buffer, len);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3843
        if (s != nil) {
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3844
            RETURN (s);
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3845
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3846
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3847
fail: ;
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  3848
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3849
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3850
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3851
    "
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3852
        123 printfPrintString:'%%d -> %d'
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3853
        123 printfPrintString:'%%6d -> %6d'   
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3854
        123 printfPrintString:'%%x -> %x'     
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3855
        123 printfPrintString:'%%4x -> %4x'   
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  3856
        123 printfPrintString:'%%04x -> %04x' 
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  3857
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3858
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3859
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3860
!SmallInteger methodsFor:'private'!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3861
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3862
sign:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3863
    "private: for protocol completeness with LargeIntegers"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3864
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3865
    |absVal|
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3866
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3867
    absVal := self abs.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3868
    aNumber < 0 ifTrue:[
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3869
	^ absVal negated
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3870
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3871
    aNumber == 0 ifTrue:[^ 0].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3872
    ^ absVal
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3873
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3874
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3875
     -4 sign:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3876
     -4 sign:0
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3877
     -4 sign:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3878
     -4 sign:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3879
     -4 sign:0
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3880
     -4 sign:1
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3881
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3882
! !
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  3883
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3884
!SmallInteger methodsFor:'special modulo arithmetic'!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3885
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3886
plus32:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3887
    "return the sum of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3888
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3889
     If the result overflows the 32 bit range, the value modulo 16rFFFFFFFF is returned.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3890
     This is of course not always correct, but allows for C/Java behavior to be emulated."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3891
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3892
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3893
    INT sum;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3894
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3895
    sum =  __unsignedLongIntVal(self) + __unsignedLongIntVal(aNumber);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3896
#if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3897
    sum &= 0xFFFFFFFFL;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3898
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3899
    RETURN ( __MKUINT(sum));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3900
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3901
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3902
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3903
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3904
     16r7FFFFFFF + 1          2147483648
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3905
     16r7FFFFFFF plus32: 1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3906
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3907
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3908
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3909
plus:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3910
    "return the sum of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3911
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3912
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3913
     smallInteger range is returned (i.e. the low bits of the sum).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3914
     This is of course not always correct, but some code does a modulo anyway
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3915
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3916
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3917
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3918
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3919
    if (__isSmallInteger(aNumber)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3920
	INT sum;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3921
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3922
	sum =  __intVal(self) + __intVal(aNumber);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3923
	if (!__ISVALIDINTEGER(sum)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3924
	    /* keep the sign */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3925
	    sum %= _MAX_INT;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3926
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3927
	RETURN ( __mkSmallInteger(sum));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3928
    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3929
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3930
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3931
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3932
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3933
	5 plus:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3934
	5 plus:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3935
	1 plus:-5
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3936
	self maxVal plus:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3937
	self maxVal + 1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3938
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3939
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3940
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3941
subtract:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3942
    "return the difference of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3943
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3944
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3945
     smallInteger range is returned (i.e. the low bits of the sum).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3946
     This is of course not always correct, but some code does a modulo anyway
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3947
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3948
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3949
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3950
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3951
    if (__isSmallInteger(aNumber)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3952
	INT diff;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3953
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3954
	diff = __intVal(self) - __intVal(aNumber);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3955
	if (!__ISVALIDINTEGER(diff)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3956
	    /* keep the sign */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3957
	    diff %= _MAX_INT;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3958
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3959
	RETURN ( __mkSmallInteger(diff));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3960
    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3961
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3962
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3963
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3964
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3965
	-1 subtract:5
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3966
	5 subtract:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3967
	1 subtract:-5
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3968
	self minVal subtract:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3969
	self minVal - 1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3970
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3971
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3972
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3973
times:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3974
    "return the product of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3975
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3976
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3977
     smallInteger range is returned (i.e. the low bits of the product).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3978
     This is of course not always correct, but some code does a modulo anyway
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3979
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3980
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3981
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3982
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3983
    INT myValue, otherValue;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3984
    unsigned INT productLow, productHi;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3985
    int negative;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3986
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3987
#   define low16Bits(foo)  ((foo) & 0xFFFF)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3988
#   define hi16Bits(foo)   ((foo) >> 16)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3989
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3990
#   define hi32Bits(foo)   ((foo) >> 32)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3991
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3992
    /*
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3993
     * can we use long long arithmetic ?
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3994
     *
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3995
     * long-long arithmetic seems to be buggy with some systems
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3996
     * (took me a while to find this out :-(
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3997
     * (try 10000 * 10000)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3998
     */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  3999
#if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4000
# define USE_LONGLONG_FOR_MUL
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4001
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4002
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4003
#if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4004
# define USE_LONGLONG_FOR_MUL
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4005
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4006
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4007
    if (__isSmallInteger(aNumber)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4008
	myValue = __intVal(self);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4009
	otherValue = __intVal(aNumber);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4010
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4011
#if defined(USE_LONGLONG_FOR_MUL)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4012
	{
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4013
# if defined(__alpha__) && !defined(__alpha64__)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4014
#  define LONGLONG      INT64
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4015
# else
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4016
#  define LONGLONG      long long
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4017
# endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4018
	    LONGLONG product;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4019
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4020
	    product = (LONGLONG)myValue * (LONGLONG)otherValue;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4021
	    if (product < 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4022
		RETURN ( __mkSmallInteger(-(INT)(-product & _MAX_INT)));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4023
	    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4024
	    RETURN ( __mkSmallInteger((INT)(product & _MAX_INT)));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4025
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4026
#else /* no long-long */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4027
	negative = 1;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4028
	if (myValue < 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4029
	    negative = -1;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4030
	    myValue = -myValue;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4031
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4032
	if (otherValue < 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4033
	    negative = -negative;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4034
	    otherValue = -otherValue;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4035
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4036
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4037
# if defined(__GNUC__) && defined(__mc68k__)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4038
	asm ("mulu%.l %3,%1:%0"
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4039
		: "=d"  ((unsigned long)(productLow)),
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4040
		  "=d"  ((unsigned long)(productHi))
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4041
		: "%0"  ((unsigned long)(myValue)),
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4042
		  "dmi" ((unsigned long)(otherValue)));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4043
# else
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4044
#  if defined (__GNUC__) && defined(__i386__)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4045
	asm ("mull %3"
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4046
		: "=a"  ((unsigned long)(productLow)),
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4047
		  "=d"  ((unsigned long)(productHi))
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4048
		: "%0"  ((unsigned long)(myValue)),
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4049
		  "rm"  ((unsigned long)(otherValue)));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4050
#  else
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4051
#   if defined(WIN32) && defined(__BORLANDC__)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4052
	asm {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4053
	    mov   eax, myValue
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4054
	    mov   edx, otherValue
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4055
	    mul   edx
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4056
	    mov   productLow, eax
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4057
	    mov   productHi, edx
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4058
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4059
#   else /* generic */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4060
	{
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4061
	    unsigned INT pHH, pHL, pLH, pLL;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4062
	    unsigned INT low1, low2, hi1, hi2;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4063
	    unsigned INT t;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4064
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4065
	    /* unsigned multiply myValue * otherValue -> productHi, productLow
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4066
	     *
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4067
	     * this is too slow:
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4068
	     * since most machines can do 32*32 to 64 bit multiply,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4069
	     * (or at least 32*32 with Overflow check)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4070
	     * - need more assembler (inline) functions here
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4071
	     */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4072
#    if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4073
	    low1 = low32Bits((unsigned INT)myValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4074
	    hi1 = hi32Bits((unsigned INT)myValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4075
	    low2 = low32Bits((unsigned INT)otherValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4076
	    hi2 = hi32Bits((unsigned INT)otherValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4077
#     define LLMASK 0xC000000000000000L
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4078
#    else
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4079
	    low1 = low16Bits((unsigned INT)myValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4080
	    hi1 = hi16Bits((unsigned INT)myValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4081
	    low2 = low16Bits((unsigned INT)otherValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4082
	    hi2 = hi16Bits((unsigned INT)otherValue);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4083
#     define LLMASK 0xC0000000
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4084
#    endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4085
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4086
	    pLH = low1 * hi2;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4087
	    pHL = hi1 * low2;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4088
	    pLL = low1 * low2;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4089
	    pHH = hi1 * hi2;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4090
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4091
	    /*
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4092
	     * the common case ...
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4093
	     */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4094
	    if ((pHL == 0)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4095
	     && (pLH == 0)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4096
	     && (pHH == 0)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4097
	     && ((pLL & LLMASK) == 0)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4098
		if (negative < 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4099
		    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4100
		}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4101
		RETURN ( __mkSmallInteger((INT)pLL) );
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4102
	    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4103
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4104
	    /*
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4105
	     *   pHH |--------|--------|
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4106
	     *   pLH          |--------|--------|
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4107
	     *   pHL          |--------|--------|
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4108
	     *   pLL                   |--------|--------|
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4109
	     */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4110
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4111
#    if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4112
	    t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4113
	    productLow = (t << 32) + low32Bits(pLL);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4114
	    productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4115
#    else
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4116
	    t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4117
	    productLow = (t << 16) + low16Bits(pLL);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4118
	    productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4119
#    endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4120
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4121
#   endif /* ! WIN32 */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4122
#  endif /* ! (__GNUC__ && __i386__) */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4123
# endif /* ! (__GNUC__ && __mc68k__) */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4124
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4125
	if (negative < 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4126
	    RETURN ( __mkSmallInteger(-(INT)(productLow & _MAX_INT)));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4127
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4128
	RETURN ( __mkSmallInteger((INT)(productLow & _MAX_INT)));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4129
#endif /* ! USE_LONGLONG */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4130
    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4131
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4132
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4133
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4134
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4135
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4136
	5 times:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4137
	5 times:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4138
	self maxVal-1 times:2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4139
	self maxVal-1 times:-2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4140
	self maxVal-1 * 2  bitAnd:16r3fffffff
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4141
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4142
! !
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4143
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4144
!SmallInteger methodsFor:'special modulo bit operators'!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4145
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4146
bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4147
    "return the value of the receiver with all bits inverted in 32bit signed int space
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4148
     (changes the sign)"
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4149
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4150
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4151
    unsigned INT v;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4152
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4153
    v = __intVal(self);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4154
    v = ~v;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4155
#if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4156
    v &= 0xFFFFFFFFL;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4157
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4158
    RETURN ( __MKUINT(v) );
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4159
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4160
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4161
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4162
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4163
     1 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4164
     16r40000000 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4165
     16r80000000 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4166
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4167
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4168
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4169
bitRotate32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4170
    "return the value of the receiver rotated by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4171
     but only within 32 bits, rotating left for positive, right for negative counts.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4172
     Rotates through the sign bit.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4173
     Useful for crypt algorithms, or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4174
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4175
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4176
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4177
    unsigned INT bits;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4178
    int count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4179
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4180
    if (__isSmallInteger(shiftCount)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4181
	count = __intVal(shiftCount);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4182
	count = count % 32;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4183
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4184
	bits = __intVal(self);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4185
	if (count > 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4186
	    bits = (bits << count) | (bits >> (32-count));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4187
	} else {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4188
	    bits = (bits >> (-count)) | (bits << (32-(-count)));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4189
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4190
#if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4191
	bits &= 0xFFFFFFFFL;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4192
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4193
	RETURN (__MKUINT(bits));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4194
    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4195
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4196
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4197
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4198
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4199
     128 rotate32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4200
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4201
     1 rotate32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4202
     1 rotate32:2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4203
     1 rotate32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4204
     1 rotate32:32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4205
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4206
     1 rotate32:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4207
     1 rotate32:-2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4208
     1 rotate32:-3
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4209
     1 rotate32:-32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4210
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4211
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4212
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4213
bitShift32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4214
    "return the value of the receiver shifted by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4215
     but only within 32 bits, shifting into/out-of the sign bit.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4216
     May be useful for communication interfaces, to create ST-numbers
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4217
     from a signed 32bit int value given as individual bytes,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4218
     or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4219
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4220
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4221
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4222
    INT bits, count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4223
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4224
    if (__isSmallInteger(shiftCount)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4225
	count = __intVal(shiftCount);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4226
	if (count >= 32) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4227
	    RETURN (__mkSmallInteger(0));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4228
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4229
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4230
	bits = __intVal(self);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4231
	if (count > 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4232
	    bits = bits << count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4233
	} else {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4234
	    bits = bits >> (-count);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4235
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4236
#if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4237
	bits &= 0xFFFFFFFFL;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4238
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4239
	RETURN (__MKINT(bits));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4240
    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4241
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4242
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4243
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4244
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4245
     128 bitShift:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4246
     128 bitShift32:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4247
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4248
     1 bitShift:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4249
     1 bitShift32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4250
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4251
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4252
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4253
bitXor32:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4254
    "return the xor of the receiver and the argument.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4255
     The argument must be another SmallInteger or a 4-byte LargeInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4256
     If the result overflows the 32 bit range, the value modulo 16rFFFFFFFF is returned.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4257
     This is of course not always correct, but allows for C/Java behavior to be emulated."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4258
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4259
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4260
    INT rslt;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4261
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4262
    rslt =  __unsignedLongIntVal(self) ^ __unsignedLongIntVal(aNumber);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4263
#if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4264
    rslt &= 0xFFFFFFFFL;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4265
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4266
    RETURN ( __MKUINT(rslt));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4267
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4268
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4269
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4270
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4271
     16r7FFFFFFF bitXor: 16r80000000          4294967295
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4272
     16r7FFFFFFF bitXor32: 16r80000000
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4273
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4274
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4275
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4276
unsignedBitShift32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4277
    "return the value of the receiver shifted by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4278
     but only within 32 unsigned bits.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4279
     May be useful for communication interfaces, to create ST-numbers
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4280
     from an unsigned 32bit int value given as individual byte,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4281
     or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4282
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4283
%{  /* NOCONTEXT */
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4284
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4285
    unsigned INT bits;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4286
    INT count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4287
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4288
    if (__isSmallInteger(shiftCount)) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4289
	count = __intVal(shiftCount);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4290
	if (count >= 32) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4291
	    RETURN (__mkSmallInteger(0));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4292
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4293
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4294
	bits = __intVal(self);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4295
	if (count > 0) {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4296
	    bits = bits << count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4297
	} else {
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4298
	    bits = bits >> (-count);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4299
	}
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4300
#if __POINTER_SIZE__ == 8
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4301
	bits &= 0xFFFFFFFFL;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4302
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4303
	RETURN (__MKUINT(bits));
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4304
    }
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4305
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4306
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4307
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4308
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4309
     128 unsignedBitShift:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4310
     128 unsignedBitShift32:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4311
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4312
     1 unsignedBitShift:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4313
     1 unsignedBitShift32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4314
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4315
     -1 unsignedBitShift32:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4316
     -1 unsignedBitShift32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4317
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4318
! !
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4319
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4320
!SmallInteger methodsFor:'testing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4321
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4322
between:min and:max
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4323
    "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
  4324
     and greater than or equal to the argument min.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4325
     - reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4326
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4327
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4328
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4329
    if (__bothSmallInteger(min, max)) {
15432
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4330
#if TAG_INT == 1
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4331
        // tag bit does not change the magnitude order
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4332
        if ((INT)self < (INT)(min)) {
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4333
             RETURN ( false );
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4334
        }
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4335
        if ((INT)self > (INT)(max)) {
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4336
             RETURN ( false );
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4337
        }
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4338
        RETURN ( true );
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4339
#else
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4340
        REGISTER INT selfVal;
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4341
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4342
        selfVal = __intVal(self);
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4343
        if (selfVal < __intVal(min)) {
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4344
             RETURN ( false );
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4345
        }
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4346
        if (selfVal > __intVal(max)) {
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4347
             RETURN ( false );
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4348
        }
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4349
        RETURN ( true );
53d85559eaf1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15325
diff changeset
  4350
#endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4351
    }
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4352
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4353
    (self < min) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4354
    (self > max) ifTrue:[^ false].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4355
    ^ true
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4356
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4357
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4358
even
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4359
    "return true, if the receiver is even"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4360
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4361
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4362
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4363
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4364
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4365
    ^ super even
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4366
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4367
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4368
isPowerOfTwo
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4369
    "return true, if the receiver is a power of 2"
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4370
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4371
"/ mhmh: how about the following
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4372
"/    self == 0 ifTrue:[^ false].
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4373
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4374
    ^ (self bitAnd:(self - 1)) == 0
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4375
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4376
    "
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4377
     0 isPowerOfTwo
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4378
     1 isPowerOfTwo
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4379
     2 isPowerOfTwo
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4380
     3 isPowerOfTwo
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4381
     4 isPowerOfTwo
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4382
     16r8000000000000000 isPowerOfTwo
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4383
     16r8000000000000001 isPowerOfTwo
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4384
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4385
     10000 factorial isPowerOfTwo
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4386
     |n| n := 10000 factorial. Time millisecondsToRun:[1000 timesRepeat:[ n isPowerOfTwo]]
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4387
    "
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4388
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4389
    "Modified: / 20-06-2011 / 12:41:18 / cg"
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4390
!
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  4391
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4392
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4393
    "return true, if the receiver is less than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4394
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4395
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4396
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4397
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4398
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4399
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4400
    RETURN ( ((INT)(self) < 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4401
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4402
    RETURN ( (__intVal(self) < 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4403
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4404
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4405
    ^ self < 0
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4406
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4407
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4408
nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4409
    "return the power of 2 at or above the receiver.
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4410
     Useful for padding."
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4411
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4412
%{  /* NOCONTEXT */
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4413
    INT x;
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4414
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4415
    x = __intVal(self) - 1;
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4416
    x |= (x >> 1);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4417
    x |= (x >> 2);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4418
    x |= (x >> 4);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4419
    x |= (x >> 8);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4420
    x |= (x >> 16);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4421
#if __POINTER_SIZE__ == 8
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4422
    x |= (x >> 32);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4423
#endif
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4424
    RETURN (__MKINT(x + 1));
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4425
%}
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4426
    "
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4427
     1 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4428
     2 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4429
     3 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4430
     4 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4431
     5 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4432
     6 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4433
     7 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4434
     8 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4435
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4436
     22 nextPowerOf2
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4437
     10 factorial nextPowerOf2 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4438
     20 factorial nextPowerOf2 
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4439
     100 factorial nextPowerOf2 
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4440
    "
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4441
!
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  4442
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4443
odd
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4444
    "return true, if the receiver is odd"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4445
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4446
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4447
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4448
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4449
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4450
    ^ super odd
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4451
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4452
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4453
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4454
parityOdd
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4455
    "return true, if an odd number of bits are set in the receiver, false otherwise.
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4456
     (i.e. true for odd parity)
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4457
     Undefined for negative values (smalltalk does not require the machine to use 2's complement)"
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4458
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4459
%{  /* NOCONTEXT */
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4460
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4461
    // tricky, but very fast (google for it, to understand)
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4462
#if __POINTER_SIZE__ == 4
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4463
    unsigned int v = __intVal(self);
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4464
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4465
    v ^= v >> 16;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4466
    v ^= v >> 8;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4467
    v ^= v >> 4;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4468
    v &= 0xf;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4469
    RETURN ( ( (0x6996 >> v) & 1 ) ? true : false );
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4470
#endif
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4471
%}.
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4472
    ^ super parityOdd
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4473
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4474
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4475
	self assert:
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4476
	 (((0 to:255) collect:[:i | i parityOdd ifTrue:1 ifFalse:0])
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4477
	    asByteArray collect:[:c | c + $0 asciiValue]) asString
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4478
	 =
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4479
	    '0110100110010110100101100110100110010110011010010110100110010110100101100110100101101001100101100110100110010110100101100110100110010110011010010110100110010110011010011001011010010110011010010110100110010110100101100110100110010110011010010110100110010110'
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4480
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4481
	self assert:(16r0FFFFFFF parityOdd = 16r0FFFFFFF bitCount odd).
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4482
	self assert:(16r1FFFFFFF parityOdd = 16r1FFFFFFF bitCount odd).
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4483
	self assert:(16r3FFFFFFF parityOdd = 16r3FFFFFFF bitCount odd).
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4484
	self assert:(16r7FFFFFFF parityOdd = 16r7FFFFFFF bitCount odd).
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4485
	self assert:(16rFFFFFFFF parityOdd = 16rFFFFFFFF bitCount odd).
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4486
    "
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4487
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4488
    "Modified (comment): / 09-01-2012 / 19:55:37 / cg"
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4489
!
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  4490
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4491
positive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4492
    "return true, if the receiver is not negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4493
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4494
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4495
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4496
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4497
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4498
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4499
    RETURN ( ((INT)(self) >= 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4500
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4501
    RETURN ( (__intVal(self) >= 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4502
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4503
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4504
    ^ super positive
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4505
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4506
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4507
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4508
sign
7471
c5d4bd612d9f comments
Claus Gittinger <cg@exept.de>
parents: 7438
diff changeset
  4509
    "return the sign of the receiver (-1, 0 or 1).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4510
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4511
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4512
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4513
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  4514
    INT val = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4515
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4516
    if (val < 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  4517
	RETURN ( __mkSmallInteger(-1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4518
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4519
    if (val > 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  4520
	RETURN ( __mkSmallInteger(1) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4521
    }
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  4522
    RETURN ( __mkSmallInteger(0) );
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4523
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4524
    ^ super sign
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4525
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4526
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4527
strictlyPositive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4528
    "return true, if the receiver is greater than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4529
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4530
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4531
%{  /* NOCONTEXT */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4532
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4533
#if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4534
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4535
    RETURN ( ((INT)(self) > 0) ? true : false );
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4536
#else
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4537
    RETURN ( (__intVal(self) > 0) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4538
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4539
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  4540
    ^ super strictlyPositive
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4541
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4542
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4543
!SmallInteger class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4544
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4545
version
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4546
    ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.225 2014-11-11 14:24:34 cg Exp $'
12482
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  4547
!
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  4548
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  4549
version_CVS
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4550
    ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.225 2014-11-11 14:24:34 cg Exp $'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4551
! !
14755
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
  4552
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4553
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4554
SmallInteger initialize!