SmallInteger.st
author Stefan Vogel <sv@exept.de>
Thu, 16 Apr 2020 16:57:05 +0200
changeset 25362 f1606835f9fb
parent 25214 2faf844125d9
permissions -rw-r--r--
#TUNING by stefan class: Win32OperatingSystem class changed: #getProcessId cache my own process id
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
     1
"{ Encoding: utf8 }"
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
     2
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     3
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     4
 COPYRIGHT (c) 1988 by Claus Gittinger
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
     5
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
"
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    14
"{ Package: 'stx:libbasic' }"
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    15
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
    16
"{ NameSpace: Smalltalk }"
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
    17
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
Integer subclass:#SmallInteger
20819
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    19
	instanceVariableNames:''
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    20
	classVariableNames:'ZeroString'
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    21
	poolDictionaries:''
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    22
	category:'Magnitude-Numbers'
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
    23
!
14755
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    24
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    25
!SmallInteger class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    26
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    27
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    28
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
 COPYRIGHT (c) 1988 by Claus Gittinger
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    30
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    41
documentation
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    42
"
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    43
    SmallIntegers are Integers in the range of at least +/- 2^30
19318
Claus Gittinger <cg@exept.de>
parents: 19317
diff changeset
    44
    i.e. 31 bits, but this is not a guaranteed:
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    45
	on an alpha or x86_64, 63 bits are used, if the system was configured for 64bit mode.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    46
	under the Schteam-VM, 64 bits are used (i.e. a full long integer)
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    47
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    48
    These are no real objects - they have no instances (not even storage !!)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    49
    and cannot be subclassed.
21155
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    50
    The reason is to save both storage and runtime by not boxing and
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    51
    garbage collecting SmallIntegers in the system.
21155
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    52
    SmallInts are marked by having the TAG_INT
8908
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
21155
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    61
    Because the range and sharing of SmallIntegers is different among implementations
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    62
    (both in different dialects, and in different architectures within the Smalltalk/X family),
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    63
    you should not depend on the identity of two integers with the same value.
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    64
    For portable code, when comparing integers, use #'=' and #'~=' (instead of #'==' / #'~~'),
21155
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    65
    unless you are comparing very small integers in the -1024 .. 0 .. 1024 range.
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    66
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    67
    [author:]
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    68
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    69
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    70
    [see also:]
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    71
	Number
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    72
	Float Fraction FixedPoint
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
    73
	LargeInteger
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    74
"
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    75
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    77
!SmallInteger class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    82
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
basicNew:size
a27a279701f8 Initial revision
claus
parents:
diff changeset
    87
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    88
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
a27a279701f8 Initial revision
claus
parents:
diff changeset
    90
    self error:'instances of SmallInteger cannot be created with new'
23476
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    91
!
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    92
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    93
fastFromString:aString at:startIndex
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    94
    "return the next SmallInteger from the string starting at startIndex.
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    95
     No spaces are skipped.
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    96
     Raises an error, if the index is out of bounds,
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    97
     Returns garbage if the argument string is not a valid integer.
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    98
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
    99
     This is a specially tuned entry (using a low-level C-call to atol).
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   100
     It has been added to allow high speed string decomposition into 
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   101
     numbers, especially for mass-data (reading millions of numbers)."
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   102
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   103
%{   /* NOCONTEXT */
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   104
     if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   105
        char *cp = (char *)(__stringVal(aString));
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   106
        int idx = __intVal(startIndex) - 1;
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   107
        long atol(const char *);
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   108
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   109
        if ((unsigned)idx < __stringSize(aString)) {
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   110
            long val = atol(cp + idx);
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   111
            RETURN (__MKINT(val));
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   112
        }
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   113
     }
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   114
%}.
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   115
     self primitiveFailed.
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   116
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   117
    "
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   118
     SmallInteger fastFromString:'hello12345' at:6
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   119
     SmallInteger fastFromString:'12345' at:1
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   120
     SmallInteger fastFromString:'12345' at:2
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   121
     SmallInteger fastFromString:'12345' at:3
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   122
     SmallInteger fastFromString:'12345' at:4
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   123
     SmallInteger fastFromString:'12345' at:5
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   124
     SmallInteger fastFromString:'12345' at:6
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   125
     SmallInteger fastFromString:'12345' at:0
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   126
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   127
     Time millisecondsToRun:[
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   128
        1000000 timesRepeat:[
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   129
            SmallInteger readFrom:'12345'
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   130
        ]
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   131
     ]
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   132
    "
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   133
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   134
    "
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   135
     Time millisecondsToRun:[
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   136
        1000000 timesRepeat:[
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   137
            SmallInteger fastFromString:'12345' at:1
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   138
        ]
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   139
     ]
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   140
    "
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   141
93b798639100 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23357
diff changeset
   142
    "Created: / 27-10-2018 / 08:52:32 / Claus Gittinger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   143
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   145
!SmallInteger class methodsFor:'bit mask constants'!
701
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
bitMaskFor:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   148
    "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
   149
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   150
    (index between:1 and:SmallInteger maxBits) ifFalse:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   151
	^ SubscriptOutOfBoundsSignal
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   152
		raiseRequestWith:index
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   153
		errorString:'index out of bounds'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   154
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   155
    ^ 1 bitShift:(index - 1)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   156
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   157
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   158
!SmallInteger class methodsFor:'class initialization'!
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   159
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   160
initialize
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   161
    ZeroString := '0'
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   162
! !
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   163
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   164
!SmallInteger class methodsFor:'constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   165
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
maxBits
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   167
    "return the number of bits in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   168
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   171
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   172
    // longs are always 64bits
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   173
    return context._RETURN ( STInteger._new(64) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   174
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   175
    RETURN ( __mkSmallInteger(N_INT_BITS) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   176
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   177
%}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   178
    "
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   179
     SmallInteger maxBits
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   180
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   182
a27a279701f8 Initial revision
claus
parents:
diff changeset
   183
maxBytes
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   184
    "return the number of bytes in instances of me.
19486
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   185
     For very special uses only - not constant across implementations.
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   186
     Notice: this is inlined by the compiler(s) as a constant,
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   187
     therefore, a query like 'SmallInteger maxBytes == 8'
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   188
     costs nothing; it is compiled in as a constant."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   189
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   191
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   192
    // longs are always 8 bytes
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   193
    return context._RETURN ( STInteger._new(8) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   194
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   195
    RETURN ( __mkSmallInteger(N_INT_BITS / 8 + 1) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   196
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   197
%}
3684
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   198
    "
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   199
     SmallInteger maxBytes
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   200
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   202
a27a279701f8 Initial revision
claus
parents:
diff changeset
   203
maxVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   204
    "return the largest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   205
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   206
a27a279701f8 Initial revision
claus
parents:
diff changeset
   207
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   208
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   209
    return context._RETURN ( STInteger._MAX_INTVAL );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   210
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   211
    RETURN ( __mkSmallInteger(_MAX_INT) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   212
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   213
%}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   214
    "
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   215
     SmallInteger maxVal
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   216
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   217
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   218
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   219
minVal
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   220
    "return the smallest Integer representable as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   221
     For very special uses only - not constant across implementations"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   222
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   223
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   224
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   225
    return context._RETURN ( STInteger._MIN_INTVAL );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   226
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   227
    RETURN ( __mkSmallInteger(_MIN_INT) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   228
#endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   229
%}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   230
    "
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   231
     SmallInteger minVal
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   232
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   234
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   235
!SmallInteger class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   236
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   237
canBeSubclassed
21444
1fc538e9d70e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21155
diff changeset
   238
    "return true, if it's allowed to create subclasses of the receiver.
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   239
     Return false here - since it is NOT possible for SmallInteger
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   240
     (due to the tagged representation of SmallIntegers)"
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   241
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   242
    ^ false
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   243
21444
1fc538e9d70e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21155
diff changeset
   244
    "Modified: / 05-11-1998 / 16:11:27 / cg"
1fc538e9d70e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21155
diff changeset
   245
    "Modified (comment): / 13-02-2017 / 20:30:46 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   246
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   247
2672
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   248
hasImmediateInstances
4661
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   249
    "return true if this class has immediate instances
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   250
     i.e. if the instances are represented in the pointer itself and
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   251
     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
   252
     Redefined from Behavior"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   253
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   254
    ^ true
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   255
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   256
    "Created: 3.6.1997 / 12:01:26 / cg"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   257
!
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   258
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   259
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   260
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   261
     Here, true is returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   262
a27a279701f8 Initial revision
claus
parents:
diff changeset
   263
    ^ true
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   265
    "Modified: 23.4.1996 / 16:00:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   266
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   267
a27a279701f8 Initial revision
claus
parents:
diff changeset
   268
!SmallInteger methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   269
a27a279701f8 Initial revision
claus
parents:
diff changeset
   270
* aNumber
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   271
    "return the product of the receiver and the argument"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   272
a27a279701f8 Initial revision
claus
parents:
diff changeset
   273
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   274
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   275
    return context._RETURN( self.times( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   276
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   277
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   278
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   279
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   280
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   281
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   282
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   283
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   284
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   285
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   286
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   287
    INT myValue, otherValue;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   288
    unsigned INT productLow, productHi;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   289
    int negative;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   290
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   291
    myValue = __intVal(self);
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   292
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   293
#   define low16Bits(foo)  ((foo) & 0xFFFF)
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   294
#   define hi16Bits(foo)   ((foo) >> 16)
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   295
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   296
#   define hi32Bits(foo)   ((foo) >> 32)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   297
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   298
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   299
     * can we use long long arithmetic ?
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   300
     *
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   301
     * long-long arithmetic seems to be buggy with some systems
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   302
     * (took me a while to find this out :-(
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   303
     * (try 10000 * 10000)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   304
     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   305
# if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   306
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   307
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   308
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   309
# if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   310
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   311
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   312
252
   313
    if (__isSmallInteger(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   314
	otherValue = __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   315
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   316
# if defined(USE_LONGLONG_FOR_MUL)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   317
	{
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   318
#  if defined(__alpha__) && !defined(__alpha64__)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   319
#   define LONGLONG      INT64
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   320
#  else
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   321
#   define LONGLONG      long long
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   322
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   323
	    LONGLONG product;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   324
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   325
	    product = (LONGLONG)myValue * (LONGLONG)otherValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   326
	    if ((product >= (LONGLONG)_MIN_INT)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   327
	     && (product <= (LONGLONG)_MAX_INT)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   328
		RETURN ( __mkSmallInteger((INT)product) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   329
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   330
	    if (product < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   331
		negative = -1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   332
		product = -product;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   333
	    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   334
		negative = 1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   335
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   336
	    productHi = product >> 32;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   337
	    productLow = product & 0xFFFFFFFFLL;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   338
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   339
# else /* no long-long */
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   340
	negative = 1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   341
	if (myValue < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   342
	    negative = -1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   343
	    myValue = -myValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   344
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   345
	if (otherValue < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   346
	    negative = -negative;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   347
	    otherValue = -otherValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   348
	}
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   349
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   350
#  if defined(__GNUC__) && defined(__mc68k__)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   351
	asm ("mulu%.l %3,%1:%0"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   352
		: "=d"  ((unsigned long)(productLow)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   353
		  "=d"  ((unsigned long)(productHi))
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   354
		: "%0"  ((unsigned long)(myValue)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   355
		  "dmi" ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   356
#  else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   357
#   if defined (__GNUC__) && defined(__x86__)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   358
	asm ("mull %3"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   359
		: "=a"  ((unsigned long)(productLow)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   360
		  "=d"  ((unsigned long)(productHi))
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   361
		: "%0"  ((unsigned long)(myValue)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   362
		  "rm"  ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   363
#   else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   364
#    if defined(__win32__) && defined(__BORLANDC__)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   365
	asm {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   366
	    mov   eax, myValue
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   367
	    mov   edx, otherValue
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   368
	    mul   edx
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   369
	    mov   productLow, eax
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   370
	    mov   productHi, edx
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   371
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   372
#    else /* generic */
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   373
	{
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   374
	    unsigned INT pHH, pHL, pLH, pLL;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   375
	    unsigned INT low1, low2, hi1, hi2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   376
	    unsigned INT t;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   377
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   378
	    /* unsigned multiply myValue * otherValue -> productHi, productLow
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   379
	     *
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   380
	     * this is too slow:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   381
	     * since most machines can do 32*32 to 64 bit multiply,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   382
	     * (or at least 32*32 with Overflow check)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   383
	     * - need more assembler (inline) functions here
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   384
	     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   385
#     if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   386
	    low1 = low32Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   387
	    hi1 = hi32Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   388
	    low2 = low32Bits((unsigned INT)otherValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   389
	    hi2 = hi32Bits((unsigned INT)otherValue);
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
   390
#      define LLMASK 0xC000000000000000LL
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   391
#     else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   392
	    low1 = low16Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   393
	    hi1 = hi16Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   394
	    low2 = low16Bits((unsigned INT)otherValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   395
	    hi2 = hi16Bits((unsigned INT)otherValue);
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
   396
#      define LLMASK 0xC0000000L
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   397
#     endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   398
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   399
	    pLH = low1 * hi2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   400
	    pHL = hi1 * low2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   401
	    pLL = low1 * low2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   402
	    pHH = hi1 * hi2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   403
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   404
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   405
	     * the common case ...
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   406
	     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   407
	    if ((pHL == 0)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   408
	     && (pLH == 0)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   409
	     && (pHH == 0)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   410
	     && ((pLL & LLMASK) == 0)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   411
		if (negative < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   412
		    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   413
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   414
		RETURN ( __mkSmallInteger((INT)pLL) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   415
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   416
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   417
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   418
	     *   pHH |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   419
	     *   pLH          |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   420
	     *   pHL          |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   421
	     *   pLL                   |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   422
	     */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   423
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   424
#     if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   425
	    t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   426
	    productLow = (t << 32) + low32Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   427
	    productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   428
#     else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   429
	    t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   430
	    productLow = (t << 16) + low16Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   431
	    productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   432
#     endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   433
	}
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   434
#    endif /* ! __win32__ */
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   435
#   endif /* ! (__GNUC__ && __x86__) */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   436
#  endif /* ! (__GNUC__ && __mc68k__) */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   437
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   438
	if (productHi == 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   439
	    if (negative < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   440
		if (productLow <= -(_MIN_INT)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   441
		    RETURN ( __mkSmallInteger(-((INT)productLow)) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   442
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   443
	    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   444
		if (productLow <= _MAX_INT) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   445
		    RETURN ( __mkSmallInteger(productLow) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   446
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   447
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   448
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   449
# endif /* ! USE_LONGLONG */
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   450
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   451
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   452
	RETURN (__MKLARGEINT128(negative, productLow, productHi));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   453
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   454
	RETURN (__MKLARGEINT64(negative, productLow, productHi));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   455
# endif
283
a897d331b4c1 *** empty log message ***
claus
parents: 282
diff changeset
   456
    } else if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   457
	OBJ newFloat;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   458
	double val = (double)myValue * __floatVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   459
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   460
	__qMKFLOAT(newFloat, val);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   461
	RETURN ( newFloat );
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   462
    } else if (__isShortFloat(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   463
	OBJ newFloat;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   464
	float val = (float)myValue * __shortFloatVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   465
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   466
	__qMKSFLOAT(newFloat, val);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   467
	RETURN ( newFloat );
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   468
    } else if (__isFractionLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   469
	OBJ t = __FractionInstPtr(aNumber)->f_numerator;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   470
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   471
	if (myValue == 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   472
	    RETURN(__mkSmallInteger(0));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   473
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   474
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   475
	if (__isSmallInteger(t)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   476
	    INT num = __intVal(t);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   477
	    t = __FractionInstPtr(aNumber)->f_denominator;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   478
	    if (__isSmallInteger(t)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   479
		INT prod = myValue * num;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   480
		if (prod / myValue == num) { // check for overflow
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   481
		    INT den = __intVal(t);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   482
		    INT quo = prod / den;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   483
		    if (quo * den == prod) {        // check for integer result
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   484
			RETURN ( __mkSmallInteger(quo) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   485
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   486
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   487
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   488
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   489
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   490
#endif /* not __SCHTEAM__ */
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
   491
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   492
    ^ aNumber productFromInteger:self
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   493
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   494
    "
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   495
	3 * (1/2)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   496
	6 * (1/2)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   497
	6 * (-1/2)
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   498
   "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   499
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   500
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   501
+ aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   502
    "return the sum of the receiver's value and the argument's value"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   503
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   504
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   505
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   506
    return context._RETURN( self.plus( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   507
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   508
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   509
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   510
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   511
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   512
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   513
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   514
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   515
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   516
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   517
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   518
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   519
# ifdef _ADD_IO_IO
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   520
	RETURN ( _ADD_IO_IO(self, aNumber) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   521
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   522
	REGISTER INT sum;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   523
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   524
	sum =  __intVal(self) + __intVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   525
	if (__ISVALIDINTEGER(sum)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   526
	    RETURN ( __mkSmallInteger(sum) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   527
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   528
	RETURN ( __MKLARGEINT(sum) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   529
# endif
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   530
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   531
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   532
	OBJ newFloat;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   533
	double val = (double)__intVal(self) + __floatVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   534
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   535
	__qMKFLOAT(newFloat, val);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   536
	RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   537
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   538
    if (__isShortFloat(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   539
	OBJ newFloat;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   540
	float val = (float)__intVal(self) + __shortFloatVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   541
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   542
	__qMKSFLOAT(newFloat, val);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   543
	RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   544
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   545
#endif /* not __SCHTEAM__ */
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   546
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   547
    ^ aNumber sumFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   548
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   549
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   550
- aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   551
    "return the difference of the receiver's value and the argument's value"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   552
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   553
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   554
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   555
    return context._RETURN( self.minus( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   556
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   557
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   558
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   559
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   560
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   561
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   562
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   563
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   564
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   565
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   566
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   567
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   568
# ifdef _SUB_IO_IO
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   569
	RETURN ( _SUB_IO_IO(self, aNumber) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   570
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   571
	REGISTER INT diff =  __intVal(self) - __intVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   572
	if (__ISVALIDINTEGER(diff)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   573
	    RETURN ( __mkSmallInteger(diff) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   574
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   575
	RETURN ( __MKLARGEINT(diff) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   576
# endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   577
    }
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   578
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   579
	OBJ newFloat;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   580
	double val = (double)__intVal(self) - __floatVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   581
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   582
	__qMKFLOAT(newFloat, val);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   583
	RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   584
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   585
    if (__isShortFloat(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   586
	OBJ newFloat;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   587
	float val = (float)__intVal(self) - __shortFloatVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   588
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   589
	__qMKSFLOAT(newFloat, val);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   590
	RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   591
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   592
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   593
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   594
    ^ aNumber differenceFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   595
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   596
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   597
/ aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   598
    "return the quotient of the receiver's value and the argument's value"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   599
a27a279701f8 Initial revision
claus
parents:
diff changeset
   600
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   601
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   602
    return context._RETURN( self.quotient( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   603
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   604
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   605
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   606
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   607
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   608
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   609
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   610
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   611
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   612
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   613
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   614
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   615
    INT t, val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   616
    double dval;
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   617
    INT myValue = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   618
252
   619
    if (__isSmallInteger(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   620
	val = __intVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   621
	if (val != 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   622
	    t = myValue / val;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   623
# ifdef GOOD_OPTIMIZER
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   624
	    if (myValue % val == 0) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   625
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   626
	    /* this is stupid - all I want is to look for a remainder ...
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   627
	       but most compilers are too stupid and generate an extra modulus
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   628
	       instruction for "if (me % val)".
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   629
	       Even if most divide instructions already leave the remainder in
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   630
	       some register.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   631
	       Therefore I use a multiplication which is faster than a modulo
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   632
	       on most machines. Hint to GNU people :-)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   633
	    */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   634
	    if ((t * val) == myValue) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   635
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   636
		RETURN ( __mkSmallInteger(t) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   637
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   638
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   639
    } else {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   640
	if (__isFloatLike(aNumber)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   641
	    dval = __floatVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   642
	    if (dval != 0.0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   643
		OBJ newFloat;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   644
		double val = (double)myValue / dval;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   645
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   646
		__qMKFLOAT(newFloat, val);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   647
		RETURN ( newFloat );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   648
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   649
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   650
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   651
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   652
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   653
    aNumber isInteger ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   654
	aNumber == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   655
	    ^ ZeroDivide raiseRequestWith:thisContext.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   656
	].
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   657
	^ Fraction numerator:self denominator:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   658
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   659
    ^ aNumber quotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   660
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   661
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   662
     8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   663
     9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   664
     9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   665
     9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   666
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   667
     -8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   668
     -9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   669
     -9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   670
     -9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   671
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   672
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   673
2
claus
parents: 1
diff changeset
   674
// aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   675
    "return the integer part of the quotient of the receiver's value
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   676
     and the argument's value.
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   677
     The result is truncated toward negative infinity
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   678
     and will be negative, if the operands signs differ.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   679
     The following is always true:
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   680
	(receiver // aNumber) * aNumber + (receiver \\ aNumber) = receiver
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   681
14795
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   682
     Be careful with negative results: 9 // 4 -> 2, while -9 // 4 -> -3.
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   683
     Especially surprising (because of truncation toward negative infinity):
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   684
	-1 // 10 -> -1 (because -(1/10) is truncated towards next smaller integer, which is -1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   685
	-10 // 3 -> -4 (because -(10/3) is truncated towards next smaller integer, which is -4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   686
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   687
     See #quo: which truncates toward zero and returns -2 in the above case
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   688
     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
   689
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   690
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   691
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   692
    return context._RETURN( self.quotientTruncated( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   693
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   694
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   695
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   696
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   697
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   698
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   699
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   700
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   701
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   702
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   703
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   704
    INT divisor, rslt;
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   705
    INT dividend = __intVal(self);
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   706
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   707
    if (__isSmallInteger(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   708
	divisor = __intVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   709
	if (divisor != 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   710
	    rslt = dividend / divisor;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   711
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   712
	     * Optimized to speed up positive result
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   713
	     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   714
	    if (rslt <= 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   715
		if (rslt == 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   716
		    if ((dividend ^ divisor) < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   717
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   718
			 * result (negative) has been truncated toward 0.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   719
			 * Return -1, because we truncate toward negative inf.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   720
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   721
			 rslt = -1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   722
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   723
		} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   724
		    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   725
		     * If result (negative) has been truncated toward 0,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   726
		     * subtract 1, because we truncate toward negative inf.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   727
		     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   728
		    if (divisor > 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   729
			if (rslt * divisor > dividend) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   730
			    rslt--;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   731
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   732
		    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   733
			if (rslt * divisor < dividend) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   734
			    rslt--;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   735
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   736
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   737
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   738
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   739
	    RETURN ( __mkSmallInteger(rslt) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   740
	}
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   741
    } else {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   742
	if (__isFractionLike(aNumber)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   743
	    OBJ t = __FractionInstPtr(aNumber)->f_numerator;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   744
	    if (__isSmallInteger(t)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   745
		INT num = __intVal(t);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   746
		t = __FractionInstPtr(aNumber)->f_denominator;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   747
		if (__isSmallInteger(t)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   748
		    INT den = __intVal(t);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   749
		    INT prod;
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   750
#if 0 && defined(__GNUC__) // supported from GCC 5
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   751
		    if (!__builtin_mul_overflow(myself, den, &prod)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   752
			goto out;   // overflow, try harder...
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   753
		    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   754
#else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   755
		    prod = dividend * den;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   756
		    // make sure, that no overflow occurred
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   757
		    if (prod / den != dividend) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   758
			goto out;   // overflow, try harder...
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   759
		    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   760
#endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   761
		    rslt = prod / num;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   762
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   763
		    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   764
		     * Optimized to speed up positive result
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   765
		     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   766
		    if (rslt <= 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   767
			if (rslt == 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   768
			    if ((dividend ^ num) < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   769
				/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   770
				 * result (negative) has been truncated toward 0.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   771
				 * Return -1, because we truncate toward negative inf.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   772
				 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   773
				 rslt = -1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   774
			    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   775
			} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   776
			    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   777
			     * If result (negative) has been truncated toward 0,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   778
			     * subtract 1, because we truncate toward negative inf.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   779
			     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   780
			    if (num > 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   781
				if (rslt * num > prod) rslt--;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   782
			    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   783
				if (rslt * num < prod) rslt--;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   784
			    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   785
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   786
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   787
		    RETURN ( __mkSmallInteger(rslt) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   788
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   789
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   790
	}
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   791
    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   792
out:;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   793
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   794
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   795
    (aNumber = 0) ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   796
	^ ZeroDivide raiseRequestWith:thisContext.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   797
    ].
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   798
    ^ aNumber integerQuotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   799
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   800
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   801
     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
   802
     -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
   803
     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
   804
     -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
   805
     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
   806
     -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
   807
     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
   808
     -1 // -2   ~~ 0 ifTrue:[self halt].
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   809
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   810
     -7 // (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   811
     -7 quo: (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   812
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   813
     7 // (-4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   814
     7 quo: (-4/3)
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   815
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   816
     10000 // 3600000 ~~ 0 ifTrue:[self halt].
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   817
     12 // (1 / 1000000000000000000)
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   818
     12 // (1 / 100000000000000)
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   819
     12 // 0.00000000000001s
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   820
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   821
     9 quo:4   => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   822
     -9 quo:4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   823
     9 quo:-4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   824
     -9 quo:-4 => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   825
    "
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   826
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   827
    "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
   828
!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   829
2
claus
parents: 1
diff changeset
   830
\\ aNumber
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   831
    "Answer the integer remainder m defined by division with truncation toward
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   832
     negative infinity.
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   833
     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
   834
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   835
     The returned remainder has the same sign as aNumber.
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   836
     The following is always true:
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   837
	(receiver // aNumber) * aNumber + (receiver \\ aNumber) = receiver
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   838
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   839
     Be careful with negative results: 9 // 4 -> 2, while -9 // 4 -> -3.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   840
     Especially surprising:
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   841
	-1 \\ 10 -> 9  (because -(1/10) is truncated towards next smaller integer, which is -1,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   842
			and -1 multiplied by 10 gives -10, so we have to add 9 to get the original -1).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   843
	-10 \\ 3 -> 2 (because -(10/3) is truncated towards next smaller integer, which is -4,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   844
			and -4 * 4 gives -12, so we need to add 2 to get the original -10.
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   845
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   846
     See #rem: which is the corresponding remainder for division via #quo:.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   847
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   848
     Redefined here for speed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   849
a27a279701f8 Initial revision
claus
parents:
diff changeset
   850
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   851
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   852
    return context._RETURN( self.remainder( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   853
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   854
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   855
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   856
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   857
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   858
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   859
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   860
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   861
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   862
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   863
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   864
    INT dividend, divisor, rem;
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   865
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   866
    if (__isSmallInteger(aNumber)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   867
	&& (divisor = __intVal(aNumber)) != 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   868
	/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   869
	 * Note that the sign of something modulo a negative number is undefined
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   870
	 * in C!
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   871
	 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   872
	dividend = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   873
	rem = dividend % divisor;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   874
	if (rem) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   875
	    if ((rem ^ divisor) < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   876
		/* sign of remainder is different from sign of divisor */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   877
		rem = -rem;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   878
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   879
	    if ((dividend ^ divisor) < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   880
		/* different signs, so division would have returned a
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   881
		 * negative number.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   882
		 * C rounds toward zero, this code will simulate
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   883
		 * rounding towards negative infinity.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   884
		 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   885
		rem = divisor - rem;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   886
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   887
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   888
	RETURN ( __mkSmallInteger(rem) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   889
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   890
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   891
%}.
2
claus
parents: 1
diff changeset
   892
    (aNumber = 0) ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   893
	^ ZeroDivide raiseRequestWith:thisContext.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   894
    ].
14003
727df70aa9f5 changed: #\\
Claus Gittinger <cg@exept.de>
parents: 13991
diff changeset
   895
    ^ aNumber moduloFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   896
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   897
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   898
     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
   899
     -9 \\ 4 == 3 ifFalse:[self halt].
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   900
     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
   901
     -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
   902
     (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
   903
     (-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
   904
     1000 \\ 3600000 == 1000 ifFalse:[self halt]
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   905
    "
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   906
14003
727df70aa9f5 changed: #\\
Claus Gittinger <cg@exept.de>
parents: 13991
diff changeset
   907
    "Modified: / 12-02-2012 / 20:43:40 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   908
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   909
a27a279701f8 Initial revision
claus
parents:
diff changeset
   910
abs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   911
    "return the absolute value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   912
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   913
a27a279701f8 Initial revision
claus
parents:
diff changeset
   914
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   915
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   916
    return context._RETURN( self.abs());
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   917
#else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   918
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   919
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   920
    if (val >= 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   921
	RETURN (self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   922
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   923
    if (val != _MIN_INT) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   924
	RETURN ( __mkSmallInteger(-val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   925
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   926
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   927
    RETURN( __MKLARGEINT(-_MIN_INT));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   928
#endif
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   929
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   930
    ^ super abs
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   931
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   932
a27a279701f8 Initial revision
claus
parents:
diff changeset
   933
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   934
    "return the negative value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   935
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   936
a27a279701f8 Initial revision
claus
parents:
diff changeset
   937
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   938
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   939
    return context._RETURN( self.negated());
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   940
#else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   941
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   942
a27a279701f8 Initial revision
claus
parents:
diff changeset
   943
    if (val != _MIN_INT) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   944
	RETURN ( __mkSmallInteger(- val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   945
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   946
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   947
    RETURN (__MKLARGEINT( -_MIN_INT));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   948
#endif
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   949
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   950
    ^ 0 - self
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   951
!
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   952
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   953
quo:aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   954
    "return the integer part of the quotient of the receiver's value
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   955
     and the argument's value. The result is truncated towards zero
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   956
     and negative, if the operands signs differ..
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   957
     The following is always true:
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   958
	(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
   959
     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
   960
     for negative results, the remainder is ignored.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   961
     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
   962
     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
   963
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   964
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   965
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   966
    return context._RETURN( self.quotient(aNumber));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   967
#else
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   968
    if (__isSmallInteger(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   969
	INT val = __intVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   970
	if (val != 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   971
	    RETURN ( __mkSmallInteger(__intVal(self) / val) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   972
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   973
    } else {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   974
	if (__isFractionLike(aNumber)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   975
	    OBJ t = __FractionInstPtr(aNumber)->f_numerator;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   976
	    if (__isSmallInteger(t)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   977
		INT num = __intVal(t);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   978
		t = __FractionInstPtr(aNumber)->f_denominator;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   979
		if (__isSmallInteger(t)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   980
		    INT den = __intVal(t);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   981
		    INT myself = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   982
		    INT prod;
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   983
#if 0 && defined(__GNUC__) // supported from GCC 5
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   984
		    if (__builtin_mul_overflow(myself, den, &prod)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   985
			RETURN ( __mkSmallInteger(prod / num ));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   986
		    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   987
#else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   988
		    prod = myself * den;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   989
		    // make sure, that no overflow occurred
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   990
		    if (prod / den == myself) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   991
			RETURN ( __mkSmallInteger(prod / num ));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   992
		    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   993
#endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   994
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   995
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
   996
	}
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   997
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   998
#endif /* not __SCHTEAM__ */
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   999
%}.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1000
    (aNumber = 0) ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1001
	^ ZeroDivide raiseRequestWith:thisContext.
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1002
    ].
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1003
    ^ self retry:#quo: coercing:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1004
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1005
    "
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1006
     9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1007
     -9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1008
     9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1009
     -9 quo:4
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
  1010
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1011
     -7 // (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1012
     -7 quo: (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1013
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1014
     7 // (-4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1015
     7 quo: (-4/3)
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  1016
    "
21743
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1017
!
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1018
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1019
sqrt
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1020
    "return the square root value of the receiver
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1021
     reimplemented here for speed"
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1022
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1023
%{  /* NOCONTEXT */
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1024
#ifdef __SCHTEAM__
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1025
    return context._RETURN( self.sqrt());
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1026
#else
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1027
    double val = __intVal(self);
21744
4ffcc8930e88 #BUGFIX by ca
ca
parents: 21743
diff changeset
  1028
    extern double sqrt();
21743
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1029
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1030
    if (val >= 0.0) {
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1031
	RETURN (__MKFLOAT(sqrt(val)));
21743
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1032
    }
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1033
#endif
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1034
%}.
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1035
    ^ self class
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1036
	raise:#imaginaryResultSignal
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1037
	receiver:self
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1038
	selector:#sqrt
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1039
	arguments:#()
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1040
	errorString:'bad (negative) receiver in sqrt'
21743
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1041
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1042
    "
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1043
	2 sqrt
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1044
	-2 sqrt
21743
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1045
    "
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1046
987bc81dfb42 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 21700
diff changeset
  1047
    "Created: / 08-05-2017 / 14:57:07 / stefan"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1048
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1049
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1050
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  1051
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1052
!SmallInteger methodsFor:'bit operators'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1053
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1054
bitAnd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1055
    "return the bitwise-and of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1056
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1057
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1058
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1059
    return context._RETURN( self.bitAnd(anInteger));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1060
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1061
    /* anding the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1062
    if (__isSmallInteger(anInteger)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1063
	RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1064
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1065
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1066
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1067
    anInteger class == LargeInteger ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1068
	^ anInteger bitAnd:self
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1069
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1070
    ^ self retry:#bitAnd: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1071
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1072
    "(2r001010100 bitAnd:2r00001111) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1073
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1074
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1075
bitClear:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1076
    "return the bitwise-and of the receiver and the complement of the argument, anInteger,
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1077
     returning the receiver with bits of the argument cleared.
19070
9cabcfcb9ada #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19069
diff changeset
  1078
     (i.e. the same as self bitAnd:aMaskInteger bitInvert).
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1079
     The method's name may be misleading: the receiver is not changed,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1080
     but a new number is returned. Should be named #withBitCleared:"
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1081
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1082
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1083
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1084
    return context._RETURN( self.bitClear(anInteger));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1085
#else
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1086
    /* anding the tags doesn't change it */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1087
    if (__isSmallInteger(anInteger)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1088
	RETURN ( ((OBJ) (((INT)self & ~(INT)anInteger) | TAG_INT)) );
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1089
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1090
#endif /* not __SCHTEAM__ */
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1091
%}.
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1092
    ^ self retry:#bitClear: coercing:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1093
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1094
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1095
     (2r001010100 bitClear:2r00001111) radixPrintStringRadix:2
5458
2aa89d4fad64 example
Claus Gittinger <cg@exept.de>
parents: 5447
diff changeset
  1096
     (2r111111111 bitClear:2r00001000) radixPrintStringRadix:2
19070
9cabcfcb9ada #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19069
diff changeset
  1097
9cabcfcb9ada #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19069
diff changeset
  1098
     (2r001010100 bitAnd:2r00001111 bitInvert) radixPrintStringRadix:2
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1099
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1100
!
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1101
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1102
bitCount
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1103
    "return the number of 1-bits in the receiver"
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1104
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1105
%{  /* NOCONTEXT */
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1106
#ifdef __SCHTEAM__
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1107
    long _v1, _v2;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1108
    long _self = self.longValue();
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1109
    long _cnt;
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1110
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1111
    _v1 = _self & 0xFFFFFFFF;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1112
    _v1 = _v1 - ((_v1 >> 1) & 0x55555555);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1113
    _v1 = (_v1 & 0x33333333) + ((_v1 >> 2) & 0x33333333);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1114
    _v1 = ((_v1 + (_v1 >> 4)) & 0x0F0F0F0F);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1115
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  1116
    _v2 = (_self >> 32) & 0xFFFFFFFF;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1117
    _v2 = _v2 - ((_v2 >> 1) & 0x55555555);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1118
    _v2 = (_v2 & 0x33333333) + ((_v2 >> 2) & 0x33333333);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1119
    _v2 = ((_v2 + (_v2 >> 4)) & 0x0F0F0F0F);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1120
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1121
    _cnt = ((_v1 * 0x01010101) >> 24) + ((_v2 * 0x01010101) >> 24);
18948
cab22236fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18947
diff changeset
  1122
    return __c__._RETURN( STInteger._qnew( (byte)(_cnt) ) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1123
#else
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1124
    unsigned int _cnt;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1125
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1126
    // popcnt is actually slower on some (older) cpus;
23942
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1127
    // and almost equal to ALG3 on modern intel hardware.
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1128
    // So ALGO3 is good for all
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1129
# if 0 && (defined(__GNUC__) || defined(clang)) && (defined(__x86__) || defined(__x86_64__))
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1130
#  define ALGORITHM_4
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1131
# else
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1132
#  define ALGORITHM_3
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1133
# endif
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1134
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1135
# if defined( ALGORITHM_1 )
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1136
    // old k&r code; might be better if only one or two bits are set
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1137
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1138
    unsigned INT _self = __intVal(self);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1139
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1140
    _cnt = 0;
11666
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
  1141
    while (_self) {
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1142
        _cnt++;
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1143
        _self = _self & (_self - 1);
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1144
    }
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1145
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1146
# elif defined( ALGORITHM_2 )
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1147
    // seems to be faster on the average (and has better worst case)
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1148
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1149
    static unsigned char table[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4 };
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1150
    unsigned INT _self = __intVal(self);
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1151
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1152
    _cnt = 0;
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1153
    while (_self) {
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1154
        _cnt += table[ _self & 0x0F ];
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1155
        _self >>= 4;
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1156
    }
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1157
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1158
# elif defined( ALGORITHM_3 )
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1159
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1160
    // the fastest, but hard (impossible) to understand (google for fastest bit count)
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1161
18898
0dc54d84ac92 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18897
diff changeset
  1162
    unsigned INT _self = __intVal(self);
0dc54d84ac92 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18897
diff changeset
  1163
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1164
#  if __POINTER_SIZE__ == 8
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1165
    unsigned int _v1, _v2;
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1166
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1167
    _v1 = _self & 0xFFFFFFFF;
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1168
    _v1 = _v1 - ((_v1 >> 1) & 0x55555555);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1169
    _v1 = (_v1 & 0x33333333) + ((_v1 >> 2) & 0x33333333);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1170
    _v1 = ((_v1 + (_v1 >> 4)) & 0x0F0F0F0F);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1171
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1172
    _v2 = (unsigned int)(_self >> 32);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1173
    _v2 = _v2 - ((_v2 >> 1) & 0x55555555);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1174
    _v2 = (_v2 & 0x33333333) + ((_v2 >> 2) & 0x33333333);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1175
    _v2 = ((_v2 + (_v2 >> 4)) & 0x0F0F0F0F);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1176
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1177
    _cnt = ((_v1 * 0x01010101) >> 24) + ((_v2 * 0x01010101) >> 24);
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1178
#  else // POINTER_SIZE not 8
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1179
    _cnt = _self - ((_self >> 1) & 0x55555555);
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1180
    _cnt = (_cnt & 0x33333333) + ((_cnt >> 2) & 0x33333333);
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1181
    _cnt = ((_cnt + (_cnt >> 4)) & 0x0F0F0F0F);
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1182
    _cnt = (_cnt * 0x01010101) >> 24;
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1183
#  endif
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1184
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1185
# elif defined( ALGORITHM_4 )
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1186
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1187
     // using the popcnt instruction (x86 only); 
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1188
     // strange enough, this is slower than ALGO3 on some (older) Pentiums
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1189
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1190
#  if __POINTER_SIZE__ == 8
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1191
    unsigned INT _v;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1192
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1193
    #define _POPCNT(__op)                       \
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1194
    ({                                          \
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1195
        INT __rslt;                             \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1196
        asm("xor    %%rax,%%rax        \n       \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1197
             popcnt %1,%%rax           \n       \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1198
                        "  : "=a" (__rslt)      \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1199
                           : "g" ((INT)(__op))  \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1200
                           : "cc");             \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1201
        (OBJ)__rslt;                            \
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1202
     })
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1203
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1204
    _v = ((INT)self) - TAG_INT;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1205
    _cnt = _POPCNT(_v);
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1206
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1207
#  else // not POINTER_SIZE 8
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1208
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1209
    #define _POPCNT(__op)                       \
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1210
    ({                                          \
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1211
        INT __rslt;                             \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1212
        asm("xor     %%eax,%%eax        \n      \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1213
             popcnt  %1,%%eax           \n      \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1214
                        "  : "=a" (__rslt)      \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1215
                           : "g" ((INT)(__v))   \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1216
                           : "cc");             \
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1217
        (OBJ)__rslt;                            \
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1218
     })
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1219
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1220
    _v = ((INT)self) - TAG_INT;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1221
    _cnt = _POPCNT(_v);
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1222
#  endif
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1223
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1224
# elif defined( ALGORITHM_5 )
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1225
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1226
     // using the builtin_popcnt intrinsic
23942
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1227
    unsigned INT _v;
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1228
    _v = ((INT)self) - TAG_INT;   // remove the tag
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1229
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1230
#  if __POINTER_SIZE__ == 8
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1231
    _cnt = __builtin_popcountll(_v);
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1232
#  else // not POINTER_SIZE 8
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1233
    _cnt = __builtin_popcountl(_v);
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1234
#  endif
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1235
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1236
# else
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1237
      error error error "which ALGORITHM?"
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1238
# endif
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1239
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1240
    RETURN ( __MKSMALLINT(_cnt));
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1241
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1242
#endif /* not __SCHTEAM__ */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1243
%}.
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1244
    ^ super bitCount.
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1245
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1246
    "
23942
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1247
     16rAA bitCount
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1248
     
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1249
     TimeDuration toRun:[
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1250
        1 to:10000000 do:[:n |
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1251
            n bitCount
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1252
        ].
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1253
     ]   
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1254
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1255
     AL1: 967ms 958ms 971ms 930ms
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1256
     AL2: 900ms 872ms 877ms 870ms
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1257
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1258
     AL3: 879ms 849ms 831ms 849ms 
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1259
     AL4: 858ms 852ms 846ms 810ms
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1260
     AL5: 830ms 843ms 835ms 845ms
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1261
23942
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1262
     Mac PB2012/2.6Ghz I7
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1263
     AL3: 855ms 885ms 859ms 878ms 844ms
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1264
     AL5: 877ms 877ms 846ms 890ms 853ms
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1265
     
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1266
     1 to:1000000 do:[:n |
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1267
        self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
13909
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
  1268
     ].
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
  1269
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1270
     #( 16r00000000
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1271
        16r00010000 16r00100000 16r01000000 16r10000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1272
        16r00020000 16r00200000 16r02000000 16r20000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1273
        16r00040000 16r00400000 16r04000000 16r40000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1274
        16r00080000 16r00800000 16r08000000 16r80000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1275
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1276
        16rFFFFFFFF 16r7FFFFFFF 16r3FFFFFFF 16r1FFFFFFF
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1277
        16rEEEEEEEE 16r7EEEEEEE 16r3EEEEEEE 16r1EEEEEEE
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1278
        16rDDDDDDDD 16r7DDDDDDD 16r3DDDDDDD 16r1DDDDDDD
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1279
        16rCCCCCCCC 16r7CCCCCCC 16r3CCCCCCC 16r1CCCCCCC
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1280
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1281
        16r8000000000010000 16r8000000000100000 16r8000000001000000 16r8000000010000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1282
        16r8000000000020000 16r8000000000200000 16r8000000002000000 16r8000000020000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1283
        16r8000000000040000 16r8000000000400000 16r8000000004000000 16r8000000040000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1284
        16r8000000000080000 16r8000000000800000 16r8000000008000000 16r8000000080000000
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1285
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1286
        16r80000000FFFFFFFF 16r800000007FFFFFFF 16r800000003FFFFFFF 16r800000001FFFFFFF
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1287
        16r80000000EEEEEEEE 16r800000007EEEEEEE 16r800000003EEEEEEE 16r800000001EEEEEEE
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1288
        16r80000000DDDDDDDD 16r800000007DDDDDDD 16r800000003DDDDDDD 16r800000001DDDDDDD
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1289
        16r80000000CCCCCCCC 16r800000007CCCCCCC 16r800000003CCCCCCC 16r800000001CCCCCCC
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1290
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1291
        16rFFFFFFFFFFFFFFFF 16r7FFFFFFFFFFFFFFF 16r3FFFFFFFFFFFFFFF 16r1FFFFFFFFFFFFFFF
13909
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
  1292
     ) do:[:n |
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1293
        self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1294
     ]
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1295
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1296
     1 to:10000000 do:[:n |
22784
46a73ec92977 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22304
diff changeset
  1297
        (n bitCount)
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1298
     ]
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1299
    "
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1300
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1301
    "Modified: / 09-01-2012 / 19:12:41 / cg"
23942
d453cd166c2b #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23616
diff changeset
  1302
    "Modified: / 20-03-2019 / 12:49:47 / Claus Gittinger"
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1303
!
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1304
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1305
bitDeinterleave:n
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1306
    "extract count integers from an n-way Morton number as a vector;
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1307
     This is the inverse operation from bitInterleave: - see comment there.
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1308
     i.e. if count is 3,
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1309
     and the receiver's bits are
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1310
        cN bN aN ... c2 b2 a2 c1 b1 a1 c0 b0 a0
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1311
     then the result will be a vector containing the numbers a,b,c with bits:
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1312
        aN ... a2 a1 a0
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1313
        bN ... b2 b1 b0
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1314
        cN ... c2 c1 c0.
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1315
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1316
     Morton numbers are great to linearize 2D coordinates
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1317
     eg. to sort 2D points by distances"
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1318
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1319
%{
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1320
#if __POINTER_SIZE__ == 8
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1321
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1322
# define M5555555555555555 0x5555555555555555
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1323
# define M3333333333333333 0x3333333333333333
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1324
# define M0f0f0f0f0f0f0f0f 0x0f0f0f0f0f0f0f0f
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1325
# define M00ff00ff00ff00ff 0x00ff00ff00ff00ff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1326
# define M0000ffff0000ffff 0x0000ffff0000ffff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1327
# define M00000000ffffffff 0x00000000ffffffff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1328
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1329
# define M9249249249249249 0x9249249249249249
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1330
# define M30c30c30c30c30c3 0x30c30c30c30c30c3
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1331
# define Mf00f00f00f00f00f 0xf00f00f00f00f00f
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1332
# define M00ff0000ff0000ff 0x00ff0000ff0000ff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1333
# define Mffff00000000ffff 0xffff00000000ffff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1334
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1335
#else
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1336
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1337
# define M5555555555555555 0x55555555
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1338
# define M3333333333333333 0x33333333
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1339
# define M0f0f0f0f0f0f0f0f 0x0f0f0f0f
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1340
# define M00ff00ff00ff00ff 0x00ff00ff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1341
# define M0000ffff0000ffff 0x0000ffff
25001
4d5ec8f74450 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24699
diff changeset
  1342
# define M00000000ffffffff 0xffffffff
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1343
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1344
# define M9249249249249249 0x49249249
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1345
# define M30c30c30c30c30c3 0xc30c30c3
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1346
# define Mf00f00f00f00f00f 0x0f00f00f
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1347
# define M00ff0000ff0000ff 0xff0000ff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1348
# define Mffff00000000ffff 0x0000ffff
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1349
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1350
#endif
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1351
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1352
    unsigned INT bits = __intVal(self);
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1353
    unsigned INT a, b;
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1354
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1355
    if (n == __MKSMALLINT(2)) {
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1356
#       define morton2(x,dst) \
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1357
            { \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1358
                unsigned INT t; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1359
                t = (x) & M5555555555555555; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1360
                t = (t | (t >> 1))  & M3333333333333333; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1361
                t = (t | (t >> 2))  & M0f0f0f0f0f0f0f0f; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1362
                t = (t | (t >> 4))  & M00ff00ff00ff00ff; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1363
                t = (t | (t >> 8))  & M0000ffff0000ffff; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1364
                t = (t | (t >> 16)) & M00000000ffffffff; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1365
                dst = t; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1366
            }
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1367
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1368
        morton2(bits, a);
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1369
        morton2(bits>>1, b);
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1370
        RETURN (__ARRAY_WITH2(__MKSMALLINT(a), __MKSMALLINT(b)));
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1371
    }
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1372
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1373
    if (n == __MKSMALLINT(3)) {
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1374
        unsigned INT c;
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1375
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1376
#       define morton3(x,dst) \
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1377
            { \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1378
                unsigned INT t; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1379
                t = (x) & M9249249249249249; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1380
                t = (t | (t >> 2))  & M30c30c30c30c30c3; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1381
                t = (t | (t >> 4))  & Mf00f00f00f00f00f; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1382
                t = (t | (t >> 8))  & M00ff0000ff0000ff; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1383
                t = (t | (t >> 16)) & Mffff00000000ffff; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1384
                t = (t | (t >> 32)) & M00000000ffffffff; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1385
                dst = t; \
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1386
            }
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1387
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1388
        morton3(bits, a);
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1389
        morton3(bits>>1, b);
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1390
        morton3(bits>>2, c);
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1391
        RETURN (__ARRAY_WITH3(__MKSMALLINT(a), __MKSMALLINT(b), __MKSMALLINT(c)));
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1392
    }
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1393
done: ;
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1394
%}.
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1395
    ^ super bitDeinterleave:n
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1396
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1397
    "
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1398
     (2r1100 bitInterleaveWith:2r1001) bitDeinterleave:2 -> #(12 9)
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1399
     (197 bitInterleaveWith:144) bitDeinterleave:2 -> #(197 144)
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1400
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1401
     (197 bitInterleaveWith:144 and:62) bitDeinterleave:3 -> #(197 144 62)
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1402
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1403
     |a b|
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1404
     (0 to:31) do:[:bitA |
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1405
         a := 1 << bitA.
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1406
         (0 to:31) do:[:bitB |
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1407
            b := 1 << bitB.
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1408
            self assert:( (a bitInterleaveWith:b) bitDeinterleave:2 ) = {a . b }
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1409
         ].
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1410
     ].
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1411
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1412
     |a b c|
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1413
     (0 to:31) do:[:bitA |
24554
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1414
         a := 1 << bitA.
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1415
         (0 to:31) do:[:bitB |
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1416
             b := 1 << bitB.
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1417
             (0 to:31) do:[:bitC |
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1418
                 c := 1 << bitC.
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1419
                 self assert:( (a bitInterleaveWith:b and:c) bitDeinterleave:3 ) = {a . b . c}
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1420
             ].
1841effd762b #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24406
diff changeset
  1421
         ].
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1422
     ].
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1423
    "
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1424
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1425
    "Created: / 28-08-2017 / 18:32:48 / cg"
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1426
!
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1427
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1428
bitInterleaveWith:anInteger
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1429
    "generate a Morton number (-> https://en.wikipedia.org/wiki/Morton_number_(number_theory))
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1430
     by interleaving bits of the receiver
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1431
     (at even positions if counting from 1) with bits of the argument (at odd bit positions).
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1432
     Thus, if the bits of the receiver are
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1433
	aN ... a2 a1 a0
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1434
     and those of the argument are:
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1435
	bN ... b2 b1 b0
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1436
     the result is
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1437
	bN aN ... b2 a2 b1 a1 b0 a0.
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1438
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1439
     Morton numbers are great to linearize 2D coordinates
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1440
     eg. to sort 2D points by distances"
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1441
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1442
%{
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1443
#if __POINTER_SIZE__ == 8
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1444
# define __SLOW_MULTIPLY__
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1445
# ifndef __SLOW_MULTIPLY__
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1446
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1447
    // the following is only faster, if multiplication is faster than a memory fetch
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1448
    if (__isSmallInteger(anInteger)) {
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1449
	INT _a = __intVal(self);
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1450
	INT _b = __intVal(anInteger);
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1451
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1452
	if ( (((unsigned)_a)<=0xFFFFFFFF) && (((unsigned)_b)<=0xFFFFFFFF) )  {
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1453
	    int shift = 0;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1454
	    unsigned INT val = 0;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1455
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1456
	    // Interleave bits of (8-bit) a and b, so that all of the
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1457
	    // bits of a are in the even positions and b in the odd;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1458
	    // resulting in a 16-bit Morton Number.
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1459
#           define interleaveBytes(a,b) \
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1460
		((((a * 0x0101010101010101ULL & 0x8040201008040201ULL) * 0x0102040810204081ULL >> 49) & 0x5555) \
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1461
		| (((b * 0x0101010101010101ULL & 0x8040201008040201ULL) * 0x0102040810204081ULL >> 48) & 0xAAAA))
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1462
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1463
	    while (_a | _b) {
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1464
		val |= (interleaveBytes((_a & 0xFF), (_b & 0xFF)) << shift);
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1465
		_a = _a >> 8;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1466
		_b = _b >> 8;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1467
		shift += 16;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1468
	    }
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1469
	    RETURN (__MKUINT(val) );
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1470
	}
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1471
    }
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1472
# else
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1473
#  if __POINTER_SIZE__ == 8
24006
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1474
#   define HALF_INT_MAX     0xFFFFFFFFFFFFFFFFLL
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1475
#   define M55555555        0x5555555555555555LL
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1476
#   define M33333333        0x3333333333333333LL
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1477
#   define M0F0F0F0F        0x0F0F0F0F0F0F0F0FLL
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1478
#   define M00FF00FF        0x00FF00FF00FF00FFLL
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1479
#   define M0000FFFF        0x0000FFFF0000FFFFLL
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1480
#  else
24006
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1481
#   define HALF_INT_MAX     0xFFFFFFFFL
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1482
#   define M55555555        0x55555555L
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1483
#   define M33333333        0x33333333L
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1484
#   define M0F0F0F0F        0x0F0F0F0FL
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1485
#   define M00FF00FF        0x00FF00FFL
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1486
#   define M0000FFFF        0
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1487
#  endif
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1488
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1489
    if (__isSmallInteger(anInteger)) {
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1490
	INT _a = __intVal(self);
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1491
	INT _b = __intVal(anInteger);
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1492
24006
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1493
	if ( (((unsigned INT)_a)<=HALF_INT_MAX) && (((unsigned INT)_b)<=HALF_INT_MAX) )  {
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1494
	    unsigned INT val;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1495
24006
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1496
	    // spread the bits (...xxx -> ...0x0x0x)
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1497
	    _a = (_a | (_a << 16)) & M0000FFFF;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1498
	    _a = (_a | (_a << 8))  & M00FF00FF;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1499
	    _a = (_a | (_a << 4))  & M0F0F0F0F;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1500
	    _a = (_a | (_a << 2))  & M33333333;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1501
	    _a = (_a | (_a << 1))  & M55555555;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1502
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1503
	    _b = (_b | (_b << 16)) & M0000FFFF;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1504
	    _b = (_b | (_b << 8))  & M00FF00FF;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1505
	    _b = (_b | (_b << 4))  & M0F0F0F0F;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1506
	    _b = (_b | (_b << 2))  & M33333333;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1507
	    _b = (_b | (_b << 1))  & M55555555;
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1508
24006
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1509
	    // merge the bits (...0a0a0a and ...0b0b0b => ...bababa)
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1510
	    val = _a | (_b << 1);
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1511
	    RETURN (__MKUINT(val) );
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1512
	}
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1513
    }
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1514
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1515
# endif
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1516
#endif
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1517
%}.
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1518
    ^ super bitInterleaveWith:anInteger
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1519
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1520
    "
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1521
     (2r1100 bitInterleaveWith:2r1001) printStringRadix:2 -> '11 01 00 10'
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1522
     (2r11000101 bitInterleaveWith:2r10010000) printStringRadix:2'1101001000010001 -> '11 01 00 10 00 01 00 01'
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1523
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1524
     |a b|
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1525
     (0 to:31) do:[:bitA |
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1526
	 a := 1 << bitA.
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1527
	 (0 to:31) do:[:bitB |
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1528
	    b := 1 << bitB.
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1529
	    self assert:( (a bitInterleaveWith:b) bitDeinterleave:2 ) = {a . b }
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  1530
	 ].
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1531
     ].
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1532
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1533
    "
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1534
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1535
    "Created: / 28-08-2017 / 14:33:52 / cg"
22221
ffeed1814b34 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22220
diff changeset
  1536
    "Modified (comment): / 28-08-2017 / 19:30:14 / cg"
22220
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1537
!
afff1eb8cb71 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22218
diff changeset
  1538
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1539
bitInvert
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1540
    "return the value of the receiver with all bits inverted.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1541
     The method's name may be misleading: the receiver is not changed,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1542
     but a new number is returned. Could be named #withBitsInverted"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1543
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1544
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1545
#ifdef __SCHTEAM__
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1546
    long _self = self.longValue();
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1547
    return __c__._RETURN( STInteger._new( ~_self ) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1548
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1549
    /* invert anything except tag bits */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1550
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1551
#endif /* not __SCHTEAM__ */
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1552
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1553
    ^ super bitInvert
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1554
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1555
19069
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1556
bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1557
    "return a new integer, where the low 8 bits are masked and complemented.
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1558
     This returns an unsigned version of what bitInvert would return.
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1559
     (i.e. same as self bitInvert bitAnd:16rFF)"
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1560
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1561
%{  /* NOCONTEXT */
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1562
#ifdef __SCHTEAM__
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1563
    long _self = self.longValue();
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1564
    return __c__._RETURN( STInteger._new( ~_self & 0xFF) );
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1565
#else
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1566
    /* invert anything except tag bits */
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1567
    RETURN ( (OBJ) (((INT)self ^ ~TAG_MASK) & (INT)(__mkSmallInteger(0xFF))) );
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1568
#endif /* not __SCHTEAM__ */
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1569
%}.
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1570
    ^ super bitInvertByte
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  1571
19069
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1572
    "
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1573
     16r7f bitInvert
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1574
     16r7f bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1575
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1576
     16r80 bitInvert
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1577
     16r80 bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1578
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1579
     16rff bitInvert
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1580
     16rff bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1581
    "
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1582
!
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1583
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1584
bitOr:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1585
    "return the bitwise-or of the receiver and the argument, anInteger"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1586
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1587
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1588
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1589
    return context._RETURN( self.bitOr( anInteger ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1590
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1591
    /* oring the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1592
    if (__isSmallInteger(anInteger)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1593
	RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1594
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1595
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1596
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1597
    ^ self retry:#bitOr: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1598
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1599
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1600
     (2r000000100 bitOr:2r00000011) radixPrintStringRadix:2
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1601
     (0 bitOr:16r20000000) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1602
     (0 bitOr:16r40000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1603
     (0 bitOr:16r80000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1604
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1605
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1606
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1607
bitReversed
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1608
    "swap (i.e. reverse) bits in an integer
23993
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1609
     i.e. a.b.c.d....x.y.z -> z.y.x...b.a.d.c.
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1610
     Warning: 
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1611
        do not use this without care: it depends on the machine's 
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1612
        word size; i.e. a 64bit machine will return a different result as a 32bit machine.
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1613
        Better use one of the bitReversedXX methods.
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1614
        This my vanish or be replaced by something better"
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1615
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1616
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1617
#ifndef __SCHTEAM__
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1618
    unsigned INT v = __intVal(self);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1619
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1620
# if __POINTER_SIZE__ == 8
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1621
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1622
    v = ((v >> 1) & 0x5555555555555555) | ((v & 0x5555555555555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1623
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1624
    v = ((v >> 2) & 0x3333333333333333) | ((v & 0x3333333333333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1625
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1626
    v = ((v >> 4) & 0x0F0F0F0F0F0F0F0F) | ((v & 0x0F0F0F0F0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1627
    // swap bytes
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1628
    v = ((v >> 8) & 0x00FF00FF00FF00FF) | ((v & 0x00FF00FF00FF00FF) << 8);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1629
    // swap 2-byte pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1630
    v = ((v >> 16) & 0x0000FFFF0000FFFF) | (( v & 0x0000FFFF0000FFFF) << 16);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1631
    // swap 4-byte long pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1632
    v = ((v >> 32) & 0x00000000FFFFFFFF) | (( v & 0x00000000FFFFFFFF) << 32);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1633
# else
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1634
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1635
    v = ((v >> 1) & 0x55555555) | ((v & 0x55555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1636
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1637
    v = ((v >> 2) & 0x33333333) | ((v & 0x33333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1638
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1639
    v = ((v >> 4) & 0x0F0F0F0F) | ((v & 0x0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1640
    // swap bytes
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1641
    v = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1642
    // swap 2-byte long pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1643
    v = ((v >> 16) & 0x0000FFFF) | ((v & 0x0000FFFF) << 16);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1644
# endif
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1645
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1646
    if (v <= _MAX_INT) {
23993
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1647
        RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1648
    }
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1649
    RETURN (__MKUINT(v));
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1650
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1651
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1652
    ^ super bitReversed
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1653
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1654
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1655
     2r1001 bitReversed printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1656
     2r100111010011 bitReversed printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1657
     -1 bitReversed printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1658
    "
23993
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1659
e460b1c11d6a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23991
diff changeset
  1660
    "Modified (comment): / 27-03-2019 / 18:28:47 / Claus Gittinger"
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1661
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1662
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1663
bitReversed16
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1664
    "swap (i.e. reverse) the low 16 bits in an integer
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1665
     the high bits are ignored and clear in the result
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1666
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1667
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1668
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1669
#ifndef __SCHTEAM__
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1670
    unsigned int v = __intVal(self) & 0xFFFF;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1671
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1672
    // swap odd and even bits
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1673
    v = ((v >> 1) & 0x5555) | ((v & 0x5555) << 1);
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1674
    // swap consecutive pairs
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1675
    v = ((v >> 2) & 0x3333) | ((v & 0x3333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1676
    // swap nibbles ...
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1677
    v = ((v >> 4) & 0x0F0F) | ((v & 0x0F0F) << 4);
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1678
    // swap bytes
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1679
    v = ((v >> 8) & 0x00FF) | ((v & 0x00FF) << 8);
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1680
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1681
    RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1682
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1683
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1684
    ^ super bitReversed16
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1685
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1686
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1687
     2r1001 bitReversed16 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1688
     2r100111010011 bitReversed16 printStringRadix:2
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1689
     16r1ABCD bitReversed16 printStringRadix:2
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1690
     -1 bitReversed16 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1691
    "
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1692
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1693
    "Modified: / 24-03-2019 / 11:55:34 / Claus Gittinger"
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1694
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1695
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1696
bitReversed32
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1697
    "swap (i.e. reverse) the low 32 bits in an integer
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1698
     the high bits are ignored and clear in the result
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1699
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1700
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1701
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1702
#ifndef __SCHTEAM__
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1703
    unsigned int v = __intVal(self) & 0xFFFFFFFF;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1704
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1705
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1706
    v = ((v >> 1) & 0x55555555) | ((v & 0x55555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1707
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1708
    v = ((v >> 2) & 0x33333333) | ((v & 0x33333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1709
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1710
    v = ((v >> 4) & 0x0F0F0F0F) | ((v & 0x0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1711
    // swap bytes
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1712
    v = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1713
    // swap 16bit words
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1714
    v = ((v >> 16) & 0x0000FFFF) | ((v & 0x0000FFFF) << 16);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1715
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1716
# if __POINTER_SIZE__ == 8
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1717
    RETURN ( __mkSmallInteger(v) );
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1718
# else
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1719
    if (v <= _MAX_INT) {
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1720
        RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1721
    }
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1722
    RETURN (__MKUINT(v));
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1723
# endif /* not __SCHTEAM__ */
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1724
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1725
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1726
    ^ super bitReversed32
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1727
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1728
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1729
     2r1001 bitReversed32 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1730
     2r100111010011 bitReversed32 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1731
     -1 bitReversed32 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1732
    "
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1733
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1734
    "Modified (format): / 27-03-2019 / 17:54:43 / Claus Gittinger"
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1735
!
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1736
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1737
bitReversed64
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1738
    "swap (i.e. reverse) the low 64 bits in an integer
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1739
     the high bits are ignored and clear in the result
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1740
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1741
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1742
%{  /* NOCONTEXT */
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1743
#ifndef __SCHTEAM__
23996
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1744
    unsigned INT v = __intVal(self);
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1745
# if __POINTER_SIZE__ == 8
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1746
    // swap odd and even bits
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1747
    v = ((v >> 1) & 0x5555555555555555ULL) | ((v & 0x5555555555555555ULL) << 1);
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1748
    // swap consecutive pairs
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1749
    v = ((v >> 2) & 0x3333333333333333ULL) | ((v & 0x3333333333333333ULL) << 2);
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1750
    // swap nibbles ...
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1751
    v = ((v >> 4) & 0x0F0F0F0F0F0F0F0FULL) | ((v & 0x0F0F0F0F0F0F0F0FULL) << 4);
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1752
    // swap bytes
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1753
    v = ((v >> 8) & 0x00FF00FF00FF00FFULL) | ((v & 0x00FF00FF00FF00FFULL) << 8);
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1754
    // swap 16bit words
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1755
    v = ((v >> 16) & 0x0000FFFF0000FFFFULL) | ((v & 0x0000FFFF0000FFFFULL) << 16);
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1756
    // swap 32bit words
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1757
    v = ((v >> 32) & 0x00000000FFFFFFFFULL) | ((v & 0x00000000FFFFFFFFULL) << 32);
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1758
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1759
    if (v <= _MAX_INT) {
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1760
        RETURN ( __mkSmallInteger(v) );
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1761
    }
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1762
    RETURN (__MKUINT(v));
24006
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1763
# else
23996
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1764
    // swap odd and even bits
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1765
    v = ((v >> 1) & 0x55555555UL) | ((v & 0x55555555UL) << 1);
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1766
    // swap consecutive pairs
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1767
    v = ((v >> 2) & 0x33333333UL) | ((v & 0x33333333UL) << 2);
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1768
    // swap nibbles ...
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1769
    v = ((v >> 4) & 0x0F0F0F0FUL) | ((v & 0x0F0F0F0FUL) << 4);
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1770
    // swap bytes
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1771
    v = ((v >> 8) & 0x00FF00FFUL) | ((v & 0x00FF00FFUL) << 8);
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1772
    // swap 16bit words
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1773
    v = ((v >> 16) & 0x0000FFFFUL) | ((v & 0x0000FFFFUL) << 16);
0e2c9990b86f #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23995
diff changeset
  1774
    // swap 32bit words
24006
5eedbb97db6a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 24004
diff changeset
  1775
    RETURN (__MKLARGEINT64(1, (INT)0, (INT)v));
23990
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1776
# endif
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1777
#endif /* not __SCHTEAM__ */
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1778
%}.
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1779
    ^ super bitReversed64
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1780
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1781
    "
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1782
     2r1001 bitReversed64 printStringRadix:2
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1783
     2r100111010011 bitReversed64 printStringRadix:2
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1784
     -1 bitReversed64 printStringRadix:2
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1785
    "
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1786
70e4e762b3e2 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23961
diff changeset
  1787
    "Created: / 27-03-2019 / 18:11:11 / Claus Gittinger"
24004
7a3254568d7f #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23996
diff changeset
  1788
    "Modified: / 27-03-2019 / 15:25:26 / stefan"
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1789
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1790
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1791
bitReversed8
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1792
    "swap (i.e. reverse) the low 8 bits in an integer
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1793
     the high bits are ignored and clear in the result
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1794
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1795
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1796
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1797
#ifndef __SCHTEAM__
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1798
    unsigned int v = __intVal(self) & 0xFF;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1799
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1800
    // swap odd and even bits
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1801
    v = ((v >> 1) & 0x55) | ((v & 0x55) << 1);
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1802
    // swap consecutive pairs
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1803
    v = ((v >> 2) & 0x33) | ((v & 0x33) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1804
    // swap nibbles ...
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1805
    v = ((v >> 4) & 0x0F) | ((v & 0x0F) << 4);
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1806
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1807
    RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1808
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1809
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1810
    ^ super bitReversed8
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1811
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1812
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1813
     2r1001 bitReversed8 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1814
     2r10011101 bitReversed8 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1815
     2r111110011101 bitReversed8 printStringRadix:2
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1816
     16r1234 bitReversed8 printStringRadix:2
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1817
     -1 bitReversed8 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1818
    "
23961
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1819
7e0c1ebaf951 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23942
diff changeset
  1820
    "Modified: / 24-03-2019 / 11:57:14 / Claus Gittinger"
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1821
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1822
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1823
bitShift:shiftCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1824
    "return the value of the receiver shifted by shiftCount bits;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1825
     leftShift if shiftCount > 0; rightShift otherwise.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1826
     Notice: the result of bitShift: on negative receivers is not
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1827
             defined in the language standard (since the implementation
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1828
             is free to choose any internal representation for integers).
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1829
             However, ST/X preserves the sign;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1830
             i.e. it is an arithmetic shift as long as you stay within the 
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1831
             number of bits supported by the platform."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1832
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1833
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1834
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1835
    return context._RETURN( self.bitShift( shiftCount ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1836
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1837
    INT bits, count;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1838
252
  1839
    if (__isSmallInteger(shiftCount)) {
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1840
        bits = __intVal(self);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1841
        if (bits == 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1842
            RETURN (self);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1843
        }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1844
        count = __intVal(shiftCount);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1845
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1846
        if (count > 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1847
            INT sign = 1;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1848
            if (bits < 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1849
                bits = -bits;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1850
                sign = -1;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1851
            }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1852
            /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1853
             * a left shift
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1854
             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1855
# if defined(USE_LONGLONG_FOR_SHIFT)
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1856
            if (count <= N_INT_BITS) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1857
                unsigned LONGLONG result;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1858
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1859
                result = (unsigned LONGLONG)bits;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1860
                result <<= count;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1861
                if (result <= _MAX_INT) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1862
                    if (sign < 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1863
                        RETURN ( __MKINT(-result) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1864
                    }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1865
                    RETURN ( __mkSmallInteger(result) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1866
                }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1867
                {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1868
                    RETURN (__MKLARGEINT64(sign, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1869
                }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1870
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1871
# else
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1872
            /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1873
             * check for overflow
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1874
             */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1875
            if (count < (N_INT_BITS-1)) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1876
                if (! (bits >> (N_INT_BITS - 1 - count))) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1877
                    INT result = bits << count;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1878
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1879
                    if (sign < 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1880
                        RETURN ( __MKINT(-result) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1881
                    }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1882
                    RETURN ( __mkSmallInteger(result) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1883
                }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1884
                /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1885
                 * so, there is an overflow ...
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1886
                 * handle it as largeInteger
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1887
                 */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1888
                /* FALL THROUGH */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1889
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1890
# endif
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1891
        } else {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1892
            if (count == 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1893
                RETURN (self);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1894
            }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1895
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1896
            /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1897
             * right shifts cannot overflow
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1898
             *
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1899
             * some machines ignore shifts bigger than
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1900
             * the number of bits in an int ...
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1901
             */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1902
            count = -count;
24406
588966201b30 #BUGFIX by Stefan Reise
sr
parents: 24288
diff changeset
  1903
            if (count > N_INT_BITS) {
588966201b30 #BUGFIX by Stefan Reise
sr
parents: 24288
diff changeset
  1904
                RETURN (__mkSmallInteger(bits < 0 ? -1 : 0));
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1905
            }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1906
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1907
            RETURN ( __mkSmallInteger(bits >> count) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1908
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1909
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1910
#endif /* not __SCHTEAM__ */
85
claus
parents: 77
diff changeset
  1911
%}.
claus
parents: 77
diff changeset
  1912
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1913
        ^ (LargeInteger value:self) bitShift:shiftCount
85
claus
parents: 77
diff changeset
  1914
    ].
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1915
    ^ self bitShift:shiftCount asInteger   "/ is this a good idea ?
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1916
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1917
    "
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1918
       16 bitShift:-1
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1919
       16 bitShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1920
       16 bitShift:-63
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1921
       
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1922
       -16 bitShift:-1
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1923
       -16 bitShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1924
       -16 bitShift:-63
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1925
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1926
         4 rightShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1927
        -4 rightShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1928
        -4 rightShift:63
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1929
    "
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1930
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  1931
    "Modified (comment): / 03-06-2019 / 17:49:15 / Claus Gittinger"
24406
588966201b30 #BUGFIX by Stefan Reise
sr
parents: 24288
diff changeset
  1932
    "Modified: / 09-07-2019 / 14:24:07 / Stefan Reise"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1933
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1934
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1935
bitTest:aMask
5782
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1936
    "return true, if any bit from aMask is set in the receiver.
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1937
     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
  1938
     is non-0, false otherwise."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1939
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1940
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1941
#ifdef __SCHTEAM__
18232
Claus Gittinger <cg@exept.de>
parents: 18227
diff changeset
  1942
    return context._RETURN(
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1943
	    ( self.bitAnd( aMask ) == STInteger._0 )
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1944
	    ? STObject.False : STObject.True );
18232
Claus Gittinger <cg@exept.de>
parents: 18227
diff changeset
  1945
    /* NOTREACHED */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1946
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1947
    /* and all bits except tag */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1948
    if (__isSmallInteger(aMask)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1949
	RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1950
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1951
#endif /* not __SCHTEAM__ */
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1952
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1953
    aMask class == LargeInteger ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1954
	^ (aMask bitAnd:self) ~~ 0
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1955
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1956
    ^ self retry:#bitTest: coercing:aMask
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1957
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1958
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1959
     2r10001 bitTest:2r00001
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1960
     2r10001 bitTest:2r00010
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1961
     2r10001 bitTest:2r00100
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1962
     2r10001 bitTest:2r01000
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1963
     2r10001 bitTest:2r10000
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1964
     2r10001 bitTest:2r10001
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1965
     2r10001 bitTest:2r10010
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1966
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1967
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1968
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1969
bitXor:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1970
    "return the bitwise-exclusive-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1971
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1972
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1973
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1974
    return context._RETURN( self.bitXor( anInteger ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1975
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1976
    /* xoring the tags turns it off - or it in again */
252
  1977
    if (__isSmallInteger(anInteger)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  1978
	RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1979
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1980
#endif /* not __SCHTEAM__ */
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1981
%}.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1982
    ^ self retry:#bitXor: coercing:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1983
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1984
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1985
highBit
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  1986
    "return the bitIndex of the highest bit set.
19601
bcce77592dae #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19486
diff changeset
  1987
     The returned bitIndex starts at 1 for the least significant bit.
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  1988
     Returns 0 if no bit is set.
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  1989
     Notice for negative numbers, the returned value is undefined (actually: nonsense),
24288
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  1990
     because for 2's complement representation, conceptionally all high bits are 1.
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  1991
     But because we use a sign-magnitude representation for large integers, 
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  1992
     you'll get the high bit of the absolute magnitude for numbers above the SmallInteger
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  1993
     range, in contrast to the highbit of the negative number if within the SmallInt range."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1994
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1995
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1996
#ifdef __SCHTEAM__
18234
34f00359de08 experimental java support
Claus Gittinger <cg@exept.de>
parents: 18232
diff changeset
  1997
    {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  1998
        long bits = self.longValue();
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  1999
        int bitNr = 0;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2000
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2001
        if (bits != 0) {
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2002
            if ((bits & 0xFFFFFFFF00000000L) != 0) {
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2003
                bitNr += 32; bits >>= 32;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2004
            }
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2005
            if ((bits & 0xFFFF0000L) != 0) {
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2006
                bitNr += 16; bits >>= 16;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2007
            }
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2008
            if ((bits & 0xFF00) != 0) {
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2009
                bitNr += 8; bits >>= 8;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2010
            }
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2011
            if ((bits & 0xF0) != 0) {
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2012
                bitNr += 4; bits >>= 4;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2013
            }
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2014
            if ((bits & 0xC) != 0) {
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2015
                bitNr += 2; bits >>= 2;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2016
            }
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2017
            if ((bits & 0x2) != 0) {
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2018
                bitNr += 1; bits >>= 1;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2019
            }
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2020
            bitNr += 1;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2021
        }
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2022
        return context._RETURN( STInteger._new(bitNr) );
18234
34f00359de08 experimental java support
Claus Gittinger <cg@exept.de>
parents: 18232
diff changeset
  2023
    }
34f00359de08 experimental java support
Claus Gittinger <cg@exept.de>
parents: 18232
diff changeset
  2024
    /* NOTREACHED */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2025
#else
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2026
    unsigned INT bits;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2027
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2028
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2029
# ifdef __BSR
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2030
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2031
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2032
     * 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
  2033
     * (but saves a few code-bytes, though)
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2034
     */
21984
f0c07acc75df #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21983
diff changeset
  2035
    index = __BSR((INT)self);
f0c07acc75df #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21983
diff changeset
  2036
    RETURN ( __mkSmallInteger(index) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2037
# else
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  2038
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2039
    /*
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2040
     * this uses the FPU, which counts the bits during the normalization
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2041
     * and leaves the high bitnumber in the exponent...
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2042
     * Notice: due to rounding mode details,
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2043
     * this code only works for <=53 bit integers (i.e. only on 32bit machines)
24288
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  2044
     * we never use it - it is only here as a hint.
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2045
     */
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2046
#  if (POINTER_SIZE == 4) && defined( USE_IEE_FLOAT_BITS )
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2047
    union {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2048
        double ff;
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2049
        int ll[2];
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2050
    } uu;
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2051
    int bNr;
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2052
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2053
    uu.ff=(double)((INT)(self));
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2054
    bNr = (uu.ll[1]>>20)-1023;
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2055
    return __mkSmallInteger(bNr);  // assumes x86 endianness
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2056
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2057
#  else
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2058
    /*
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2059
     * general fallback; not super-fast,
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2060
     * but fast enough on all machines (better than a bit-masking loop, definitely).
24288
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  2061
     * Notice, the code runs completely in registers,
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  2062
     * so it is probably faster than a table-lookup version (at least if its not in the cache)
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2063
     */
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  2064
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2065
    index = 0;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2066
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2067
    bits = __intVal(self);
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2068
    if (bits == 0) {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2069
        RETURN ( __mkSmallInteger(0) );
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2070
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2071
#  if __POINTER_SIZE__ == 8
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2072
    if (bits & 0xFFFFFFFF00000000L) {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2073
        index += 32; bits >>= 32;
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2074
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2075
#  endif
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2076
    if (bits & 0xFFFF0000L) {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2077
        index += 16; bits >>= 16;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2078
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2079
    if (bits & 0xFF00) {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2080
        index += 8; bits >>= 8;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2081
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2082
    if (bits & 0xF0) {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2083
        index += 4; bits >>= 4;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2084
    }
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2085
    if (bits & 0xC) {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2086
        index += 2; bits >>= 2;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2087
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2088
    if (bits & 0x2) {
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2089
        index += 1; bits >>= 1;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2090
    }
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2091
#  endif /* not IEE float */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2092
# endif /* no BSR instruction */
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2093
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2094
    RETURN ( __mkSmallInteger(index+1) );
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2095
#endif /* not __SCHTEAM__ */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2096
%}.
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2097
    ^ super highBit
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2098
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2099
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2100
     2r0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2101
     2r1 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2102
     2r10 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2103
     2r100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2104
     2r1000 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2105
     2r100000000000 highBit
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2106
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2107
     ((0 to:64) collect:[:s | 1 bitShift:s])
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2108
        collect:[:n | n highBit]
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2109
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2110
     (((0 to:64) collect:[:s | 1 bitShift:s])
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2111
        collect:[:n | n highBit]) = (1 to:65)
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2112
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2113
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2114
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2115
     Time millisecondsToRun:[
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2116
        1000000 timesRepeat:[
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2117
            2r1 highBit
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2118
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2119
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2120
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2121
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2122
     Time millisecondsToRun:[
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2123
        1000000 timesRepeat:[
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2124
            2r1111 highBit
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2125
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2126
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2127
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2128
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2129
     Time millisecondsToRun:[
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2130
        1000000 timesRepeat:[
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2131
            2r11111111111111 highBit
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2132
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2133
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2134
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2135
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2136
     Time millisecondsToRun:[
24168
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2137
        1000000 timesRepeat:[
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2138
            2r11111111111111111111111111 highBit
7b016046fdb9 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24100
diff changeset
  2139
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2140
     ]
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2141
    "
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2142
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2143
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2144
     2r000100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2145
     2r010100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2146
     2r000001 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2147
     0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2148
     SmallInteger maxVal highBit
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  2149
    "
21983
27b59dd4c7fa #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21966
diff changeset
  2150
21984
f0c07acc75df #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 21983
diff changeset
  2151
    "Modified: / 05-07-2017 / 16:56:08 / cg"
24288
6ea528fc3cb4 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24245
diff changeset
  2152
    "Modified (comment): / 08-06-2019 / 02:07:54 / Claus Gittinger"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2153
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2154
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2155
lowBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2156
    "return the bitIndex of the lowest bit set. The returned bitIndex
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2157
     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
  2158
     Returns 0 if no bit is set."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2159
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2160
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2161
#ifdef __SCHTEAM__
18370
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  2162
    long bits = self.longValue();
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  2163
    int index = 0;
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  2164
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  2165
    if (bits != 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2166
	if ((bits & 0xFFFFFFFFL)==0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2167
	    index += 32; bits >>= 32;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2168
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2169
	if ((bits & 0xFFFFL)==0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2170
	    index += 16; bits >>= 16;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2171
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2172
	if ((bits & 0xFFL)==0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2173
	    index += 8; bits >>= 8;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2174
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2175
	if ((bits & 0xFL)==0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2176
	    index += 4; bits >>= 4;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2177
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2178
	if ((bits & 0x3L)==0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2179
	    index += 2; bits >>= 2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2180
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2181
	if ((bits & 0x1L)==0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2182
	    index += 1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2183
	}
18370
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  2184
    }
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  2185
    return __c__._RETURN( STInteger._qnew( index ) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2186
#else
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  2187
    unsigned INT bits;
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  2188
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2189
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2190
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2191
    if (bits == 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2192
	RETURN ( __mkSmallInteger(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2193
    }
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  2194
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2195
# ifdef __BSF
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2196
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2197
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2198
     * 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
  2199
     * (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
  2200
     * but saves a few code-bytes, though.
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2201
     */
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  2202
    index = __BSF(bits);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2203
    RETURN ( __mkSmallInteger(index + 1) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2204
# else
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2205
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2206
    index = 1;
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  2207
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2208
#  if __POINTER_SIZE__ == 8
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2209
    if ((bits<<32) == 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2210
	index += 32; bits >>= 32;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2211
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2212
#  endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2213
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2214
    if ((bits & 0xFFFF)==0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2215
	index += 16; bits >>= 16;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2216
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2217
    if ((bits & 0xFF)==0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2218
	index += 8; bits >>= 8;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2219
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2220
    if ((bits & 0xF)==0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2221
	index += 4; bits >>= 4;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2222
    }
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2223
    if ((bits & 0x3)==0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2224
	index += 2; bits >>= 2;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2225
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2226
    if ((bits & 0x1)==0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2227
	index += 1;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2228
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2229
# endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2230
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2231
    RETURN ( __mkSmallInteger(index) );
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2232
#endif /* not __SCHTEAM__ */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2233
%}.
18370
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  2234
    self primitiveFailed "/ must be implemented (or else: recursion)
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2235
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2236
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2237
     0 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2238
     2r0001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2239
     2r0010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2240
     2r0100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2241
     2r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2242
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2243
     2r000100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2244
     2r010010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2245
     2r100001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2246
     16r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2247
     16r1000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2248
     16r1000000000000000 lowBit
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2249
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2250
     Time millisecondsToRun:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2251
	1000000 timesRepeat:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2252
	    2r1000 lowBit
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2253
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2254
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2255
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2256
     Time millisecondsToRun:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2257
	1000000 timesRepeat:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2258
	    2r11110000000 lowBit
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2259
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2260
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2261
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2262
     Time millisecondsToRun:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2263
	1000000 timesRepeat:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2264
	    2r1000000000000 lowBit
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2265
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2266
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  2267
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2268
     Time millisecondsToRun:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2269
	1000000 timesRepeat:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2270
	    2r1000000000000000000000000000 lowBit
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2271
	]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2272
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  2273
    "
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2274
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2275
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2276
rightShift:shiftCount
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2277
    "return the value of the receiver shifted by shiftCount bits;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2278
     right shift if shiftCount > 0; left shift  otherwise.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2279
     Notice: the result of bitShift: on negative receivers is not
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2280
             defined in the language standard (since the implementation
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2281
             is free to choose any internal representation for integers).
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2282
             However, ST/X preserves the sign,
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2283
             i.e. it is an arithmetic shift as long as you stay within the 
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2284
             number of bits supported by the platform."
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2285
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2286
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2287
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2288
#else
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2289
    INT bits, count;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2290
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2291
    if (__isSmallInteger(shiftCount)) {
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2292
        bits = __intVal(self);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2293
        if (bits == 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2294
            RETURN (self);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2295
        }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2296
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2297
        count = __intVal(shiftCount);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2298
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2299
        if (count < 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2300
            /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2301
             * a left shift
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2302
             */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2303
            count = -count;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2304
# if defined(USE_LONGLONG_FOR_SHIFT)
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2305
            if (count <= N_INT_BITS) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2306
                unsigned LONGLONG result;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2307
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2308
                result = (unsigned LONGLONG)bits;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2309
                result <<= count;
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2310
                if (result <= _MAX_INT) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2311
                    RETURN ( __mkSmallInteger(result) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2312
                }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2313
                {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2314
                    RETURN (__MKLARGEINT64(1, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2315
                }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2316
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2317
# else
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2318
            /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2319
             * check for overflow
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2320
             */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2321
            if (count < (N_INT_BITS-1)) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2322
                if (! (bits >> (N_INT_BITS - 1 - count))) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2323
                    RETURN ( __mkSmallInteger(bits << count) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2324
                }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2325
                /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2326
                 * so, there is an overflow ...
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2327
                 * handle it as largeInteger
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2328
                 */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2329
                /* FALL THROUGH */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2330
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2331
# endif
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2332
        } else {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2333
            if (count == 0) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2334
                RETURN (self);
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2335
            }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2336
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2337
            /*
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2338
             * right shifts cannot overflow
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2339
             *
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2340
             * some machines ignore shifts bigger than
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2341
             * the number of bits in an int ...
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2342
             */
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2343
            if (count >= (__POINTER_SIZE__*8)) {
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2344
                RETURN (__mkSmallInteger(0));
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2345
            }
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2346
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2347
            RETURN ( __mkSmallInteger(bits >> count) );
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2348
        }
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2349
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2350
#endif /* not __SCHTEAM__ */
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2351
%}.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2352
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2353
        ^ (LargeInteger value:self) rightShift:shiftCount
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2354
    ].
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  2355
    ^ self rightShift:shiftCount asInteger   "/ is this a good idea ?
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2356
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2357
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2358
    "
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2359
        16 rightShift:1
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2360
        16 rightShift:2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2361
        16 rightShift:63
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2362
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2363
       -16 rightShift:1
22211
8fb52fc26e1a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21984
diff changeset
  2364
       -16 rightShift:2
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2365
       -16 rightShift:63
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2366
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2367
        1 rightShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2368
       -1 rightShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2369
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2370
         4 rightShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2371
        -4 rightShift:-2
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2372
        -4 rightShift:63
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2373
    "
22211
8fb52fc26e1a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21984
diff changeset
  2374
8fb52fc26e1a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21984
diff changeset
  2375
    "Modified: / 25-08-2017 / 12:30:42 / cg"
24245
987981c3e50d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 24193
diff changeset
  2376
    "Modified (comment): / 03-06-2019 / 17:50:22 / Claus Gittinger"
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2377
! !
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2378
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2379
!SmallInteger methodsFor:'bit operators - indexed'!
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2380
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2381
bitAt:anIntegerIndex
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2382
    "return the value of the index's bit (index starts at 1) as 0 or 1.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2383
     Notice: the result of bitAt: on negative receivers is not
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2384
	     defined in the language standard (since the implementation
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2385
	     is free to choose any internal representation for integers)"
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2386
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2387
%{  /* NOCONTEXT */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2388
#ifdef __SCHTEAM__
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2389
    return context._RETURN( self.bitAt(anIntegerIndex));
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2390
#else
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2391
    if (__isSmallInteger(anIntegerIndex)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2392
	INT idx = __smallIntegerVal(anIntegerIndex);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2393
	if (idx > 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2394
	    if (idx > N_INT_BITS) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2395
		RETURN(__mkSmallInteger(0));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2396
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2397
	    RETURN((__smallIntegerVal(self) & ((INT)1 << (idx-1))) ? __mkSmallInteger(1) : __mkSmallInteger(0));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2398
	}
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2399
    }
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2400
#endif /* not __SCHTEAM__ */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2401
%}.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2402
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2403
    ^ SubscriptOutOfBoundsError
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2404
	    raiseRequestWith:anIntegerIndex
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2405
	    errorString:'index out of bounds'
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2406
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2407
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2408
     16r000000001 bitAt:0 -> error
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2409
     16r000000001 bitAt:1
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2410
     16r000000001 bitAt:2
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2411
     16r000008000 bitAt:16
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2412
     16r000800000 bitAt:24
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2413
     16r008000000 bitAt:28
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2414
     16r010000000 bitAt:29
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2415
     16r020000000 bitAt:30
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2416
     16r040000000 bitAt:31
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2417
     16r080000000 bitAt:32
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2418
     16r100000000 bitAt:33
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2419
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2420
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2421
" Smalltalk implementation:
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2422
    |mask|
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2423
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2424
    anIntegerIndex <= 0 ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2425
	^ SubscriptOutOfBoundsSignal
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2426
		raiseRequestWith:anIntegerIndex
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2427
		errorString:'index out of bounds'
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2428
    ].
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2429
    (anIntegerIndex > SmallInteger maxBits) ifTrue:[^ 0].
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2430
    mask := 1 bitShift:(anIntegerIndex - 1).
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2431
    ((self bitAnd:mask) == 0) ifTrue:[^ 0].
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2432
    ^ 1
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2433
"
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2434
!
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2435
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2436
clearBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2437
    "return a new integer where the specified bit is off.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2438
     Bits are counted from 1 starting with the least significant.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2439
     The method's name may be misleading: the receiver is not changed,
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2440
     but a new number is returned. Should be named #withBitCleared:"
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2441
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2442
%{  /* NOCONTEXT */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2443
#ifndef __SCHTEAM__
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2444
    if (__isSmallInteger(anInteger)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2445
	int index = __intVal(anInteger);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2446
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2447
	if (index > 0) {
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2448
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2449
	    if (index <= 62)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2450
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2451
	    if (index <= 30)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2452
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2453
	    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2454
		INT mask = __MASKSMALLINT( ((INT)1 << (index-1)));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2455
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2456
		RETURN ( ((OBJ) ((INT)self & ~(INT)mask)) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2457
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2458
	    RETURN (self);  /* nothing to do ... */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2459
	}
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2460
    }
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2461
#endif /* not __SCHTEAM__ */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2462
%}.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2463
    ^ super clearBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2464
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2465
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2466
     (16r401 clearBit:1     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2467
     (16r401 clearBit:0     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2468
     (16r3fffffff clearBit:1) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2469
     (16r3fffffff clearBit:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2470
     (16r3fffffff clearBit:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2471
     (16r3fffffff clearBit:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2472
     (16r3fffffff bitAt:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2473
     (16r3fffffff bitAt:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2474
     (16r3fffffff bitAt:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2475
     (16r40000001 clearBit:1) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2476
     (16rF0000001 clearBit:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2477
     (16rF0000001 clearBit:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2478
     (16rF0000001 clearBit:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2479
     (16rF0000001 clearBit:32) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2480
     (16r1F0000001 clearBit:33) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2481
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2482
!
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2483
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2484
invertBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2485
    "return a new number where the specified bit is inverted.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2486
     Bits are counted from 1 starting with the least significant.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2487
     The method's name may be misleading: the receiver is not changed,
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2488
     but a new number is returned. Should be named #withBitInverted:"
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2489
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2490
%{  /* NOCONTEXT */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2491
#ifndef __SCHTEAM__
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2492
    if (__isSmallInteger(anInteger)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2493
	int index = __intVal(anInteger);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2494
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2495
	if (index > 0) {
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2496
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2497
	    if (index <= 62)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2498
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2499
	    if (index <= 30)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2500
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2501
	    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2502
		INT mask = __MASKSMALLINT((INT)1 << (index-1));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2503
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2504
		RETURN ( ((OBJ) ((INT)self ^ (INT)mask)) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2505
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2506
	}
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2507
    }
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2508
#endif /* not __SCHTEAM__ */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2509
%}.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2510
    ^ super invertBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2511
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2512
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2513
     (16r401 invertBit:2     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2514
     (16r401 invertBit:1     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2515
     (16r30000000 invertBit:1) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2516
     (16r40000000 invertBit:0) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2517
     (16r0 invertBit:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2518
     (16r0 invertBit:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2519
     (16r0 invertBit:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2520
     (16r0 invertBit:32) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2521
     (16r0 invertBit:33) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2522
     (16r0 invertBit:100) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2523
    "
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2524
!
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2525
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2526
setBit:anInteger
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8919
diff changeset
  2527
    "return a new integer where the specified bit is on.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2528
     Bits are counted from 1 starting with the least significant.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2529
     The method's 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
  2530
     but a new number is returned. Should be named #withBitSet:"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2531
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2532
%{  /* NOCONTEXT */
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2533
#ifndef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2534
    if (__isSmallInteger(anInteger)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2535
	int index = __intVal(anInteger);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2536
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2537
	if (index > 0) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2538
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2539
	    if (index <= 62)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2540
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2541
	    if (index <= 30)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2542
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2543
	    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2544
		INT mask = __MASKSMALLINT((INT)1 << (index-1));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2545
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2546
		RETURN ( ((OBJ) ((INT)self | (INT)mask)) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2547
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2548
	}
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2549
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2550
#endif /* not __SCHTEAM__ */
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2551
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  2552
    ^ super setBit:anInteger
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2553
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2554
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2555
     (16r401 setBit:2     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2556
     (16r30000000 setBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2557
     (16r40000000 setBit:0) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2558
     (16r0 setBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2559
     (16r0 setBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2560
     (16r0 setBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2561
     (16r0 setBit:32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2562
     (16r0 setBit:33) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2563
     (16r0 setBit:100) hexPrintString
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2564
    "
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  2565
! !
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  2566
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2567
!SmallInteger methodsFor:'byte access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2568
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2569
byteSwapped
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2570
    "lsb -> msb;
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2571
     i.e. a.b.c.d -> d.c.b.a"
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2572
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2573
    SmallInteger maxBytes == 8 ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2574
	^ self byteSwapped64
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2575
    ] ifFalse:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2576
	^ self byteSwapped32
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2577
    ].
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2578
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2579
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2580
     16r11223344 byteSwapped hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2581
     16r44332211 byteSwapped hexPrintString
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2582
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2583
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2584
    "Created: / 09-01-2012 / 23:01:33 / cg"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2585
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2586
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2587
byteSwapped16
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2588
    "for 16bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2589
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2590
     i.e. a.b -> b.a"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2591
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2592
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2593
#ifndef __SCHTEAM__
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2594
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2595
    unsigned INT swapped;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2596
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2597
    swapped = ((v>>8)&0xFF) | ((v & 0xFF)<<8);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2598
    RETURN (__mkSmallInteger(swapped));
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2599
#endif /* not __SCHTEAM__ */
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2600
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2601
    ^ super byteSwapped16
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2602
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2603
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2604
     16r1122 byteSwapped16 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2605
     16r2211 byteSwapped16 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2606
     16r332211 byteSwapped16 hexPrintString
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2607
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2608
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2609
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2610
byteSwapped32
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2611
    "for 32bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2612
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2613
     i.e. a.b.c.d -> d.c.b.a"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2614
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2615
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2616
#ifndef __SCHTEAM__
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2617
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2618
    unsigned INT swapped;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2619
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2620
# undef HAVE_BSWAP
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2621
# if __POINTER_SIZE__ == 4
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2622
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2623
#  if defined(USE_BSWAP) && defined(__BORLANDC__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2624
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2625
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2626
    _asm {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2627
	mov eax, v
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2628
	bswap eax
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2629
	mov swapped, eax
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2630
    };
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2631
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2632
#  if defined(USE_BSWAP) && defined(__VISUALC__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2633
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2634
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2635
    _asm {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2636
	mov eax, v
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2637
	xchg al, ah
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2638
	rol eax, 16
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2639
	xchg al, ah
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2640
	mov swapped, eax
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2641
    };
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2642
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2643
#  if defined(USE_BSWAP) && defined(__GNUC__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2644
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2645
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  2646
    asm("movl %1, %%eax \n\
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2647
	 bswap %%eax    \n\
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2648
	 movl %%eax, %0 \n\
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2649
	"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2650
	: "=rm"  (swapped)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2651
	: "rm"   (v));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2652
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2653
# endif /* __POINTER_SIZE__ == 4 */
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2654
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2655
# if __POINTER_SIZE__ == 8
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2656
    v &= 0xFFFFFFFF;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2657
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  2658
#  if defined(__x86_64__) && defined(__GNUC__) && !defined(__CLANG__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2659
#   define HAVE_BSWAP
19133
Claus Gittinger <cg@exept.de>
parents: 19070
diff changeset
  2660
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  2661
    asm("movq %1, %%rax \n\
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2662
	 bswap %%eax    \n\
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2663
	 movq %%rax, %0 \n\
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2664
	"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2665
	: "=rm"  (swapped)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2666
	: "rm"   (v));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2667
#  endif
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2668
# endif
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2669
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2670
# ifndef HAVE_BSWAP
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2671
    swapped = ((v>>24) | ((v>>8)&0xFF00) | ((v & 0xFF00)<<8) | ((v & 0xFF)<<24));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2672
# endif
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2673
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2674
    RETURN (__MKUINT(swapped));
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2675
#endif /* not __SCHTEAM__ */
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2676
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2677
    ^ super byteSwapped32
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2678
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2679
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2680
     16r11223344 byteSwapped32 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2681
     16r44332211 byteSwapped32 hexPrintString
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2682
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2683
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2684
    "Created: / 09-01-2012 / 23:01:33 / cg"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2685
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2686
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2687
byteSwapped64
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2688
    "for 64bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2689
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2690
     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
  2691
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2692
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2693
#ifndef __SCHTEAM__
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2694
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2695
    unsigned INT swapped;
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2696
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2697
# if __POINTER_SIZE__ == 4
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2698
    //   xxxxxxxx 00000000 00000000 00000000 -> 00000000 00000000 00000000 xxxxxxxx
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2699
    //            xxxxxxxx                                        xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2700
    //                     xxxxxxxx                      xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2701
    //                              xxxxxxxx    xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2702
    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
  2703
    RETURN(__MKLARGEINT64(1, 0, swapped));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2704
# else
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2705
    //   xxxxxxxx 00000000 00000000 00000000 -> 00000000 00000000 00000000 xxxxxxxx
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2706
    //            xxxxxxxx                                        xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2707
    //                     xxxxxxxx                      xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2708
    //                              xxxxxxxx    xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2709
    swapped =  (v>>56) | ((v>>40)&0xFF00) | ((v>>24) & 0xFF0000) | ((v>>8) & 0xFF000000)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2710
		| ((v & 0xFF000000)<<8) | ((v & 0x00FF0000)<<24) | ((v & 0x0000FF00)<<40)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2711
		| ((v & 0xFF)<<56);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2712
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2713
    RETURN(__MKUINT( swapped ));
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2714
#endif /* not __SCHTEAM__ */
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2715
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2716
    ^ super byteSwapped64
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2717
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2718
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2719
     16r11223344 byteSwapped64 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2720
     16r44332211 byteSwapped64 hexPrintString
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2721
    "
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2722
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2723
    "Created: / 09-01-2012 / 23:01:33 / cg"
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2724
!
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2725
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2726
digitAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2727
    "return 8 bits of value, starting at byte index"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2728
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2729
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2730
#ifdef __SCHTEAM__
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2731
    int idx0Based = index.intValue() - 1;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2732
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2733
    if (idx0Based <= 7) {
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2734
        long myVal = self.longValue();
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2735
        if (myVal < 0) {
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2736
            myVal = -myVal;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2737
        }
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2738
        int byteVal = (int)((myVal >> (idx0Based * 8)) & 0xFF);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2739
        return __c__._RETURN( STInteger._qnew(byteVal) );
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2740
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2741
    if (idx0Based > 0) {
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2742
        return __c__._RETURN( STInteger._0 );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2743
    }
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2744
#else
357
claus
parents: 329
diff changeset
  2745
    REGISTER INT val;
claus
parents: 329
diff changeset
  2746
    INT idx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2747
252
  2748
    if (__isSmallInteger(index)) {
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2749
        val = __intVal(self);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2750
        if (val < 0)
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2751
            val = -val;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2752
        switch (idx = __intVal(index)) {
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2753
            case 1:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2754
                break;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2755
            case 2:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2756
                val = (val >> 8);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2757
                break;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2758
            case 3:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2759
                val = (val >> 16);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2760
                break;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2761
            case 4:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2762
                val = (val >> 24);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2763
                break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2764
# if __POINTER_SIZE__ == 8
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2765
            case 5:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2766
                val = (val >> 32);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2767
                break;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2768
            case 6:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2769
                val = (val >> 40);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2770
                break;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2771
            case 7:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2772
                val = (val >> 48);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2773
                break;
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2774
            case 8:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2775
                val = (val >> 56);
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2776
                break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2777
# endif
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2778
            default:
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2779
                if (idx < 1)
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2780
                    goto bad;   /* sorry */
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2781
                RETURN (__mkSmallInteger(0));
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2782
        }
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2783
        RETURN ( __mkSmallInteger( val & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2784
    }
357
claus
parents: 329
diff changeset
  2785
  bad: ;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2786
#endif /* not __SCHTEAM__ */
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2787
%}.
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2788
    index <= 0 ifTrue:[
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2789
        "
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2790
         index less than 1 - not allowed
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2791
        "
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2792
        ^ SubscriptOutOfBoundsError
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2793
                raiseRequestWith:index
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2794
                errorString:'index out of bounds'
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2795
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2796
    ^ 0
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2797
357
claus
parents: 329
diff changeset
  2798
    "
claus
parents: 329
diff changeset
  2799
     (16r12345678 digitAt:1) printStringRadix:16
claus
parents: 329
diff changeset
  2800
     (16r12345678 digitAt:3) printStringRadix:16
claus
parents: 329
diff changeset
  2801
     (16r12345678 digitAt:15) printStringRadix:16
claus
parents: 329
diff changeset
  2802
     (16r12345678 digitAt:0) printStringRadix:16
claus
parents: 329
diff changeset
  2803
     (16r12345678 digitAt:-10) printStringRadix:16
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2804
     (16r12345678 digitAt:-10) printStringRadix:16
357
claus
parents: 329
diff changeset
  2805
    "
25214
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2806
2faf844125d9 #QUALITY by stefan
Stefan Vogel <sv@exept.de>
parents: 25017
diff changeset
  2807
    "Modified: / 29-01-2020 / 17:26:59 / Stefan Vogel"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2808
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2809
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2810
digitByteAt:index
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2811
    "return 8 bits of my signed value, starting at byte index.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2812
     For positive receivers, this is the same as #digitAt:;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2813
     for negative ones, the actual bit representation is returned."
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2814
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2815
%{  /* NOCONTEXT */
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2816
#ifdef __SCHTEAM__
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2817
    int idx0Based = index.intValue() - 1;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2818
    long myVal = self.longValue();
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2819
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2820
    if (idx0Based <= 7) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2821
	int byteVal = (int)((myVal >> (idx0Based * 8)) & 0xFF);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2822
	return __c__._RETURN( STInteger._qnew(byteVal) );
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2823
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2824
    if (idx0Based > 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2825
	if (myVal < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2826
	    return __c__._RETURN( STInteger._M1 );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2827
	} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2828
	    return __c__._RETURN( STInteger._0 );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2829
	}
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2830
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2831
#else
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2832
    REGISTER INT val;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2833
    INT idx;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2834
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2835
    if (__isSmallInteger(index)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2836
	val = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2837
	switch (idx = __intVal(index)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2838
	    case 1:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2839
		break;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2840
	    case 2:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2841
		val = (val >> 8);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2842
		break;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2843
	    case 3:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2844
		val = (val >> 16);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2845
		break;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2846
	    case 4:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2847
		val = (val >> 24);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2848
		break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2849
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2850
	    case 5:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2851
		val = (val >> 32);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2852
		break;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2853
	    case 6:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2854
		val = (val >> 40);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2855
		break;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2856
	    case 7:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2857
		val = (val >> 48);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2858
		break;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2859
	    case 8:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2860
		val = (val >> 56);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2861
		break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2862
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2863
	    default:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2864
		if (idx < 1)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2865
		    goto bad;   /* sorry */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2866
		if (val < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2867
		    RETURN (__mkSmallInteger(0xFF));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2868
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2869
		RETURN (__mkSmallInteger(0));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2870
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2871
	RETURN ( __mkSmallInteger( val & 0xFF) );
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2872
    }
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2873
  bad: ;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2874
#endif /* not __SCHTEAM__ */
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2875
%}.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2876
    index > 0 ifFalse:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2877
	"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2878
	 index less than 1 - not allowed
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2879
	"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2880
	^ self primitiveFailed
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2881
    ].
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2882
    ^ 0
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2883
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2884
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2885
     (10 digitByteAt:1) printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2886
     (10 digitByteAt:3) printStringRadix:16
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2887
     (-10 digitByteAt:1) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2888
     (-10 digitByteAt:3) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2889
    "
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2890
!
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2891
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2892
digitBytes
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2893
    "return a byteArray filled with the receiver's bits
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2894
     (8 bits of the absolute value per element),
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2895
     least significant byte is first"
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2896
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2897
    |absValue
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2898
     b1 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2899
     b2 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2900
     b3 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2901
     b4 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2902
     b5 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2903
     b6 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2904
     b7 "{ Class: SmallInteger }" digitByteArray|
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2905
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2906
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2907
     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
  2908
     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
  2909
     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
  2910
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2911
    self == 0 ifTrue: [
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2912
	^ ByteArray with:0.
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2913
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2914
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2915
    self < 0 ifTrue: [
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2916
	absValue := self negated
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2917
    ] ifFalse: [
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2918
	absValue := self.
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2919
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2920
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2921
    b1 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2922
    absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2923
    absValue == 0 ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2924
	digitByteArray := ByteArray with:b1
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2925
    ] ifFalse:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2926
	b2 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2927
	absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2928
	absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2929
	    digitByteArray := ByteArray with:b1 with:b2
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2930
	] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2931
	    b3 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2932
	    absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2933
	    absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2934
		digitByteArray := ByteArray with:b1 with:b2 with:b3
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2935
	    ] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2936
		b4 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2937
		absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2938
		absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2939
		    digitByteArray := ByteArray with:b1 with:b2 with:b3 with:b4
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2940
		] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2941
		    b5 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2942
		    absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2943
		    absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2944
			digitByteArray := ByteArray new:5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2945
			digitByteArray at:1 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2946
			digitByteArray at:2 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2947
			digitByteArray at:3 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2948
			digitByteArray at:4 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2949
			digitByteArray at:5 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2950
		    ] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2951
			b6 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2952
			absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2953
			absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2954
			    digitByteArray := ByteArray new:6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2955
			    digitByteArray at:1 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2956
			    digitByteArray at:2 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2957
			    digitByteArray at:3 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2958
			    digitByteArray at:4 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2959
			    digitByteArray at:5 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2960
			    digitByteArray at:6 put:b6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2961
			] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2962
			    b7 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2963
			    absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2964
			    absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2965
				digitByteArray := ByteArray new:7.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2966
				digitByteArray at:1 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2967
				digitByteArray at:2 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2968
				digitByteArray at:3 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2969
				digitByteArray at:4 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2970
				digitByteArray at:5 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2971
				digitByteArray at:6 put:b6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2972
				digitByteArray at:7 put:b7.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2973
			    ] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2974
				digitByteArray := ByteArray new:8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2975
				digitByteArray at:1 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2976
				digitByteArray at:2 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2977
				digitByteArray at:3 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2978
				digitByteArray at:4 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2979
				digitByteArray at:5 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2980
				digitByteArray at:6 put:b6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2981
				digitByteArray at:7 put:b7.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2982
				digitByteArray at:8 put:absValue.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2983
			    ]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2984
			]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2985
		    ]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2986
		]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2987
	    ]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  2988
	]
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2989
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2990
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2991
    ^ digitByteArray
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2992
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2993
    "
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2994
      16r12 digitBytes hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2995
      16r1234 digitBytes hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2996
      16r12345678 digitBytes hexPrintString
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2997
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2998
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2999
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3000
digitBytesMSB
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3001
    "return a byteArray filled with the receiver's bits
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  3002
     (8 bits of the absolute value per element),
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3003
     most significant byte is first"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3004
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3005
    |absValue
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3006
     b1 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3007
     b2 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3008
     b3 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3009
     b4 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3010
     b5 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3011
     b6 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3012
     b7 "{ Class: SmallInteger }" digitByteArray|
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  3013
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  3014
    "
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3015
     could have simply created a 4-byte largeinteger and normalize it.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3016
     The code below does the normalize right away, avoiding the
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3017
     overhead of producing any intermediate byte-arrays (and the scanning)
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3018
    "
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3019
    self == 0 ifTrue: [
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3020
	^ ByteArray with:0.
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3021
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3022
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3023
    self < 0 ifTrue: [
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3024
	absValue := self negated
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3025
    ] ifFalse: [
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3026
	absValue := self.
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3027
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3028
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3029
    b1 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3030
    absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3031
    absValue == 0 ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3032
	digitByteArray := ByteArray with:b1
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3033
    ] ifFalse:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3034
	b2 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3035
	absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3036
	absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3037
	    digitByteArray := ByteArray with:b2 with:b1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3038
	] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3039
	    b3 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3040
	    absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3041
	    absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3042
		digitByteArray := ByteArray with:b3 with:b2 with:b1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3043
	    ] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3044
		b4 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3045
		absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3046
		absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3047
		    digitByteArray := ByteArray with:b4 with:b3 with:b2 with:b1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3048
		] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3049
		    b5 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3050
		    absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3051
		    absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3052
			digitByteArray := ByteArray new:5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3053
			digitByteArray at:1 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3054
			digitByteArray at:2 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3055
			digitByteArray at:3 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3056
			digitByteArray at:4 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3057
			digitByteArray at:5 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3058
		    ] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3059
			b6 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3060
			absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3061
			absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3062
			    digitByteArray := ByteArray new:6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3063
			    digitByteArray at:1 put:b6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3064
			    digitByteArray at:2 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3065
			    digitByteArray at:3 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3066
			    digitByteArray at:4 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3067
			    digitByteArray at:5 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3068
			    digitByteArray at:6 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3069
			] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3070
			    b7 := absValue bitAnd:16rFF.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3071
			    absValue := absValue bitShift:-8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3072
			    absValue == 0 ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3073
				digitByteArray := ByteArray new:7.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3074
				digitByteArray at:1 put:b7.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3075
				digitByteArray at:2 put:b6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3076
				digitByteArray at:3 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3077
				digitByteArray at:4 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3078
				digitByteArray at:5 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3079
				digitByteArray at:6 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3080
				digitByteArray at:7 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3081
			    ] ifFalse:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3082
				digitByteArray := ByteArray new:8.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3083
				digitByteArray at:1 put:absValue.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3084
				digitByteArray at:2 put:b7.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3085
				digitByteArray at:3 put:b6.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3086
				digitByteArray at:4 put:b5.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3087
				digitByteArray at:5 put:b4.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3088
				digitByteArray at:6 put:b3.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3089
				digitByteArray at:7 put:b2.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3090
				digitByteArray at:8 put:b1.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3091
			    ]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3092
			]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3093
		    ]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3094
		]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3095
	    ]
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3096
	]
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3097
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3098
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3099
    ^ digitByteArray
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3100
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3101
    "
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3102
      16r12 digitBytesMSB hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3103
      16r1234 digitBytesMSB hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  3104
      16r12345678 digitBytesMSB hexPrintString
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  3105
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  3106
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  3107
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3108
digitLength
19321
1948c58602d0 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19318
diff changeset
  3109
    "return the number of bytes needed for the unsigned binary representation of the receiver.
1948c58602d0 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19318
diff changeset
  3110
     For negative receivers, the result is not defined by the language standard.
1948c58602d0 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19318
diff changeset
  3111
     ST/X returns the digitLength of its absolute value."
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3112
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3113
%{  /* NOCONTEXT */
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3114
#ifdef __SCHTEAM__
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3115
    long val = self.longValue();
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3116
    int offs = 0;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3117
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3118
    if (val < 0) val = -val;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3119
    if ((val & 0xFFFFFFFF00000000L) != 0) {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3120
        val >>= 32;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3121
        offs = 4;
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3122
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3123
    if ((val & 0xFFFF0000) != 0) {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3124
        if ((val & 0xFF000000) != 0) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3125
            offs += 4;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3126
        } else {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3127
            offs += 3;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3128
        }
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3129
    } else {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3130
        if ((val & 0x0000FF00)!= 0) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3131
            offs += 2;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3132
        } else {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3133
            offs += 1;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3134
        }
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3135
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3136
    return __c__._RETURN( STInteger._qnew(offs) );
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3137
#else
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3138
    INT val = __intVal(self);
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3139
    int offs = 0;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3140
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3141
    if (val < 0) {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3142
        val = -val;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3143
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3144
# if __POINTER_SIZE__ == 8
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3145
    if (val & 0xFFFFFFFF00000000L) {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3146
        val >>= 32;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3147
        offs = 4;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3148
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3149
# endif
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3150
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3151
    if (val & 0xFFFF0000) {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3152
        if (val & 0xFF000000) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3153
            RETURN ( __mkSmallInteger(4+offs));
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3154
        } else {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3155
            RETURN ( __mkSmallInteger(3+offs));
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3156
        }
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3157
    } else {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3158
        if (val & 0x0000FF00) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3159
            RETURN ( __mkSmallInteger(2+offs));
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3160
        } else {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3161
            RETURN ( __mkSmallInteger(1+offs));
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3162
        }
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3163
    }
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  3164
#endif /* not SCHTEAM */
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3165
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3166
    ^ self abs highBit - 1 // 8 + 1
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3167
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3168
    "
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3169
     16rFF00000000000000 digitLength
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3170
     16r-FF00000000000000 digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3171
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3172
     16rFF000000 digitLength
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3173
     16rFF0000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3174
     16rFF00 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3175
     16rFF digitLength
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3176
     16r-FF000000 digitLength
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3177
     16r-FF0000 digitLength
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3178
     16r-FF00 digitLength
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3179
     16r-FF digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  3180
    "
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3181
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3182
    "Modified: / 19-09-2017 / 16:34:26 / stefan"
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3183
!
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3184
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3185
swapBytes
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  3186
    "swap bytes pair-wise in a positive integer
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  3187
     i.e. a.b.c.d -> b.a.d.c.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3188
     The name may be misleading; actually a new integer is returned,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3189
     and the receiver is not modified.
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  3190
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  3191
     Redefined here for speed.
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  3192
     Swapping of negative integers is undefined and therefore not supported.
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  3193
     This case is handled in the superclass."
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3194
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3195
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3196
#ifndef __SCHTEAM__
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  3197
    unsigned INT v = __intVal(self);
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  3198
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  3199
    if ((INT)v >= 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3200
	unsigned INT swapped;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3201
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3202
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3203
	swapped = ((v >> 8) & 0x00FF00FF00FF00FF) | ((v & 0x00FF00FF00FF00FF) << 8);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3204
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3205
	swapped = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3206
# endif /* __POINTER_SIZE__ */
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3207
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3208
	//if (__ISVALIDINTEGER(swapped)) {   // sorry, but this does not work here if (INT)swapped would be negative
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3209
	if (swapped <= _MAX_INT) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3210
	    RETURN ( __mkSmallInteger(swapped) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3211
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3212
	RETURN (__MKUINT(swapped));
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  3213
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3214
#endif
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3215
%}.
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3216
    ^ super swapBytes
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3217
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3218
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3219
     -1 swapBytes hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3220
     16r11223344 swapBytes hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3221
     16r44332211 swapBytes hexPrintString
16873
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  3222
     self maxVal swapBytes hexPrintString
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  3223
     self maxVal swapBytes swapBytes hexPrintString
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3224
     16r1122334455667788 swapBytes hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3225
     16r11223344556677889900 swapBytes hexPrintString
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3226
    "
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3227
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  3228
    "Created: / 09-01-2012 / 23:01:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3229
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3230
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3231
!SmallInteger methodsFor:'catching messages'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3232
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3233
basicAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3234
    "catch indexed access - report an error
21756
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3235
     defined here since basicAt: in Object omits the SmallInteger check."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3236
14540
84fc4b759ad8 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14492
diff changeset
  3237
    ^ self notIndexed
21756
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3238
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3239
    "Modified (comment): / 17-05-2017 / 16:34:34 / mawalch"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3240
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3241
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3242
basicAt:index put:anObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3243
    "catch indexed access - report an error
21756
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3244
     defined here since basicAt:put: in Object omits the SmallInteger check."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3245
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3246
    self notIndexed
21756
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3247
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3248
    "Modified (comment): / 17-05-2017 / 16:34:40 / mawalch"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3249
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3250
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3251
basicSize
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3252
    "return the number of indexed instvars - SmallIntegers have none.
21756
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3253
     Defined here since basicSize in Object omits the SmallInteger check."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3254
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3255
    ^ 0
21756
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3256
19fdb5bfa327 #OTHER by mawalch
mawalch
parents: 21744
diff changeset
  3257
    "Modified (comment): / 17-05-2017 / 16:34:49 / mawalch"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3258
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3259
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3260
size
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3261
    "return the number of indexed instvars - SmallIntegers have none."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3262
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3263
    ^ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3264
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3265
5240
2a91958ba1f1 categories
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  3266
!SmallInteger methodsFor:'coercing & converting'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3267
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3268
asCharacter
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3269
    "Return a character with the receiver as ascii (actually: unicode) value"
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  3270
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3271
    ^ Character value:self
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3272
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3273
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3274
     Character value:16r61
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3275
     Character value:16r161
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3276
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3277
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3278
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3279
asFloat
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3280
    "return a Float with same value as the receiver.
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3281
     Redefined for performance (machine can do it faster)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3282
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3283
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3284
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3285
    return context._RETURN( STDouble._new((double)(self.longValue())) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3286
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3287
    OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  3288
    double dVal = (double)__intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3289
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  3290
    __qMKFLOAT(newFloat, dVal);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3291
    RETURN ( newFloat );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3292
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3293
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3294
    ^ self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3295
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3296
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3297
asLargeInteger
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3298
    "return a LargeInteger with same value as receiver.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3299
     Not for general use:
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3300
       Notice, that this returns an unnormalized large int (i.e. a large with a smallint value),
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3301
       which are normally not present in the system, and not handled correctly by many functions.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3302
       This exists only as a helper for some algorithms and converters"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3303
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3304
    ^ LargeInteger value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3305
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3306
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3307
asShortFloat
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3308
    "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
  3309
     Redefined for performance (machine can do it faster)"
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3310
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3311
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3312
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3313
    return context._RETURN( STFloat._new((float)(self.longValue())) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3314
#else
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3315
    OBJ dummy = @global(ShortFloat);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3316
    OBJ newFloat;
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3317
    float fVal = (float)__intVal(self);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3318
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  3319
    __qMKSFLOAT(newFloat, fVal);
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3320
    RETURN ( newFloat );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3321
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3322
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3323
    ^ self primitiveFailed
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3324
!
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  3325
18676
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3326
asUnsignedInt
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  3327
    "return an integer representing my unsigned INT value.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3328
     Notice, that the returned integer's size
18676
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3329
     depends heavily on the underlying INT size;
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3330
     You will get 16rFFFFFFFF on 32bit machines,
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3331
     but 16rFFFFFFFFFFFFFFFF on 64 bit machines.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3332
     So use this only for printing or certain bit operations (emulating C semantics)."
18676
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3333
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3334
%{  /* NOCONTEXT */
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3335
    INT iVal = __intVal(self);
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3336
    OBJ uiVal;
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3337
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3338
    uiVal = __MKUINT( (unsigned INT)iVal );
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3339
    RETURN ( uiVal );
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3340
%}.
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3341
    ^ self primitiveFailed
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3342
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3343
    "
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3344
     -1 asUnsignedInt hexPrintString -> 'FFFFFFFFFFFFFFFF'
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3345
     16r-8000 asUnsignedInt hexPrintString -> ''FFFFFFFFFFFF8000''
18676
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3346
    "
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3347
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  3348
    "Modified (comment): / 19-09-2017 / 16:34:01 / stefan"
18676
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3349
!
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  3350
8408
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  3351
codePoint
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  3352
    "for compatibility with Characters.
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  3353
     (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
  3354
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  3355
    ^ self
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  3356
!
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  3357
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3358
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3359
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3360
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3361
    ^ 20
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3362
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3363
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3364
signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3365
    "return a smallInteger from sign-extending the 24'th bit.
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3366
     May be useful for communication interfaces"
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3367
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3368
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3369
#ifndef __SCHTEAM__
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3370
    INT i = __intVal(self);
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3371
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  3372
    if (i & 0x800000L) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3373
	i = i | ~((INT)0xFFFFFF);
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3374
    } else {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3375
	i = i & 0x7FFFFF;
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3376
    }
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3377
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3378
    RETURN (__mkSmallInteger(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3379
#endif
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3380
%}.
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3381
    ^ self primitiveFailed
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3382
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3383
    "
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3384
     16rFFFFFF signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3385
     16r800000 signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3386
     16r7FFFFF signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3387
    "
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3388
!
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  3389
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3390
signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3391
    "return a smallInteger from sign-extending the 8'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3392
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3393
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3394
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3395
#ifndef __SCHTEAM__
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3396
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3397
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3398
    if (i & 0x80) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3399
	i = i | ~((INT)0xFF);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3400
    } else {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3401
	i = i & 0x7F;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3402
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3403
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3404
    RETURN (__mkSmallInteger(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3405
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3406
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3407
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3408
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3409
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3410
     16rFF signExtendedByteValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3411
     16r80 signExtendedByteValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3412
     16r7F signExtendedByteValue
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3413
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3414
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3415
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3416
signExtendedLongValue
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3417
    "return a smallInteger from sign-extending the 32'th bit.
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3418
     May be useful for communication interfaces"
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3419
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3420
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3421
#ifndef __SCHTEAM__
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3422
    INT i = __intVal(self);
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3423
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  3424
    if (i & 0x80000000L) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3425
	i = i | ~((INT)0xFFFFFFFF);
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3426
    } else {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3427
	i = i & 0x7FFFFFFFL;
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3428
    }
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3429
19264
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  3430
    RETURN (__MKINT(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3431
#endif
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3432
%}.
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3433
    ^ self primitiveFailed
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3434
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3435
    "
19264
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  3436
     16rFFFFFFFF signExtendedLongValue -> -1
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  3437
     16r80000000 signExtendedLongValue -> -2147483648
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  3438
     16r7FFFFFFF signExtendedLongValue -> 2147483647
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3439
    "
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3440
!
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  3441
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3442
signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3443
    "return a smallInteger from sign-extending the 16'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3444
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3445
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3446
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3447
#ifndef __SCHTEAM__
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  3448
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3449
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3450
    if (i & 0x8000) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3451
	i = i | ~((INT)0xFFFF);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3452
    } else {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3453
	i = i & 0x7FFF;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3454
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3455
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  3456
    RETURN (__mkSmallInteger(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3457
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3458
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3459
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3460
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3461
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3462
     16rFFFF signExtendedShortValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3463
     16r8000 signExtendedShortValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  3464
     16r7FFF signExtendedShortValue
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3465
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3466
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3467
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3468
!SmallInteger methodsFor:'comparing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3469
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3470
< aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3471
    "return true, if the argument is greater than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3472
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3473
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3474
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3475
    return context._RETURN( self.ltP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3476
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3477
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3478
# ifdef POSITIVE_ADDRESSES
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3479
	RETURN ( (__intVal(self) < __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3480
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3481
	/* tag bit does not change ordering */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3482
	RETURN ( ((INT)self < (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3483
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3484
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3485
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3486
	RETURN ( ((double)__intVal(self) < __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3487
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3488
#endif /* not __SCHTEAM__ */
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3489
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3490
    ^ aNumber lessFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3491
    "^ self retry:#< coercing:aNumber"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3492
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3493
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3494
<= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3495
    "return true, if the argument is greater or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3496
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3497
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3498
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3499
    return context._RETURN( self.leP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3500
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3501
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3502
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3503
# ifdef POSITIVE_ADDRESSES
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3504
	RETURN ( (__intVal(self) <= __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3505
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3506
	/* tag bit does not change ordering */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3507
	RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3508
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3509
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3510
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3511
	RETURN ( ((double)__intVal(self) <= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3512
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3513
#endif /* not __SCHTEAM__ */
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3514
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3515
    ^ (self > aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3516
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3517
    "Modified: / 31.7.2002 / 10:07:17 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3518
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3519
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3520
= aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3521
    "return true, if the argument represents the same numeric value
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3522
     as the receiver, false otherwise"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3523
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3524
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3525
#ifdef __SCHTEAM__
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3526
    if (aNumber.isNumber()) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3527
	return context._RETURN( aNumber.eqvP( self.longValue() ));
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3528
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3529
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3530
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3531
    if (aNumber == self) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3532
	RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3533
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3534
    if (! __isNonNilObject(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3535
	/* a smallint or nil */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3536
	RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3537
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3538
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3539
    if (__qIsFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3540
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3541
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3542
    if (__qIsShortFloat(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3543
	RETURN ( ((double)__intVal(self) == __shortFloatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3544
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3545
#endif /* not __SCHTEAM__ */
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3546
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3547
    ^ aNumber equalFromInteger:self
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3548
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3549
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3550
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3551
    "return true, if the argument is less than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3552
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3553
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3554
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3555
    return context._RETURN( self.gtP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3556
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3557
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3558
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3559
# ifdef POSITIVE_ADDRESSES
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3560
	RETURN ( (__intVal(self) > __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3561
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3562
	/* tag bit does not change ordering */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3563
	RETURN ( ((INT)self > (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3564
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3565
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3566
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3567
	RETURN ( ((double)__intVal(self) > __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3568
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3569
#endif /* not __SCHTEAM__ */
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3570
%}.
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3571
    ^ (aNumber < self)
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3572
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3573
    "Modified: / 31.7.2002 / 10:07:05 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3574
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3575
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3576
>= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3577
    "return true, if the argument is less or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3578
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3579
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3580
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3581
    return context._RETURN( self.geP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3582
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3583
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3584
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3585
# ifdef POSITIVE_ADDRESSES
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3586
	RETURN ( (__intVal(self) >= __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3587
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3588
	/* tag bit does not change ordering */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3589
	RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3590
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3591
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3592
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3593
	RETURN ( ((double)__intVal(self) >= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3594
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3595
#endif /* not __SCHTEAM__ */
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3596
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3597
    ^ (self < aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3598
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3599
    "Modified: / 31.7.2002 / 10:07:11 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3600
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3601
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3602
hash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3603
    "return an integer useful for hashing on value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3604
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3605
    self >= 0 ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3606
    ^ self negated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3607
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3608
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3609
hashMultiply
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3610
    "used in some squeak code to generate an alternative hash value for integers"
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3611
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3612
    |low|
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3613
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3614
    low := self bitAnd: 16r3FFF.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3615
    ^ (9741 * low
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3616
      + ((9741 * (self bitShift: -14) + (101 * low) bitAnd: 16383) * 16384))
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3617
	bitAnd: 16r0FFFFFFF
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3618
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3619
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3620
     1 hashMultiply
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3621
     2 hashMultiply
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3622
     3 hashMultiply
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3623
     100 hashMultiply
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3624
    "
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3625
!
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3626
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3627
identityHash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3628
    "return an integer useful for hashing on identity"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3629
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  3630
     self >= 0 ifTrue:[^ self].
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  3631
     ^ self negated
1963
ea26c7b9ca1d experimental: new hash value for smallInts
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3632
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  3633
    "Modified: 11.11.1996 / 18:42:14 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3634
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3635
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3636
max:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3637
    "return the receiver or the argument, whichever is greater"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3638
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3639
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3640
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3641
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3642
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3643
# if TAG_INT == 1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3644
	/* tag bit does not change ordering */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3645
	if ((INT)(self) > (INT)(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3646
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3647
	if (__intVal(self) > __intVal(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3648
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3649
	{
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3650
	    RETURN ( self );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3651
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3652
	RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3653
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3654
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3655
	if ( (double)__intVal(self) > __floatVal(aNumber) ) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3656
	    RETURN ( self );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3657
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3658
	RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3659
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3660
#endif /* not __SCHTEAM__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3661
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3662
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3663
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3664
    (self > aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3665
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3666
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3667
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3668
min:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3669
    "return the receiver or the argument, whichever is smaller"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3670
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3671
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3672
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3673
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3674
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3675
# if TAG_INT == 1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3676
	/* tag bit does not change ordering */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3677
	if ((INT)(self) < (INT)(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3678
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3679
	if (__intVal(self) < __intVal(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3680
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3681
	{
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3682
	    RETURN ( self );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3683
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3684
	RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3685
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3686
    if (__isFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3687
	if ( (double)__intVal(self) < __floatVal(aNumber) ) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3688
	    RETURN ( self );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3689
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3690
	RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3691
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3692
#endif /* not __SCHTEAM__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3693
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3694
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3695
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3696
    (self < aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3697
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3698
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3699
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3700
~= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3701
    "return true, if the arguments value is not equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3702
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3703
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3704
#ifdef __SCHTEAM__
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3705
    if (aNumber.isNumber()) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3706
	return context._RETURN( (aNumber.isEqv( self.longValue() )) ? STObject.False : STObject.True);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3707
	/* NOTREACHED */
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3708
    }
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3709
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3710
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3711
    if (aNumber == self) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3712
	RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3713
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3714
    if (! __isNonNilObject(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3715
	/* a smallint or nil */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3716
	RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3717
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3718
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3719
    if (__qIsFloatLike(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3720
	RETURN ( ((double)__intVal(self) != __floatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3721
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3722
    if (__qIsShortFloat(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3723
	RETURN ( ((double)__intVal(self) != __shortFloatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3724
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3725
#endif /* not __SCHTEAM__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3726
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3727
    ^ (self = aNumber) not
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3728
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3729
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3730
!SmallInteger methodsFor:'copying'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3731
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3732
deepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3733
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3734
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3735
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3736
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3737
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3738
10947
e01ba2c3533f deepCopy change
ab
parents: 10487
diff changeset
  3739
deepCopyUsing:aDictionary postCopySelector:postCopySelector
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3740
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3741
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3742
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3743
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3744
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3745
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3746
shallowCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3747
    "return a shallow copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3748
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3749
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3750
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3751
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3752
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3753
simpleDeepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3754
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3755
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3756
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3757
    ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3758
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3759
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  3760
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3761
!SmallInteger methodsFor:'iteration'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3762
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3763
timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  3764
    "evaluate the argument, aBlock self times.
claus
parents: 329
diff changeset
  3765
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3766
357
claus
parents: 329
diff changeset
  3767
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3768
#ifndef __SCHTEAM__
357
claus
parents: 329
diff changeset
  3769
    REGISTER INT tmp;
claus
parents: 329
diff changeset
  3770
    static struct inlineCache blockVal = __ILC0(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3771
357
claus
parents: 329
diff changeset
  3772
    tmp = __intVal(self);
claus
parents: 329
diff changeset
  3773
    if (tmp > 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3774
	if (__isBlockLike(aBlock)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3775
	 && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(0))) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3776
	    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3777
		REGISTER OBJFUNC codeVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3778
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3779
		/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3780
		 * specially tuned version for compiled blocks,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3781
		 * (the most common case)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3782
		 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3783
		if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3784
# ifdef PARANOIA
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3785
		 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3786
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3787
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3788
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3789
# 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
  3790
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3791
#                   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
  3792
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3793
# else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3794
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3795
#                   define BLOCK_ARG  rHome
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3796
		    REGISTER OBJ rHome;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3797
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3798
		    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3799
		     * home on stack - no need to refetch
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3800
		     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3801
		    rHome = __BlockInstPtr(aBlock)->b_home;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3802
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3803
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3804
		    {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3805
# ifdef __UNROLL_LOOPS__
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3806
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3807
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3808
			 * you are not supposed to program like this - I know what I do
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3809
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3810
			while (tmp > 8) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3811
			    if (InterruptPending != nil) goto interrupted0;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3812
	continue0:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3813
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3814
			    if (InterruptPending != nil) goto interrupted1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3815
	continue1:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3816
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3817
			    if (InterruptPending != nil) goto interrupted2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3818
	continue2:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3819
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3820
			    if (InterruptPending != nil) goto interrupted3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3821
	continue3:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3822
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3823
			    if (InterruptPending != nil) goto interrupted4;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3824
	continue4:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3825
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3826
			    if (InterruptPending != nil) goto interrupted5;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3827
	continue5:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3828
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3829
			    if (InterruptPending != nil) goto interrupted6;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3830
	continue6:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3831
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3832
			    if (InterruptPending != nil) goto interrupted7;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3833
	continue7:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3834
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3835
			    tmp -= 8;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3836
			}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3837
# endif /* __UNROLL_LOOPS__ */
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3838
			do {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3839
			    if (InterruptPending != nil) goto interruptedX;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3840
	continueX:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3841
			    (*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3842
			} while(--tmp);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3843
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3844
			RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3845
			if (0) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3846
# ifdef __UNROLL_LOOPS__
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3847
			    interrupted0:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3848
						__interruptL(@line); goto continue0;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3849
			    interrupted1:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3850
						__interruptL(@line); goto continue1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3851
			    interrupted2:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3852
						__interruptL(@line); goto continue2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3853
			    interrupted3:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3854
						__interruptL(@line); goto continue3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3855
			    interrupted4:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3856
						__interruptL(@line); goto continue4;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3857
			    interrupted5:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3858
						__interruptL(@line); goto continue5;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3859
			    interrupted6:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3860
						__interruptL(@line); goto continue6;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3861
			    interrupted7:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3862
						__interruptL(@line); goto continue7;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3863
# endif /* __UNROLL_LOOPS__ */
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3864
			    interruptedX:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3865
						__interruptL(@line); goto continueX;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3866
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3867
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3868
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3869
	    }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  3870
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3871
#           undef BLOCK_ARG
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3872
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3873
# ifdef NEW_BLOCK_CALL
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3874
#           define BLOCK_ARG  aBlock
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3875
#           define IBLOCK_ARG nil
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3876
# else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3877
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3878
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3879
# endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3880
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3881
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3882
	     * sorry - must check for the blocks code within the loops;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3883
	     * it could be recompiled or flushed (in the interrupt)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3884
	     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3885
	    do {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3886
		REGISTER OBJFUNC codeVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3887
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3888
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3889
		    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3890
		     * arg is a compiled block with code -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3891
		     * directly call it without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3892
		     * however, if there is an interrupt, refetch the code pointer.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3893
		     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3894
		    /* stay here, while no interrupts are pending ... */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3895
		    do {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3896
			(*codeVal)(BLOCK_ARG);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3897
			if (InterruptPending != nil) goto outerLoop;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3898
		    } while (--tmp);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3899
		    RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3900
		} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3901
		    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3902
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3903
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3904
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3905
			 * arg is a compiled block with bytecode -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3906
			 * directly call interpreter without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3907
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3908
			__interpret(aBlock, 0, nil, IBLOCK_ARG, nil, nil);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3909
		    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3910
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3911
			 * arg is something else - call it with #value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3912
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3913
			(*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3914
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3915
		}
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3916
    outerLoop: ;
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3917
	    } while (--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3918
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3919
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3920
#           undef IBLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3921
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3922
	    RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3923
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3924
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3925
	/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3926
	 * not a block-like thingy - call it with #value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3927
	 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3928
	do {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3929
	    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3930
	    (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3931
	} while(--tmp);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3932
	RETURN (self);
357
claus
parents: 329
diff changeset
  3933
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3934
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3935
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3936
    ^ super timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  3937
claus
parents: 329
diff changeset
  3938
"/    |count "{ Class: SmallInteger }" |
claus
parents: 329
diff changeset
  3939
"/
claus
parents: 329
diff changeset
  3940
"/    count := self.
claus
parents: 329
diff changeset
  3941
"/    [count > 0] whileTrue:[
claus
parents: 329
diff changeset
  3942
"/        aBlock value.
claus
parents: 329
diff changeset
  3943
"/        count := count - 1
claus
parents: 329
diff changeset
  3944
"/    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3945
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3946
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3947
to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3948
    "reimplemented as primitive for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3949
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3950
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3951
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3952
    REGISTER INT tmp, step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3953
    REGISTER INT final;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3954
    static struct inlineCache blockVal = __ILC1(0);
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3955
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3956
    if (__bothSmallInteger(incr, stop)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3957
	tmp = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3958
	final = __intVal(stop);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3959
	step = __intVal(incr);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3960
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3961
	if (__isBlockLike(aBlock)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3962
	 && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3963
	    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3964
		REGISTER OBJFUNC codeVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3965
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3966
		/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3967
		 * specially tuned version for static compiled blocks, called with
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3968
		 * home on the stack (the most common case)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3969
		 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3970
		if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3971
# ifdef PARANOIA
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3972
		 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3973
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3974
		) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3975
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3976
# 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
  3977
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3978
#                   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
  3979
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3980
# else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3981
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3982
#                   define BLOCK_ARG  rHome
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3983
		    REGISTER OBJ rHome;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3984
		    rHome = __BlockInstPtr(aBlock)->b_home;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3985
		    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
  3986
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3987
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3988
		    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3989
			if (step < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3990
			    if (step == -1) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3991
				while (tmp >= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3992
				    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3993
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3994
				    tmp--;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3995
				}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3996
			    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3997
				while (tmp >= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3998
				    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  3999
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4000
				    tmp += step;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4001
				}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4002
			    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4003
			} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4004
			    if (step == 1) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4005
				while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4006
				    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4007
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4008
				    tmp++;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4009
				}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4010
			    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4011
				while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4012
				    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4013
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4014
				    tmp += step;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4015
				}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4016
			    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4017
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4018
			RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4019
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4020
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4021
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4022
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4023
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4024
	     * sorry - must check for the blocks code within the loops;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4025
	     * it could be recompiled or flushed (in the interrupt)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4026
	     */
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4027
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4028
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4029
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4030
# 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
  4031
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4032
#           define IBLOCK_ARG nil
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4033
# else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4034
#           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
  4035
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4036
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4037
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4038
	    if (step < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4039
		while (tmp >= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4040
		    REGISTER OBJFUNC codeVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4041
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4042
		    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4043
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4044
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4045
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4046
			 * arg is a compiled block with code -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4047
			 * directly call it without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4048
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4049
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4050
		    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4051
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4052
			    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4053
			     * arg is a compiled block with bytecode -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4054
			     * directly call interpreter without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4055
			     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4056
# ifdef PASS_ARG_POINTER
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4057
			    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4058
				OBJ idx;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4059
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4060
				idx = __mkSmallInteger(tmp);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4061
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4062
			    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4063
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4064
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4065
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4066
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4067
			} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4068
			    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4069
			     * arg is something else - call it with #value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4070
			     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4071
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4072
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4073
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4074
		    tmp += step;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4075
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4076
	    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4077
		while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4078
		    REGISTER OBJFUNC codeVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4079
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4080
		    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4081
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4082
		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4083
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4084
			 * arg is a compiled block with code -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4085
			 * directly call it without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4086
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4087
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4088
		    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4089
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4090
			    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4091
			     * arg is a compiled block with bytecode -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4092
			     * directly call interpreter without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4093
			     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4094
# ifdef PASS_ARG_POINTER
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4095
			    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4096
				OBJ idx;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4097
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4098
				idx = __mkSmallInteger(tmp);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4099
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4100
			    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4101
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4102
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4103
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4104
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4105
			} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4106
			    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4107
			     * arg is something else - call it with #value:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4108
			     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4109
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4110
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4111
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4112
		    tmp += step;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4113
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4114
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4115
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4116
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4117
#           undef IBLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4118
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4119
	} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4120
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4121
	     * arg is something else - call it with #value:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4122
	     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4123
	    if (step < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4124
		while (tmp >= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4125
		    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4126
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4127
		    (*blockVal.ilc_func)(aBlock,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4128
					 @symbol(value:),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4129
					 nil, &blockVal,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4130
					 __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4131
		    tmp += step;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4132
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4133
	    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4134
		while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4135
		    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4136
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4137
		    (*blockVal.ilc_func)(aBlock,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4138
					 @symbol(value:),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4139
					 nil, &blockVal,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4140
					 __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4141
		    tmp += step;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4142
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4143
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4144
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4145
	RETURN ( self );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4146
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4147
#endif
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4148
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4149
    "/
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4150
    "/ 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
  4151
    "/ pass on to super ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4152
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4153
    ^ super to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4154
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4155
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4156
     1 to:10 by:3 do:[:i | i printNewline]
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4157
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4158
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4159
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4160
to:stop do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4161
    "evaluate aBlock for every integer between (and including) the receiver
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4162
     and the argument, stop.
357
claus
parents: 329
diff changeset
  4163
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4164
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4165
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4166
#ifndef __SCHTEAM__
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4167
    REGISTER INT tmp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4168
    INT final;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  4169
    static struct inlineCache blockVal = __ILC1(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4170
252
  4171
    if (__isSmallInteger(stop)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4172
	tmp = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4173
	final = __intVal(stop);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4174
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4175
	if (__isBlockLike(aBlock)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4176
	 && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4177
	    {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4178
		/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4179
		 * specially tuned version for the most common case,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4180
		 * where called with home on the stack
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4181
		 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4182
		REGISTER OBJFUNC codeVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4183
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4184
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  4185
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4186
# 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
  4187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4188
#                   define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4189
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4190
# else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4191
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4192
#                   define BLOCK_ARG  rHome
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4193
		    REGISTER OBJ rHome;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4194
		    rHome = __BlockInstPtr(aBlock)->b_home;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4195
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4196
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4197
		    {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4198
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4199
# ifdef PARANOIA
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4200
			if (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4201
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4202
			{
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4203
			    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4204
			     * static compiled blocks ...
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4205
			     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4206
# ifdef __UNROLL_LOOPS__
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4207
			    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4208
			     * The following code is designed to run as fast as possible;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4209
			     *  - taken branches only if interrupts are pending
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4210
			     *  - only forward branches (which are usually predicted as not taken)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4211
			     *  - unrolled the loop
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4212
			     *
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4213
			     * you are not supposed to program like this - I know what I do
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4214
			     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4215
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4216
			    INT t8 = (INT)(__mkSmallInteger(tmp+8));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4217
			    tmp = (INT)(__mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4218
			    final = (INT)(__mkSmallInteger(final));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4219
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4220
			    INT t8 = tmp+8;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4221
#  endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4222
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4223
			    for (;;) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4224
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4225
				while (t8 <= final) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4226
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4227
				    t8 += (INT)(__MASKSMALLINT(8));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4228
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4229
				    t8 += 8;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4230
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4231
				    if (InterruptPending != nil) goto interrupted0;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4232
	continue0:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4233
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4234
				    (*codeVal)(BLOCK_ARG, tmp);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4235
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4236
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4237
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4238
				    if (InterruptPending != nil) goto interrupted1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4239
	continue1:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4240
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4241
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(1)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4242
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4243
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+1));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4244
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4245
				    if (InterruptPending != nil) goto interrupted2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4246
	continue2:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4247
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4248
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(2)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4249
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4250
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+2));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4251
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4252
				    if (InterruptPending != nil) goto interrupted3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4253
	continue3:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4254
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4255
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(3)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4256
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4257
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+3));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4258
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4259
				    if (InterruptPending != nil) goto interrupted4;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4260
	continue4:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4261
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4262
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(4)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4263
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4264
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+4));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4265
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4266
				    if (InterruptPending != nil) goto interrupted5;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4267
	continue5:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4268
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4269
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(5)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4270
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4271
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+5));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4272
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4273
				    if (InterruptPending != nil) goto interrupted6;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4274
	continue6:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4275
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4276
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(6)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4277
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4278
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+6));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4279
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4280
				    if (InterruptPending != nil) goto interrupted7;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4281
	continue7:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4282
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4283
				    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(7)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4284
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4285
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+7));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4286
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4287
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4288
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4289
				    tmp += (INT)(__MASKSMALLINT(8));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4290
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4291
				    tmp += 8;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4292
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4293
				}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4294
				while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4295
				    if (InterruptPending != nil) goto interruptedX;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4296
	continueX:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4297
#  if TAG_INT==1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4298
				    (*codeVal)(BLOCK_ARG, tmp);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4299
				    tmp += (INT)(__MASKSMALLINT(1));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4300
#  else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4301
				    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4302
				    tmp++;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4303
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4304
				}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4305
				RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4306
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4307
				if (0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4308
				    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4309
				     * no discussion about those gotos ...
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4310
				     * ... its better for your CPU's pipelines
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4311
				     * (if you don't understand why, just don't argue).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4312
				     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4313
				    interrupted7:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4314
						    __interruptL(@line); goto continue7;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4315
				    interrupted6:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4316
						    __interruptL(@line); goto continue6;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4317
				    interrupted5:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4318
						    __interruptL(@line); goto continue5;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4319
				    interrupted4:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4320
						    __interruptL(@line); goto continue4;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4321
				    interrupted3:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4322
						    __interruptL(@line); goto continue3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4323
				    interrupted2:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4324
						    __interruptL(@line); goto continue2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4325
				    interrupted1:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4326
						    __interruptL(@line); goto continue1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4327
				    interrupted0:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4328
						    __interruptL(@line); goto continue0;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4329
				    interruptedX:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4330
						    __interruptL(@line); goto continueX;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4331
				}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4332
			    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4333
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4334
			    while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4335
				if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4336
				(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4337
				tmp ++;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4338
			    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4339
			    RETURN (self);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4340
# endif /* __UNROLL_LOOPS__ */
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4341
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4342
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4343
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4344
			 * mhmh - seems to be a block with dynamic code
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4345
			 * must refetch, to allow dynamic recompilation or code flush.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4346
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4347
			while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4348
			    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4349
			    if ((codeVal = __BlockInstPtr(aBlock)->b_code) == (OBJFUNC)nil) break;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4350
			    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4351
			    tmp ++;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4352
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4353
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4354
			if (tmp > final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4355
			    RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4356
			}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4357
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4358
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4359
	    }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4360
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4361
#           undef BLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4362
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4363
# 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
  4364
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4365
#           define IBLOCK_ARG nil
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4366
# else
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4367
#           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
  4368
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4369
# endif
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  4370
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4371
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4372
	     * sorry - must check for the blocks code within the loops;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4373
	     * it could be recompiled or flushed (in the interrupt)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4374
	     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4375
	    while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4376
		REGISTER OBJFUNC codeVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4377
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4378
		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4379
		    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4380
		     * arg is a compiled block with code -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4381
		     * directly call it without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4382
		     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4383
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4384
		    /* stay here, while no interrupts are pending ... */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4385
		    do {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4386
			(*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4387
			if (InterruptPending != nil) goto outerLoop;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4388
			tmp++;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4389
		    } while (tmp <= final);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4390
		    RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4391
		} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4392
		    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4393
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4394
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4395
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4396
			 * arg is a compiled block with bytecode -
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4397
			 * directly call interpreter without going through Block>>value
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4398
			 */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4399
# ifdef PASS_ARG_POINTER
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4400
			{
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4401
			    OBJ idx;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4402
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4403
			    idx = __mkSmallInteger(tmp);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4404
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4405
			}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4406
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4407
			__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4408
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4409
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4410
		    } else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4411
			/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4412
			 * arg is something else - call it with #value:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4413
			 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4414
			(*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4415
		    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4416
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4417
	    outerLoop: ;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4418
		tmp++;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4419
	    }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  4420
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4421
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  4422
#           undef IBLOCK_ARG
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4423
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4424
	    RETURN (self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4425
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4426
	/*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4427
	 * arg is something else - call it with #value:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4428
	 */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4429
	while (tmp <= final) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4430
	    if (InterruptPending != nil) __interruptL(@line);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4431
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4432
	    (*blockVal.ilc_func)(aBlock,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4433
					 @symbol(value:),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4434
					 nil, &blockVal,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4435
					 __mkSmallInteger(tmp));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4436
	    tmp++;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4437
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4438
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4439
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4440
#endif /* not __SCHTEAM__ */
400
claus
parents: 394
diff changeset
  4441
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  4442
400
claus
parents: 394
diff changeset
  4443
    "/
claus
parents: 394
diff changeset
  4444
    "/ 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
  4445
    "/ pass on to super ...
400
claus
parents: 394
diff changeset
  4446
    "/
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4447
    ^ super to:stop do:aBlock
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4448
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  4449
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  4450
     1 to:10 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  4451
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4452
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4453
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4454
!SmallInteger methodsFor:'misc math'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4455
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4456
bernoulli
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4457
    "returns the nth Bernoulli number.
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4458
     The series runs this:
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4459
	 1, 1/2, 1/6, 0, -1/30, 0, 1/42, 0, -1/30, 0, 5/66, 0, -691/2730, etc
21917
00931f45bfff #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21905
diff changeset
  4460
00931f45bfff #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21905
diff changeset
  4461
     Uses a table of the first 20 even bernoulli numbers.
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4462
     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
  4463
     Used with taylor series for tan"
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4464
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4465
    |table p|
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4466
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4467
    table := #(
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4468
		(1 6)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4469
		(-1 30)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4470
		(1 42)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4471
		(-1 30)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4472
		(5 66)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4473
		(-691 2730)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4474
		(7 6)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4475
		(-3617 510)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4476
		(43867 798)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4477
		(-174611 330)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4478
		(854513 138)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4479
		(-236364091 2730)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4480
		(8553103 6)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4481
		(-23749461029 870)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4482
		(8615841276005 14322)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4483
		(-7709321041217 510)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4484
		(2577687858367 6)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4485
		(-26315271553053477373 1919190)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4486
		(2929993913841559 6)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4487
		(-261082718496449122051 13530)
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4488
	      ).
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4489
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4490
    self even ifTrue:[
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4491
	self == 0 ifTrue:[^1].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4492
	p := table at:(self / 2).
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4493
	^ 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
  4494
    ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4495
    self == 1 ifTrue:[ ^ (1 / 2) ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4496
    ^ 0.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4497
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4498
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4499
     0 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4500
     1 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4501
     2 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4502
     3 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4503
     4 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4504
     5 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4505
     6 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4506
     8 bernoulli
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4507
     38 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4508
     40 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4509
     41 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4510
     42 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4511
    "
21917
00931f45bfff #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21905
diff changeset
  4512
00931f45bfff #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21905
diff changeset
  4513
    "Modified (comment): / 22-06-2017 / 14:38:09 / cg"
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4514
!
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  4515
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4516
divMod:aNumber
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4517
    "return an array filled with
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4518
	(self // aNumber) and (self \\ aNumber).
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4519
     The returned remainder has the same sign as aNumber.
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4520
     The following is always true:
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4521
	(receiver // something) * something + (receiver \\ something) = receiver
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4522
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4523
     Be careful with negative results: 9 // 4 -> 2, while -9 // 4 -> -3.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4524
     Especially surprising:
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4525
	-1 \\ 10 -> 9  (because -(1/10) is truncated towards next smaller integer, which is -1,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4526
			and -1 multiplied by 10 gives -10, so we have to add 9 to get the original -1).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4527
	-10 \\ 3 -> 2 (because -(10/3) is truncated towards next smaller integer, which is -4,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4528
			and -4 * 4 gives -12, so we need to add 2 to get the original -10.
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4529
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4530
     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
  4531
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4532
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4533
#ifndef __SCHTEAM__
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4534
    INT val, div, mod, mySelf;
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4535
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4536
    if (__isSmallInteger(aNumber)
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4537
     && ((val = __intVal(aNumber)) > 0)
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4538
     && ((mySelf = __intVal(self)) >= 0)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4539
	div = mySelf / val;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4540
	mod = mySelf % val;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4541
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4542
	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
  4543
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4544
#endif
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4545
%}.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4546
    ^ super divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4547
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4548
    "
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4549
     10 // 3           -> 3
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4550
     10 \\ 3           -> 1
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4551
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4552
     10 // -3          -> -4
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4553
     10 \\ -3          -> -2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4554
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4555
     -10 // 3          -> -4
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4556
     -10 \\ 3          -> 2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4557
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4558
     -10 // -3         -> 3
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4559
     -10 \\ -3         -> -1
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4560
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4561
     -78 \\ 10         2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4562
     -78 // 10         -8
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4563
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4564
     10 divMod:3       -> #(3 1)   because 3*3 + 1 = 10
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4565
     10 divMod:-3      -> #(-4 -2) because -4*-3 + (-2) = 10
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4566
     -10 divMod:3      -> #(-4 2)  because -4*3 + 2 = -10
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4567
     -10 divMod:-3     -> #(3 -1)  because -3*3 + (-1) = -10
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4568
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4569
     1000000000000000000000 divMod:3   -> #(333333333333333333333 1)
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4570
     1000000000000000000000 divMod:-3  -> #(-333333333333333333334 -2)
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4571
     -1000000000000000000000 divMod:3  -> #(-333333333333333333334 2)
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4572
     -1000000000000000000000 divMod:-3 -> #(333333333333333333333 -1)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4573
     100 factorial divMod:103
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4574
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4575
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4576
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4577
gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4578
    "return the greatest common divisor (Euclid's algorithm).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4579
     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
  4580
     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
  4581
     some code. (thanx to MessageTally)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4582
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4583
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4584
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4585
    if (__isSmallInteger(anInteger)) {
23616
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4586
        INT orgArg, ttt, selfInt, orgSelfInt, temp;
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4587
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4588
        ttt = orgArg = __intVal(anInteger);
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4589
        if (ttt) {
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4590
            selfInt = orgSelfInt = __intVal(self);
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4591
            while (ttt != 0) {
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4592
                temp = selfInt % ttt;
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4593
                selfInt = ttt;
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4594
                ttt = temp;
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4595
            }
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4596
            /*
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4597
             * since its not defined in C, what the sign of
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4598
             * a modulus result is when the arg is negative,
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4599
             * change it explicitely here ...
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4600
             */
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4601
            if ((orgArg < 0) != (orgSelfInt < 0)) {
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4602
                /* flip result's sign */
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4603
                selfInt = -selfInt;
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4604
            }
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4605
            RETURN ( __mkSmallInteger(selfInt) );
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4606
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4607
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4608
#endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4609
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4610
    ^ super gcd:anInteger
23616
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4611
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4612
    "
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4613
     45 gcd:30 15
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4614
     -45 gcd:30 15
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4615
     45 gcd:-30 -15
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4616
     -45 gcd:-30 -15
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4617
    "
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4618
af0ae1b23128 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 23498
diff changeset
  4619
    "Modified: / 18-01-2019 / 16:08:31 / Claus Gittinger"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4620
!
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4621
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4622
gcd_helper:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4623
    "same as gcd - see knuth & Integer>>gcd:"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4624
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4625
    ^ self gcd:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4626
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4627
    "Created: 1.3.1997 / 16:58:01 / cg"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4628
!
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4629
21939
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4630
integerLog10
14492
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4631
    "return the truncation of log10 of the receiver.
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4632
     The same as (self log:10) floor.
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4633
     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
  4634
     to print a number/and for conversion to a LargeInteger.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  4635
     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
  4636
     (i.e. without log)."
2
claus
parents: 1
diff changeset
  4637
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  4638
    self > 0 ifTrue:[
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4639
	self < 10000 ifTrue:[
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4640
	    self < 10 ifTrue:[^ 0].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4641
	    self < 100 ifTrue:[^ 1].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4642
	    self < 1000 ifTrue:[^ 2].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4643
	    ^ 3
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4644
	].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4645
	self < 100000000 ifTrue:[
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4646
	    self < 100000 ifTrue:[^ 4].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4647
	    self < 1000000 ifTrue:[^ 5].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4648
	    self < 10000000 ifTrue:[^ 6].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4649
	    ^ 7
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4650
	].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4651
	self < 1000000000 ifTrue:[^ 8].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4652
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4653
	SmallInteger maxBytes == 4 ifTrue:[
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4654
	    "/ on a 32 bit machine, SmallInt cannot be larger
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4655
	    ^ 9
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4656
	] ifFalse:[
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4657
	    "/ 64 bit machine
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4658
	    self < 100000000000000 ifTrue:[
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4659
		self < 10000000000 ifTrue:[^ 9].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4660
		self < 100000000000 ifTrue:[^ 10].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4661
		self < 1000000000000 ifTrue:[^ 11].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4662
		self < 10000000000000 ifTrue:[^ 12].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4663
		^ 13
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4664
	    ].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4665
	    self < 1000000000000000 ifTrue:[^ 14].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4666
	    self < 10000000000000000 ifTrue:[^ 15].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4667
	    self < 100000000000000000 ifTrue:[^ 16].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4668
	    self < 1000000000000000000 ifTrue:[^ 17].
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4669
	    ^ 18.
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4670
	].
14492
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4671
    ].
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4672
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  4673
    ^ self class
22227
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4674
	raise:(self = 0 ifTrue:[#infiniteResultSignal] ifFalse:[#domainErrorSignal])
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4675
	receiver:self
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4676
	selector:#integerLog10
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4677
	arguments:#()
eae082846c10 Remove " " after "\" at end of line in macro
Stefan Vogel <sv@exept.de>
parents: 22221
diff changeset
  4678
	errorString:'bad receiver in log10 (not strictly positive)'
21939
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4679
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4680
    "
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4681
      99 integerLog10
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4682
      100 integerLog10
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4683
      101 integerLog10
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4684
      (101 log:10) floor
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4685
      120 integerLog10
21966
0772f7aae516 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21949
diff changeset
  4686
21939
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4687
      -1 integerLog10
21966
0772f7aae516 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21949
diff changeset
  4688
      0 integerLog10
0772f7aae516 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21949
diff changeset
  4689
      Number trapInfinity:[ 0 integerLog10 ]
21939
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4690
    "
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4691
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4692
    "Created: / 02-07-2017 / 01:19:09 / cg"
22218
d501998293f7 #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22211
diff changeset
  4693
    "Modified: / 28-08-2017 / 13:53:32 / cg"
21939
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4694
!
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4695
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4696
intlog10
21966
0772f7aae516 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21949
diff changeset
  4697
    <resource: #obsolete>
21939
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4698
    "return the truncation of log10 of the receiver.
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4699
     The same as (self log:10) floor.
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4700
     Stupid implementation, which is used to find out the number of digits needed
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4701
     to print a number/and for conversion to a LargeInteger.
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4702
     Implemented that way, to allow for tiny systems (PDAs) without a Float class
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4703
     (i.e. without log)."
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4704
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4705
    ^ self integerLog10
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  4706
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4707
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4708
      99 intlog10
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4709
      100 intlog10
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4710
      101 intlog10
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4711
      (101 log:10) floor
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4712
      120 intlog10
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  4713
      -1 intlog10
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  4714
    "
21939
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4715
8c7600a5fc60 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21917
diff changeset
  4716
    "Modified: / 02-07-2017 / 01:19:05 / cg"
2
claus
parents: 1
diff changeset
  4717
! !
claus
parents: 1
diff changeset
  4718
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4719
!SmallInteger methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4720
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4721
asBCD
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4722
    "return an integer which represents the BCD encoded value of the receiver;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4723
     that is: each digit of its decimal representation is placed into a nibble
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4724
     of the result. (aka 162 -> 0x162). The BCD hex string looks like the original decimal.
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4725
     This conversion is useful for some communication protocols,
16041
989a985b6f61 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16039
diff changeset
  4726
     or control systems, which represent numbers this way..."
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4727
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4728
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4729
#ifndef __SCHTEAM__
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4730
    // the following code is a leftover from times when division was expensive;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4731
    // in modern cpu's, conditional branches are often more expensive than divisions,
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4732
    // so it is questionable, if the effort below is still worth it.
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4733
    // (and asBCD is really used seldom in some serial communication protocols
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4734
    // for control systems)
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4735
    int i;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4736
    INT _10000000s = 0, _1000000s = 0;
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4737
    INT _100000s = 0, _10000s = 0, _1000s = 0;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4738
    INT _100s = 0, _10s = 0, _1s = 0;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4739
    INT b = __intVal(self);
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4740
    unsigned INT rslt;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4741
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4742
    if (b <= 99999999) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4743
	if (b <= 255) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4744
	    // the most common case: convert bytes
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4745
	    for (i=7; i>=0; i--) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4746
		if (_100s >= 5)       _100s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4747
		if (_10s >= 5)        _10s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4748
		if (_1s >= 5)         _1s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4749
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4750
		_100s    =    (_100s<<1)       | (_10s >> 3 & 1);       _100s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4751
		_10s     =    (_10s<<1)        | (_1s >> 3 & 1);        _10s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4752
		_1s      =    (_1s<<1)         | (b >> 7 & 1);          _1s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4753
		b <<= 1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4754
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4755
	    rslt = (_100s<<8) | (_10s<<4) | _1s;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4756
	    RETURN (__MKSMALLINT( rslt) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4757
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4758
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4759
	for (i=26; i>=0; i--) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4760
	    if (_10000000s >= 5)  _10000000s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4761
	    if (_1000000s >= 5)   _1000000s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4762
	    if (_100000s >= 5)    _100000s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4763
	    if (_10000s >= 5)     _10000s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4764
	    if (_1000s >= 5)      _1000s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4765
	    if (_100s >= 5)       _100s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4766
	    if (_10s >= 5)        _10s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4767
	    if (_1s >= 5)         _1s += 3;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4768
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4769
	    _10000000s =  (_10000000s<<1)  | (_1000000s >> 3 & 1);  _10000000s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4770
	    _1000000s =   (_1000000s<<1)   | (_100000s >> 3 & 1);   _1000000s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4771
	    _100000s =    (_100000s<<1)    | (_10000s >> 3 & 1);    _100000s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4772
	    _10000s  =    (_10000s<<1)     | (_1000s >> 3 & 1);     _10000s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4773
	    _1000s   =    (_1000s<<1)      | (_100s >> 3 & 1);      _1000s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4774
	    _100s    =    (_100s<<1)       | (_10s >> 3 & 1);       _100s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4775
	    _10s     =    (_10s<<1)        | (_1s >> 3 & 1);        _10s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4776
	    _1s      =    (_1s<<1)         | (b >> 26 & 1);         _1s &= 0xF;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4777
	    b <<= 1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4778
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4779
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4780
	rslt = (_10000000s<<28)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4781
	       | (_1000000s<<24) | (_100000s<<20) | (_10000s<<16)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4782
	       | (_1000s<<12) | (_100s<<8) | (_10s<<4) | _1s;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4783
	RETURN (__MKUINT( rslt) );
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4784
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4785
#endif
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4786
%}.
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4787
    ^ super asBCD.
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4788
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4789
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4790
      99999999 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4791
      12812345 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4792
      128123 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4793
      128901 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4794
      12890 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4795
      1289 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4796
      999 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4797
      256 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4798
      255 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4799
      128 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4800
      162 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4801
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4802
      999999999 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4803
      128123456 asBCD hexPrintString
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4804
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4805
    "
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4806
!
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4807
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4808
printOn:aStream
22304
2350a5693ec5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22268
diff changeset
  4809
    "append my printstring (base 10) to aStream.
2350a5693ec5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22268
diff changeset
  4810
2350a5693ec5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22268
diff changeset
  4811
     I use #printString instead of #printOn: as basic print mechanism."
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4812
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4813
    aStream nextPutAll:(self printString)
22304
2350a5693ec5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22268
diff changeset
  4814
2350a5693ec5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22268
diff changeset
  4815
    "Modified (comment): / 10-10-2017 / 14:09:00 / cg"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4816
!
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4817
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4818
printOn:aStream base:base showRadix:showRadix
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  4819
    "append a string representation of the receiver in the specified numberBase to aStream
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  4820
     (if showRadix is true, with initial XXr)
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4821
     The base argument should be between 2 and 36."
6144
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  4822
20141
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4823
    |absBase|
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4824
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4825
    (base isInteger and:[absBase := base abs. absBase between:2 and:36]) ifTrue:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4826
	showRadix ifTrue:[
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4827
	    absBase printOn:aStream.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4828
	    aStream nextPut:$r.
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4829
	].
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4830
	aStream nextPutAll:(self printStringRadix:base)
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4831
    ] ifFalse:[
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4832
	super printOn:aStream base:base showRadix:true.
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4833
    ].
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  4834
12977
fbf5437b15fb changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12876
diff changeset
  4835
    "Created: / 07-09-2001 / 13:54:40 / cg"
fbf5437b15fb changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12876
diff changeset
  4836
    "Modified: / 02-08-2010 / 12:25:20 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4837
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4838
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4839
printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4840
    "return my printstring (base 10)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4841
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4842
    "since this was heavily used in some applications,
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  4843
     here is an exception to the rule of basing printString
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  4844
     upon the printOn: method."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  4845
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4846
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4847
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4848
    return context._RETURN( new STString( java.lang.Long.toString(self.longValue()) ));
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4849
#else
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  4850
    char buffer[30];    /* enough for 64 bit integers (21 would be enough)  */
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4851
    char *cp;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4852
    OBJ newString = nil;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4853
    INT myValue;
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4854
    int negative = 0;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4855
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4856
    if (self == __MKSMALLINT(0)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4857
	RETURN (@global(ZeroString));
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4858
//        RETURN (__MKSTRING_L("0", 1));
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4859
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4860
    myValue = __intVal(self);
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4861
    if (myValue < 0) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4862
	negative = 1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4863
	myValue = -myValue;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4864
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4865
    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
  4866
    *cp-- = '\0';
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  4867
    for ( ; myValue != 0; cp--) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4868
	*cp = '0' + (myValue % 10);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4869
	myValue /= 10;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4870
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4871
    if (negative) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4872
	*cp-- = '-';
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4873
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4874
    newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4875
    if (newString != nil) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4876
	RETURN (newString);
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4877
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4878
#endif /* not __SCHTEAM__ */
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4879
%}.
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4880
    "/ only arrive here,
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4881
    "/  when having memory problems (i.e. no space for string) ...
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4882
    ^ super printString
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4883
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4884
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4885
     1234 printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4886
     0    printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4887
     -100 printString
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4888
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4889
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 123456789012 printString ]] 180 180 180 170 180
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4890
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 12345678 printString ]]     140 150 140 150 140
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4891
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 1234 printString ]]         130 140 130 130 130
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4892
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 12 printString ]]           130 120 120 120 110
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4893
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 5 printString ]]            110 110 100 110 90
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4894
    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
  4895
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4896
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4897
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4898
printStringRadix:base
20141
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4899
    "return my printstring (optimized for bases 16, 10 and 8).
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4900
     Print digits > 0 as uppercase chars if base > 0,
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4901
     as lowercase chars if base < 0."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4902
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4903
    |s|
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4904
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4905
%{
18401
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4906
#ifdef __SCHTEAM__
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  4907
    int __base = Math.abs(base.intValue());
18401
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4908
    long myValue = self.longValue();
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4909
    java.lang.String __s;
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4910
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4911
    switch (__base) {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4912
        case 2:
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4913
            __s = java.lang.Long.toBinaryString(myValue);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4914
            break;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4915
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4916
        case 8:
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4917
            __s = java.lang.Long.toOctalString(myValue);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4918
            break;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4919
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4920
        case 10:
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4921
            __s = java.lang.Long.toString(myValue);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4922
            break;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4923
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4924
        case 16:
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4925
            __s = java.lang.Long.toHexString(myValue);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4926
            break;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4927
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4928
        default:
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4929
        {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4930
            boolean negative = false;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4931
            __s = "";
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4932
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4933
            if ((__base > 36) || (__base < 2)) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4934
                throw new SmalltalkError("invalid base: ", base);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4935
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4936
            if (myValue < 0) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4937
                negative = true;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4938
                myValue = -myValue;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4939
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4940
            while (myValue != 0) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4941
                int digit;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4942
                char ch;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4943
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4944
                digit = (int)(myValue % __base);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4945
                if (digit <= 9) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4946
                    ch = (char)('0' + digit);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4947
                } else {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4948
                    ch = (char)('A' + digit - 10);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4949
                }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4950
                __s = ch + __s;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4951
                myValue = myValue / __base;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4952
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4953
            if (negative) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4954
                __s = "-" + __s;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4955
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4956
            break;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4957
        }
18401
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4958
    }
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4959
    return context._RETURN( new STString( __s ));
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4960
#else
20141
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4961
    static char ucDigits[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4962
    static char lcDigits[] = "0123456789abcdefghijklmnopqrstuvwxyz";
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4963
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4964
    if (__isSmallInteger(base)) {
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4965
        char *digits;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4966
        INT __base;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4967
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4968
        if (self == __MKSMALLINT(0)) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4969
            RETURN (@global(ZeroString));
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4970
        }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4971
        __base = __intVal(base);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4972
        if (__base < 0) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4973
            __base = - __base;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4974
            digits = lcDigits;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4975
        } else {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4976
            digits = ucDigits;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4977
        }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4978
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4979
        if ((__base < sizeof(ucDigits)) && (__base > 1)) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4980
            char buffer[64+5];  /* for 64bit machines, base 2, plus sign, plus 0-byte */
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4981
            char *cp;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4982
            OBJ newString;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4983
            int negative = 0;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4984
            INT myValue = __intVal(self);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4985
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4986
            if (myValue < 0) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4987
                negative = 1;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4988
                myValue = -myValue;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4989
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4990
            cp = buffer + sizeof(buffer) - 1;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4991
            *cp-- = '\0';
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4992
            for (; myValue != 0; cp--) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4993
                *cp = digits[myValue % __base];
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4994
                myValue /= __base;
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4995
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4996
            if (negative) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4997
                *cp-- = '-';
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4998
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  4999
            newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5000
            if (newString != nil) {
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5001
                RETURN (newString);
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5002
            }
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5003
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5004
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5005
#endif /* not __SCHTEAM__ */
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  5006
%}.
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5007
    "/ arrive here, for bad base,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5008
    "/ or when having memory problems (i.e. no space for string) ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5009
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5010
    "/
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5011
    "/ fall back for seldom used bases
20330
01cc21bb516f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20262
diff changeset
  5012
    "/ Notice: cannot use super>>printStringRadix: here,
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5013
    "/ since that would lead to endless recursion ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5014
    "/ (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
  5015
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  5016
    s := WriteStream on:(String new:10).
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  5017
    super printOn:s base:base.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  5018
    ^ s contents.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  5019
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  5020
    "
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5021
      127 printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5022
      127 printStringRadix:-16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5023
      -127 printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5024
      -127 printStringRadix:-16
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5025
      123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5026
      123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5027
      123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5028
      123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5029
      123 printStringRadix:2
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  5030
      123 printStringRadix:1
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  5031
      35 printStringRadix:36
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  5032
      123 printStringRadix:37
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  5033
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5034
      -127 printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5035
      -123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5036
      -123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5037
      -123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5038
      -123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  5039
      -123 printStringRadix:2
20330
01cc21bb516f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20262
diff changeset
  5040
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5041
      16r3FFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5042
      16r7FFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5043
      16rFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5044
      16r3FFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5045
      16r7FFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5046
      16rFFFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5047
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5048
      16r-3FFFFFFF printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5049
      16r-40000000 printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5050
      16r-7FFFFFFF printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5051
      16r-80000000 printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5052
      16r-FFFFFFFF printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5053
      16r-3FFFFFFFFFFFFFFF printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5054
      16r-7FFFFFFFFFFFFFFF printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5055
      16r-FFFFFFFFFFFFFFFF printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5056
      16r-4000000000000000 printStringRadix:16
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5057
      16r-8000000000000000 printStringRadix:16
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  5058
    "
22268
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5059
fe294972157a #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22227
diff changeset
  5060
    "Modified: / 19-09-2017 / 16:34:40 / stefan"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5061
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5062
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5063
printfPrintString:formatString
24694
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5064
    <unsave>
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5065
7746
4a4208ef7699 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7471
diff changeset
  5066
    "non-standard, but sometimes useful.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5067
     return a printed representation of the receiver
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  5068
     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
  5069
     No checking for string overrun - the resulting string
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  5070
     must be shorter than 256 chars or else ...
21905
16dbb55ee5f8 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21823
diff changeset
  5071
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  5072
     Notice that a conversion may not be portable; for example,
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  5073
     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
  5074
     on 64bit mingw or visualc, %lld is required,
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  5075
     while other systems may be happy with a %d.
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  5076
     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
  5077
     Use at your own risk (if at all).
21905
16dbb55ee5f8 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21823
diff changeset
  5078
16dbb55ee5f8 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21823
diff changeset
  5079
     This method is NONSTANDARD and may be removed without notice;
16dbb55ee5f8 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21823
diff changeset
  5080
     it is provided to allow special conversions in very special situations.
24694
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5081
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5082
     WARNING: 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
  5083
     Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5084
24694
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5085
%{  /* STACK: 8000 */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5086
#ifndef __SCHTEAM__
25017
42c0f030b71f #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 25001
diff changeset
  5087
    char buffer[1024];
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  5088
    OBJ s;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  5089
    int len;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5090
12482
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  5091
    if (__isStringLike(formatString)) {
24694
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5092
        /*
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5093
         * actually only needed on sparc: since thisContext is
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5094
         * in a global register, which gets destroyed by printf,
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5095
         * manually save it here - very stupid ...
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5096
         */
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5097
        __BEGIN_PROTECT_REGISTERS__
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5098
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5099
        len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __intVal(self));
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5100
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5101
        __END_PROTECT_REGISTERS__
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5102
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5103
        if (len < 0) goto fail;
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5104
        if (len >= sizeof(buffer)) goto fail;
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5105
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5106
        s = __MKSTRING_L(buffer, len);
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5107
        if (s != nil) {
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5108
            RETURN (s);
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5109
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5110
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  5111
fail: ;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5112
#endif /* not __SCHTEAM__ */
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  5113
%}.
21905
16dbb55ee5f8 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21823
diff changeset
  5114
    ^ super printfPrintString:formatString
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5115
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  5116
    "
24694
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5117
        123 printfPrintString:'%%d -> %d'
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5118
        123 printfPrintString:'%%6d -> %6d'
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5119
        123 printfPrintString:'%%x -> %x'
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5120
        123 printfPrintString:'%%4x -> %4x'
65f3557c7a36 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24554
diff changeset
  5121
        123 printfPrintString:'%%04x -> %04x'
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  5122
    "
21905
16dbb55ee5f8 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21823
diff changeset
  5123
21949
ce997689ab94 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21939
diff changeset
  5124
    "Modified: / 03-07-2017 / 15:07:37 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5125
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5126
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  5127
!SmallInteger methodsFor:'private'!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  5128
23498
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5129
numberOfDigits:n8BitDigits
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5130
    "initialize the instance to store n8BitDigits.
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5131
     It is a no-op for SmallIntegers."
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5132
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5133
    ^ self.
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5134
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5135
    "Created: / 01-11-2018 / 11:29:45 / Stefan Vogel"
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5136
!
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5137
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5138
numberOfDigits:n8BitDigits sign:sign
18382
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  5139
    "private: for protocol completeness with LargeIntegers.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5140
     Returns a smallInteger with my absValue and the sign of the argument.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5141
     The method's name may be misleading: the receiver is not changed,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5142
     but a new number is returned."
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  5143
23498
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5144
    ^ self setSign:sign.
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5145
5ac499e2cc2e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 23476
diff changeset
  5146
    "Created: / 01-11-2018 / 12:15:17 / Stefan Vogel"
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  5147
! !
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  5148
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5149
!SmallInteger methodsFor:'special modulo arithmetic'!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5150
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5151
plus32:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5152
    "return the sum of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5153
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5154
     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
  5155
     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
  5156
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5157
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5158
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5159
    INT sum;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5160
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5161
    sum =  __unsignedLongIntVal(self) + __unsignedLongIntVal(aNumber);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5162
# if __POINTER_SIZE__ == 8
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5163
    sum &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5164
# endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5165
    RETURN ( __MKUINT(sum));
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5166
#endif /* not __SCHTEAM__ */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5167
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5168
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5169
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5170
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5171
     16r7FFFFFFF + 1          2147483648
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5172
     16r7FFFFFFF plus32: 1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5173
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5174
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5175
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5176
plus:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5177
    "return the sum of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5178
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5179
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5180
     smallInteger range is returned (i.e. the low bits of the sum).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5181
     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
  5182
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5183
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5184
%{  /* NOCONTEXT */
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5185
#ifdef __SCHTEAM__
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5186
    {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5187
	long myValue = self.longValue();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5188
	long otherValue = aNumber.longValue();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5189
	long sum = myValue + otherValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5190
	return context._RETURN( STInteger._new(sum) );
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5191
    }
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5192
    /* NOT REACHED */
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5193
#else
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5194
    if (__isSmallInteger(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5195
	INT sum;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5196
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5197
	sum =  __intVal(self) + __intVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5198
	if (!__ISVALIDINTEGER(sum)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5199
	    /* keep the sign */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5200
	    sum %= _MAX_INT;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5201
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5202
	RETURN ( __mkSmallInteger(sum));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5203
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5204
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5205
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5206
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5207
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5208
    "
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5209
	5 plus:-1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5210
	5 plus:1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5211
	1 plus:-5
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5212
	self maxVal plus:1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5213
	self maxVal + 1
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5214
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5215
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5216
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5217
subtract:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5218
    "return the difference of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5219
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5220
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5221
     smallInteger range is returned (i.e. the low bits of the sum).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5222
     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
  5223
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5224
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5225
%{  /* NOCONTEXT */
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5226
#ifdef __SCHTEAM__
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5227
    {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5228
	long myValue = self.longValue();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5229
	long otherValue = aNumber.longValue();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5230
	long diference = myValue - otherValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5231
	return context._RETURN( STInteger._new(diference) );
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5232
    }
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5233
    /* NOT REACHED */
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5234
#else
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5235
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5236
    if (__isSmallInteger(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5237
	INT diff;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5238
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5239
	diff = __intVal(self) - __intVal(aNumber);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5240
	if (!__ISVALIDINTEGER(diff)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5241
	    /* keep the sign */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5242
	    diff %= _MAX_INT;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5243
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5244
	RETURN ( __mkSmallInteger(diff));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5245
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5246
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5247
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5248
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5249
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5250
    "
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5251
	-1 subtract:5
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5252
	5 subtract:1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5253
	1 subtract:-5
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5254
	self minVal subtract:1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5255
	self minVal - 1
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5256
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5257
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5258
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5259
times:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5260
    "return the product of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5261
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5262
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5263
     smallInteger range is returned (i.e. the low bits of the product).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5264
     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
  5265
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5266
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5267
%{  /* NOCONTEXT */
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5268
#ifdef __SCHTEAM__
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5269
    {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5270
	long myValue = self.longValue();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5271
	long otherValue = aNumber.longValue();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5272
	long product = myValue * otherValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5273
	return context._RETURN( STInteger._new(product) );
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5274
    }
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5275
    /* NOT REACHED */
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  5276
#else
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5277
    INT myValue, otherValue;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5278
    unsigned INT productLow, productHi;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5279
    int negative;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5280
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5281
#   define low16Bits(foo)  ((foo) & 0xFFFF)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5282
#   define hi16Bits(foo)   ((foo) >> 16)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5283
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5284
#   define hi32Bits(foo)   ((foo) >> 32)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5285
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5286
    /*
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5287
     * can we use long long arithmetic ?
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5288
     *
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5289
     * long-long arithmetic seems to be buggy with some systems
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5290
     * (took me a while to find this out :-(
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5291
     * (try 10000 * 10000)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5292
     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5293
# if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5294
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5295
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5296
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5297
# if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5298
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5299
# endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5300
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5301
    if (__isSmallInteger(aNumber)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5302
	myValue = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5303
	otherValue = __intVal(aNumber);
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5304
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5305
# if defined(USE_LONGLONG_FOR_MUL)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5306
	{
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5307
#  if defined(__alpha__) && !defined(__alpha64__)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5308
#   define LONGLONG      INT64
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5309
#  else
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5310
#   define LONGLONG      long long
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5311
#  endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5312
	    LONGLONG product;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5313
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5314
	    product = (LONGLONG)myValue * (LONGLONG)otherValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5315
	    if (product < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5316
		RETURN ( __mkSmallInteger(-(INT)(-product & _MAX_INT)));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5317
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5318
	    RETURN ( __mkSmallInteger((INT)(product & _MAX_INT)));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5319
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5320
# else /* no long-long */
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5321
	negative = 1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5322
	if (myValue < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5323
	    negative = -1;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5324
	    myValue = -myValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5325
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5326
	if (otherValue < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5327
	    negative = -negative;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5328
	    otherValue = -otherValue;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5329
	}
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5330
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5331
#  if defined(__GNUC__) && defined(__mc68k__)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5332
	asm ("mulu%.l %3,%1:%0"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5333
		: "=d"  ((unsigned long)(productLow)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5334
		  "=d"  ((unsigned long)(productHi))
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5335
		: "%0"  ((unsigned long)(myValue)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5336
		  "dmi" ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5337
#  else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  5338
#   if defined (__GNUC__) && defined(__x86__)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5339
	asm ("mull %3"
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5340
		: "=a"  ((unsigned long)(productLow)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5341
		  "=d"  ((unsigned long)(productHi))
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5342
		: "%0"  ((unsigned long)(myValue)),
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5343
		  "rm"  ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5344
#   else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  5345
#    if defined(__win32__) && defined(__BORLANDC__)
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5346
	asm {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5347
	    mov   eax, myValue
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5348
	    mov   edx, otherValue
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5349
	    mul   edx
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5350
	    mov   productLow, eax
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5351
	    mov   productHi, edx
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5352
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5353
#    else /* generic */
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5354
	{
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5355
	    unsigned INT pHH, pHL, pLH, pLL;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5356
	    unsigned INT low1, low2, hi1, hi2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5357
	    unsigned INT t;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5358
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5359
	    /* unsigned multiply myValue * otherValue -> productHi, productLow
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5360
	     *
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5361
	     * this is too slow:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5362
	     * since most machines can do 32*32 to 64 bit multiply,
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5363
	     * (or at least 32*32 with Overflow check)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5364
	     * - need more assembler (inline) functions here
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5365
	     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5366
#     if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5367
	    low1 = low32Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5368
	    hi1 = hi32Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5369
	    low2 = low32Bits((unsigned INT)otherValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5370
	    hi2 = hi32Bits((unsigned INT)otherValue);
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5371
#      undef LLMASK
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  5372
#      define LLMASK 0xC000000000000000LL
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5373
#     else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5374
	    low1 = low16Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5375
	    hi1 = hi16Bits((unsigned INT)myValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5376
	    low2 = low16Bits((unsigned INT)otherValue);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5377
	    hi2 = hi16Bits((unsigned INT)otherValue);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5378
#      define LLMASK 0xC0000000
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5379
#     endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5380
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5381
	    pLH = low1 * hi2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5382
	    pHL = hi1 * low2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5383
	    pLL = low1 * low2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5384
	    pHH = hi1 * hi2;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5385
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5386
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5387
	     * the common case ...
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5388
	     */
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5389
	    if ((pHL == 0)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5390
	     && (pLH == 0)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5391
	     && (pHH == 0)
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5392
	     && ((pLL & LLMASK) == 0)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5393
		if (negative < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5394
		    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5395
		}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5396
		RETURN ( __mkSmallInteger((INT)pLL) );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5397
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5398
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5399
	    /*
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5400
	     *   pHH |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5401
	     *   pLH          |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5402
	     *   pHL          |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5403
	     *   pLL                   |--------|--------|
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5404
	     */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5405
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5406
#     if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5407
	    t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5408
	    productLow = (t << 32) + low32Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5409
	    productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5410
#     else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5411
	    t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5412
	    productLow = (t << 16) + low16Bits(pLL);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5413
	    productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5414
#     endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5415
	}
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  5416
#    endif /* ! __win32__ */
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  5417
#   endif /* ! (__GNUC__ && __x86__) */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5418
#  endif /* ! (__GNUC__ && __mc68k__) */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5419
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5420
	if (negative < 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5421
	    RETURN ( __mkSmallInteger(-(INT)(productLow & _MAX_INT)));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5422
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5423
	RETURN ( __mkSmallInteger((INT)(productLow & _MAX_INT)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5424
# endif /* ! USE_LONGLONG */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5425
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5426
#endif /* not __SCHTEAM__ */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5427
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5428
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5429
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5430
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5431
    "
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5432
	5 times:-1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5433
	5 times:1
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5434
	self maxVal-1 times:2
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5435
	self maxVal-1 times:-2
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5436
	self maxVal-1 * 2  bitAnd:16r3fffffff
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5437
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5438
! !
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5439
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5440
!SmallInteger methodsFor:'special modulo bit operators'!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5441
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5442
bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5443
    "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
  5444
     (changes the sign)"
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5445
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5446
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5447
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5448
    unsigned INT v;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5449
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5450
    v = __intVal(self);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5451
    v = ~v;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5452
# if __POINTER_SIZE__ == 8
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5453
    v &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5454
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5455
    RETURN ( __MKUINT(v) );
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5456
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5457
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5458
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5459
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5460
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5461
     1 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5462
     16r40000000 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5463
     16r80000000 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5464
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5465
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5466
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5467
bitRotate32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5468
    "return the value of the receiver rotated by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5469
     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
  5470
     Rotates through the sign bit.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5471
     Useful for crypt algorithms, or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5472
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5473
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5474
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5475
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5476
    unsigned INT bits;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5477
    int count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5478
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5479
    if (__isSmallInteger(shiftCount)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5480
	count = __intVal(shiftCount);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5481
	count = count % 32;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5482
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5483
	bits = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5484
	if (count > 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5485
	    bits = (bits << count) | (bits >> (32-count));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5486
	} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5487
	    bits = (bits >> (-count)) | (bits << (32-(-count)));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5488
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5489
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5490
	bits &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5491
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5492
	RETURN (__MKUINT(bits));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5493
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5494
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5495
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5496
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5497
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5498
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5499
     128 rotate32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5500
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5501
     1 rotate32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5502
     1 rotate32:2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5503
     1 rotate32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5504
     1 rotate32:32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5505
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5506
     1 rotate32:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5507
     1 rotate32:-2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5508
     1 rotate32:-3
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5509
     1 rotate32:-32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5510
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5511
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5512
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5513
bitShift32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5514
    "return the value of the receiver shifted by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5515
     but only within 32 bits, shifting into/out-of the sign bit.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5516
     May be useful for communication interfaces, to create ST-numbers
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5517
     from a signed 32bit int value given as individual bytes,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5518
     or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5519
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5520
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5521
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5522
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5523
    INT bits, count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5524
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5525
    if (__isSmallInteger(shiftCount)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5526
	count = __intVal(shiftCount);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5527
	if (count >= 32) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5528
	    RETURN (__mkSmallInteger(0));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5529
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5530
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5531
	bits = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5532
	if (count > 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5533
	    bits = bits << count;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5534
	} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5535
	    bits = bits >> (-count);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5536
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5537
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5538
	bits &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5539
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5540
	RETURN (__MKINT(bits));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5541
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5542
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5543
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5544
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5545
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5546
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5547
     128 bitShift:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5548
     128 bitShift32:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5549
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5550
     1 bitShift:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5551
     1 bitShift32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5552
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5553
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5554
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5555
bitXor32:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5556
    "return the xor of the receiver and the argument.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5557
     The argument must be another SmallInteger or a 4-byte LargeInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5558
     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
  5559
     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
  5560
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5561
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5562
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5563
    INT rslt;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5564
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5565
    rslt =  __unsignedLongIntVal(self) ^ __unsignedLongIntVal(aNumber);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5566
# if __POINTER_SIZE__ == 8
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5567
    rslt &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5568
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5569
    RETURN ( __MKUINT(rslt));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5570
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5571
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5572
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5573
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5574
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5575
     16r7FFFFFFF bitXor: 16r80000000          4294967295
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5576
     16r7FFFFFFF bitXor32: 16r80000000
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5577
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5578
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5579
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5580
unsignedBitShift32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5581
    "return the value of the receiver shifted by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5582
     but only within 32 unsigned bits.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5583
     May be useful for communication interfaces, to create ST-numbers
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5584
     from an unsigned 32bit int value given as individual byte,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5585
     or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5586
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5587
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5588
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5589
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5590
    unsigned INT bits;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5591
    INT count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5592
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5593
    if (__isSmallInteger(shiftCount)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5594
	count = __intVal(shiftCount);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5595
	if (count >= 32) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5596
	    RETURN (__mkSmallInteger(0));
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5597
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5598
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5599
	bits = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5600
	if (count > 0) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5601
	    bits = bits << count;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5602
	} else {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5603
	    bits = bits >> (-count);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5604
	}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5605
# if __POINTER_SIZE__ == 8
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5606
	bits &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5607
# endif
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5608
	RETURN (__MKUINT(bits));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5609
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5610
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5611
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5612
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5613
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5614
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5615
     128 unsignedBitShift:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5616
     128 unsignedBitShift32:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5617
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5618
     1 unsignedBitShift:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5619
     1 unsignedBitShift32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5620
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5621
     -1 unsignedBitShift32:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5622
     -1 unsignedBitShift32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5623
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5624
! !
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5625
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5626
!SmallInteger methodsFor:'testing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5627
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5628
between:min and:max
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5629
    "return true if the receiver is greater than or equal to the argument min
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5630
     and less than or equal to the argument max.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5631
     - reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5632
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5633
%{  /* NOCONTEXT */
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5634
#ifdef __SCHTEAM__
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5635
    if (STObject.bothSmallInteger(min, max)) {
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5636
	long myVal = ((STInteger)self).longValue();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5637
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5638
	if (myVal >= ((STInteger)min).longValue()) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5639
	    if (myVal <= ((STInteger)max).longValue()) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5640
		return __c__._RETURN_true();
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5641
	    }
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5642
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5643
	return __c__._RETURN_false();
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5644
    }
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5645
#else /* not SCHTEAM */
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5646
    if (__bothSmallInteger(min, max)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5647
# if TAG_INT == 1
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5648
	// tag bit does not change the magnitude order
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5649
	if ((INT)self < (INT)(min)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5650
	     RETURN ( false );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5651
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5652
	if ((INT)self > (INT)(max)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5653
	     RETURN ( false );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5654
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5655
	RETURN ( true );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5656
# else
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5657
	REGISTER INT selfVal;
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5658
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5659
	selfVal = __intVal(self);
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5660
	if (selfVal < __intVal(min)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5661
	     RETURN ( false );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5662
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5663
	if (selfVal > __intVal(max)) {
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5664
	     RETURN ( false );
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5665
	}
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5666
	RETURN ( true );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5667
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5668
    }
18289
Claus Gittinger <cg@exept.de>
parents: 18255
diff changeset
  5669
#endif /* not SCHTEAM */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5670
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5671
    (self < min) ifTrue:[^ false].
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5672
    (max < self) ifTrue:[^ false].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5673
    ^ true
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5674
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5675
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5676
even
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5677
    "return true, if the receiver is even"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5678
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5679
%{  /* NOCONTEXT */
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5680
#ifdef __SCHTEAM__
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5681
    return __c__._RETURN( self.isEven() ? STObject.True : STObject.False );
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5682
    /* NOTREACHED */
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5683
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5684
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true );
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5685
#endif /* not SCHTEAM */
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5686
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5687
    ^ super even
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5688
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5689
23357
ec2dcc40a786 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 22784
diff changeset
  5690
isImmediate
24186
b3f0d3eb4ec0 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24168
diff changeset
  5691
    "return true if I am an immediate object
b3f0d3eb4ec0 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24168
diff changeset
  5692
     i.e. I am represented in the pointer itself and
b3f0d3eb4ec0 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24168
diff changeset
  5693
     no real object header/storage is used by me."
b3f0d3eb4ec0 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24168
diff changeset
  5694
23357
ec2dcc40a786 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 22784
diff changeset
  5695
    ^ true
ec2dcc40a786 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 22784
diff changeset
  5696
ec2dcc40a786 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 22784
diff changeset
  5697
    "Created: / 18-09-2018 / 14:48:22 / Stefan Vogel"
24186
b3f0d3eb4ec0 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24168
diff changeset
  5698
    "Modified (comment): / 27-05-2019 / 15:38:29 / Claus Gittinger"
23357
ec2dcc40a786 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 22784
diff changeset
  5699
!
ec2dcc40a786 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 22784
diff changeset
  5700
24699
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5701
isPowerOf2
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5702
    "return true, if the receiver is a power of 2"
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5703
19057
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5704
    "/ 0 is not a power of two, because ld(0) is -INF
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5705
    ^ ((self bitAnd:(self - 1)) == 0) and:[self ~~ 0]
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5706
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5707
    "
24699
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5708
     0 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5709
     1 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5710
     2 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5711
     3 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5712
     4 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5713
     5 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5714
     16r8000000000000000 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5715
     16r8000000000000001 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5716
     16r40000000 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5717
     16r80000000 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5718
     16r100000000 isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5719
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5720
     10000 factorial isPowerOf2
c19cf1b78963 #REFACTORING by exept
Claus Gittinger <cg@exept.de>
parents: 24694
diff changeset
  5721
     |n| n := 10000 factorial. Time millisecondsToRun:[10000 timesRepeat:[ n isPowerOf2]]
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5722
    "
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5723
!
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5724
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5725
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5726
    "return true, if the receiver is less than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5727
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5728
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5729
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5730
#ifdef __SCHTEAM__
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5731
    return context._RETURN( self.isLt_0() ? STObject.True : STObject.False);
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  5732
    /* NOTREACHED */
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  5733
#else
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5734
# if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5735
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5736
    RETURN ( ((INT)(self) < 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5737
# else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5738
    RETURN ( (__intVal(self) < 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5739
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5740
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5741
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5742
    ^ self < 0
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5743
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5744
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5745
nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5746
    "return the power of 2 at or above the receiver.
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5747
     Useful for padding.
19060
2fe260c4796a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19057
diff changeset
  5748
     Notice, that for a powerOf2, the receiver is returned.
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  5749
     Also notice, that (because it is used for padding),
19060
2fe260c4796a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19057
diff changeset
  5750
     0 is returned for zero."
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5751
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5752
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5753
#ifndef __SCHTEAM__
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5754
    INT x;
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5755
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5756
    x = __intVal(self) - 1;
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5757
    x |= (x >> 1);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5758
    x |= (x >> 2);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5759
    x |= (x >> 4);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5760
    x |= (x >> 8);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5761
    x |= (x >> 16);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5762
# if __POINTER_SIZE__ == 8
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5763
    x |= (x >> 32);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5764
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5765
    RETURN (__MKINT(x + 1));
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5766
#endif
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5767
%}.
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5768
    ^ super nextPowerOf2
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5769
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5770
    "
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5771
     0 nextPowerOf2
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5772
     1 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5773
     2 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5774
     3 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5775
     4 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5776
     5 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5777
     6 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5778
     7 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5779
     8 nextPowerOf2
19060
2fe260c4796a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19057
diff changeset
  5780
     9 nextPowerOf2
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5781
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5782
     22 nextPowerOf2
21107
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5783
     32 nextPowerOf2
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5784
     16rFFFF nextPowerOf2 = 16r10000
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5785
     16rFFFFFFFF nextPowerOf2 = 16r100000000
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5786
     16r1FFFFFFFFFFFFFFF nextPowerOf2 = 16r2000000000000000
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5787
     16r3FFFFFFFFFFFFFFF nextPowerOf2 = 16r4000000000000000
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5788
     16r7FFFFFFFFFFFFFFF nextPowerOf2 = 16r8000000000000000
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5789
     16rFFFFFFFFFFFFFFFF nextPowerOf2 = 16r10000000000000000
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5790
     10 factorial nextPowerOf2
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5791
     20 factorial nextPowerOf2
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5792
     100 factorial nextPowerOf2
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5793
    "
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5794
!
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5795
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5796
odd
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5797
    "return true, if the receiver is odd"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5798
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5799
%{  /* NOCONTEXT */
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5800
#ifdef __SCHTEAM__
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5801
    return __c__._RETURN( self.isEven() ? STObject.False : STObject.True );
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5802
    /* NOTREACHED */
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5803
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5804
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5805
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5806
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5807
    ^ super odd
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5808
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5809
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5810
parityOdd
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5811
    "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
  5812
     (i.e. true for odd parity)
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5813
     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
  5814
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5815
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5816
#ifndef __SCHTEAM__
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5817
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5818
    // tricky, but very fast (google for it, to understand)
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5819
    unsigned INT v = __intVal(self);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5820
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5821
# if __POINTER_SIZE__ == 8
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5822
    v ^= v >> 32;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5823
# endif
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5824
    v ^= v >> 16;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5825
    v ^= v >> 8;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5826
    v ^= v >> 4;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5827
    v &= 0xf;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5828
    RETURN ( ( (0x6996 >> v) & 1 ) ? true : false );
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5829
#endif
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5830
%}.
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5831
    ^ super parityOdd
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5832
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5833
    "
21700
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5834
	self assert:
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5835
	 (((0 to:255) collect:[:i | i parityOdd ifTrue:1 ifFalse:0])
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5836
	    asByteArray collect:[:c | c + $0 asciiValue]) asString
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5837
	 =
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5838
	    '0110100110010110100101100110100110010110011010010110100110010110100101100110100101101001100101100110100110010110100101100110100110010110011010010110100110010110011010011001011010010110011010010110100110010110100101100110100110010110011010010110100110010110'
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5839
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5840
	self assert:(16r0FFFFFFF parityOdd = 16r0FFFFFFF bitCount odd).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5841
	self assert:(16r1FFFFFFF parityOdd = 16r1FFFFFFF bitCount odd).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5842
	self assert:(16r3FFFFFFF parityOdd = 16r3FFFFFFF bitCount odd).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5843
	self assert:(16r7FFFFFFF parityOdd = 16r7FFFFFFF bitCount odd).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5844
	self assert:(16rFFFFFFFF parityOdd = 16rFFFFFFFF bitCount odd).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5845
	self assert:(16r3FFFFFFFFFFFFFFF parityOdd = 16r3FFFFFFFFFFFFFFF bitCount odd).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5846
	self assert:(16r7FFFFFFFFFFFFFFF parityOdd = 16r7FFFFFFFFFFFFFFF bitCount odd).
bbf70646dfb6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 21444
diff changeset
  5847
	self assert:(16rFFFFFFFFFFFFFFFF parityOdd = 16rFFFFFFFFFFFFFFFF bitCount odd).
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5848
    "
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5849
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5850
    "Modified (comment): / 09-01-2012 / 19:55:37 / cg"
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5851
!
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5852
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5853
positive
18864
5f4e0d1f6df1 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18849
diff changeset
  5854
    "return true, if the receiver is greater or equal to zero (not negative)
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5855
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5856
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5857
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5858
#ifdef __SCHTEAM__
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5859
    return context._RETURN( self.isGe_0() ? STObject.True : STObject.False);
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5860
    /* NOTREACHED */
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  5861
#else
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5862
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5863
# if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5864
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5865
    RETURN ( ((INT)(self) >= 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5866
# else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5867
    RETURN ( (__intVal(self) >= 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5868
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5869
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5870
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5871
    ^ super positive
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5872
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5873
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5874
sign
7471
c5d4bd612d9f comments
Claus Gittinger <cg@exept.de>
parents: 7438
diff changeset
  5875
    "return the sign of the receiver (-1, 0 or 1).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5876
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5877
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5878
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5879
#ifndef __SCHTEAM__
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5880
# if TAG_INT <= 1 /* tag in low bit */
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5881
    RETURN ( __mkSmallInteger( (((INT)self) > TAG_INT) - (((INT)self) < 0) ) );
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5882
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  5883
    INT val = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5884
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5885
    RETURN ( __mkSmallInteger( (val > 0) - (val < 0) ) );
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5886
# endif
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5887
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5888
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5889
    ^ super sign
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5890
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5891
    "
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5892
     -5 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5893
     -1 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5894
     0 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5895
     1 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5896
     5 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5897
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5898
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5899
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5900
strictlyPositive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5901
    "return true, if the receiver is greater than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5902
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5903
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5904
%{  /* NOCONTEXT */
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5905
#ifdef __SCHTEAM__
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5906
    return context._RETURN( self.isGt_0() ? STObject.True : STObject.False);
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5907
    /* NOTREACHED */
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5908
#else
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5909
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5910
# if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5911
    /* tag bit does not change sign */
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5912
    RETURN ( ((INT)(self) > (INT)(__mkSmallInteger(0))) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5913
# else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5914
    RETURN ( (__intVal(self) > 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5915
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5916
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5917
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5918
    ^ super strictlyPositive
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5919
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5920
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5921
     0 strictlyPositive
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5922
     1 strictlyPositive
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5923
     -1 strictlyPositive
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5924
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5925
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5926
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  5927
!SmallInteger class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5928
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5929
version
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  5930
    ^ '$Header$'
12482
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  5931
!
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  5932
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  5933
version_CVS
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  5934
    ^ '$Header$'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5935
! !
14755
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
  5936
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  5937
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  5938
SmallInteger initialize!