SmallInteger.st
author Jan Vrany <jan.vrany@labware.com>
Thu, 25 Mar 2021 20:30:03 +0000
branchjv
changeset 25411 248600ba8fd9
parent 23107 40173e082cbc
child 25426 963f86568b2d
permissions -rw-r--r--
Fix unlikely but possible race in `WeakValueDictionary` It may happen that value in `valueArray` could have been already collected by the GC but #clearDeadSlots have not yet been called. When this happened, `#at:ifAbsentPut:` returned tombstone rather than updating the dictionary with value from block. This commit fixes this by checking whether `valueArray` contain the tombstone and if so, clearing up the dead slots and restarting the operation. HTH.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
23107
40173e082cbc Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 23103
diff changeset
     3
 COPYRIGHT (c) 2018 Jan Vrany
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
     4
              All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
"
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    13
"{ Package: 'stx:libbasic' }"
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
    14
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
    15
"{ NameSpace: Smalltalk }"
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
    16
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    17
Integer subclass:#SmallInteger
20819
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    18
	instanceVariableNames:''
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    19
	classVariableNames:'ZeroString'
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    20
	poolDictionaries:''
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
    21
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    22
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    23
14755
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    24
!SmallInteger primitiveDefinitions!
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    25
%{
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    26
#include <stdio.h>
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    27
%}
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    28
! !
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
    29
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    30
!SmallInteger class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    31
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
 COPYRIGHT (c) 1988 by Claus Gittinger
23107
40173e082cbc Copyright updates
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 23103
diff changeset
    35
 COPYRIGHT (c) 2018 Jan Vrany
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
    36
              All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    47
documentation
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    48
"
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    49
    SmallIntegers are Integers in the range of at least +/- 2^30
19318
Claus Gittinger <cg@exept.de>
parents: 19317
diff changeset
    50
    i.e. 31 bits, but this is not a guaranteed:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
    51
        on an alpha or x86_64, 63 bits are used, if the system was configured for 64bit mode.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
    52
        under the Schteam-VM, 64 bits are used (i.e. a full long integer)
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    53
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    54
    These are no real objects - they have no instances (not even storage !!)
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    55
    and cannot be subclassed.
21155
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    56
    The reason is to save both storage and runtime by not boxing and
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    57
    garbage collecting SmallIntegers in the system. 
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    58
    SmallInts are marked by having the TAG_INT
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    59
    bit set, in contrast to all other objects which do not.
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    60
    Since this knowledge is hardwired into the system (and there is no
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
    61
    class-field stored with SmallIntegers) there can be no subclass of
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    62
    SmallInteger (sorry).
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    63
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    64
    If you really need this kind of thing, create a subclass of Integer,
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    65
    with an instance variable holding the value.
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    66
21155
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    67
    Because the range and sharing of SmallIntegers is different among implementations
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    68
    (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
    69
    you should not depend on the identity of two integers with the same value.
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    70
    For portable code, when comparing integers, use #'=' and #'~=' (instead of #'==' / #'~~'), 
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
    71
    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
    72
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    73
    [author:]
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
    74
        Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    75
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1506
diff changeset
    76
    [see also:]
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
    77
        Number
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
    78
        Float Fraction FixedPoint
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
    79
        LargeInteger
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    80
"
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
    81
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    82
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    83
!SmallInteger class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
basicNew
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    87
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    88
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    90
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    91
a27a279701f8 Initial revision
claus
parents:
diff changeset
    92
basicNew:size
a27a279701f8 Initial revision
claus
parents:
diff changeset
    93
    "catch instance creation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    94
     - SmallIntegers cannot be created with new"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    95
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
    self error:'instances of SmallInteger cannot be created with new'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    97
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    98
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
    99
!SmallInteger class methodsFor:'bit mask constants'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   100
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   101
bitMaskFor:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   102
    "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
   103
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   104
    (index between:1 and:SmallInteger maxBits) ifFalse:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   105
        ^ SubscriptOutOfBoundsSignal
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   106
                raiseRequestWith:index
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   107
                errorString:'index out of bounds'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   108
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   109
    ^ 1 bitShift:(index - 1)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   110
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   111
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   112
!SmallInteger class methodsFor:'class initialization'!
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   113
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   114
initialize
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   115
    ZeroString := '0'
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   116
! !
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
   117
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   118
!SmallInteger class methodsFor:'constants'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
maxBits
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   121
    "return the number of bits in instances of me.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   122
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   125
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   126
    // longs are always 64bits
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   127
    return context._RETURN ( STInteger._new(64) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   128
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   129
    RETURN ( __mkSmallInteger(N_INT_BITS) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   130
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
%}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   132
    "
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   133
     SmallInteger maxBits
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   134
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   135
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   136
a27a279701f8 Initial revision
claus
parents:
diff changeset
   137
maxBytes
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   138
    "return the number of bytes in instances of me.
19486
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   139
     For very special uses only - not constant across implementations.
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   140
     Notice: this is inlined by the compiler(s) as a constant,
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   141
     therefore, a query like 'SmallInteger maxBytes == 8'
359a8beaee4e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19321
diff changeset
   142
     costs nothing; it is compiled in as a constant."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   143
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   145
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   146
    // longs are always 8 bytes
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   147
    return context._RETURN ( STInteger._new(8) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   148
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   149
    RETURN ( __mkSmallInteger(N_INT_BITS / 8 + 1) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   150
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
%}
3684
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   152
    "
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   153
     SmallInteger maxBytes
5ee1baf09f4f comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
   154
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   155
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   156
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
maxVal
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   158
    "return the largest Integer representable as SmallInteger.
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   159
     For very special uses only - not constant across implementations"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
a27a279701f8 Initial revision
claus
parents:
diff changeset
   161
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   162
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   163
    return context._RETURN ( STInteger._MAX_INTVAL );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   164
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   165
    RETURN ( __mkSmallInteger(_MAX_INT) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   166
#endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   167
%}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   168
    "
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   169
     SmallInteger maxVal
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   170
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   171
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   172
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   173
minVal
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   174
    "return the smallest Integer representable as SmallInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   175
     For very special uses only - not constant across implementations"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   176
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   177
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   178
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   179
    return context._RETURN ( STInteger._MIN_INTVAL );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   180
#else
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
   181
    RETURN ( __mkSmallInteger(_MIN_INT) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   182
#endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   183
%}
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   184
    "
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   185
     SmallInteger minVal
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   186
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   187
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   188
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
   189
!SmallInteger class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   190
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   191
canBeSubclassed
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   192
    "return true, if its allowed to create subclasses of the receiver.
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   193
     Return false here - since it is NOT possible for SmallInteger
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   194
     (due to the tagged representation of SmallIntegers)"
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   195
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   196
    ^ false
3914
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   197
1aa1ab6edb7e comment change
Claus Gittinger <cg@exept.de>
parents: 3909
diff changeset
   198
    "Modified: / 5.11.1998 / 16:11:27 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   199
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
2672
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   201
hasImmediateInstances
4661
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   202
    "return true if this class has immediate instances
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   203
     i.e. if the instances are represented in the pointer itself and
9ebc7608738d comment
Claus Gittinger <cg@exept.de>
parents: 4644
diff changeset
   204
     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
   205
     Redefined from Behavior"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   206
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   207
    ^ true
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   208
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   209
    "Created: 3.6.1997 / 12:01:26 / cg"
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   210
!
dc3662188b2c added #hasImmediateInstances for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   211
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   212
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   213
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   214
     Here, true is returned."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   215
a27a279701f8 Initial revision
claus
parents:
diff changeset
   216
    ^ true
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   217
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1208
diff changeset
   218
    "Modified: 23.4.1996 / 16:00:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   219
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   220
a27a279701f8 Initial revision
claus
parents:
diff changeset
   221
!SmallInteger methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   222
a27a279701f8 Initial revision
claus
parents:
diff changeset
   223
* aNumber
11728
0c197f1c3cd0 comment
Claus Gittinger <cg@exept.de>
parents: 11718
diff changeset
   224
    "return the product of the receiver and the argument"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   225
a27a279701f8 Initial revision
claus
parents:
diff changeset
   226
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   227
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   228
    return context._RETURN( self.times( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   229
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   230
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   231
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   232
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   233
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   234
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   235
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   236
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   237
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   238
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   239
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   240
    INT myValue, otherValue;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   241
    unsigned INT productLow, productHi;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   242
    int negative;
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   243
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   244
    myValue = __intVal(self);
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   245
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   246
#   define low16Bits(foo)  ((foo) & 0xFFFF)
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   247
#   define hi16Bits(foo)   ((foo) >> 16)
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   248
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   249
#   define hi32Bits(foo)   ((foo) >> 32)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   250
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   251
    /*
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   252
     * can we use long long arithmetic ?
4176
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   253
     *
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   254
     * long-long arithmetic seems to be buggy with some systems
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   255
     * (took me a while to find this out :-(
561cf576eb0a fixed * (for sparc)
Claus Gittinger <cg@exept.de>
parents: 4167
diff changeset
   256
     * (try 10000 * 10000)
95
d22739a0c6e9 *** empty log message ***
claus
parents: 88
diff changeset
   257
     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   258
# if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   259
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   260
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   261
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   262
# if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   263
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   264
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   265
252
   266
    if (__isSmallInteger(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   267
        otherValue = __intVal(aNumber);
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   268
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   269
# if defined(USE_LONGLONG_FOR_MUL)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   270
        {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   271
#  if defined(__alpha__) && !defined(__alpha64__)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   272
#   define LONGLONG      INT64
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   273
#  else
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   274
#   define LONGLONG      long long
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   275
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   276
            LONGLONG product;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   277
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   278
            product = (LONGLONG)myValue * (LONGLONG)otherValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   279
            if ((product >= (LONGLONG)_MIN_INT)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   280
             && (product <= (LONGLONG)_MAX_INT)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   281
                RETURN ( __mkSmallInteger((INT)product) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   282
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   283
            if (product < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   284
                negative = -1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   285
                product = -product;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   286
            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   287
                negative = 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   288
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   289
            productHi = product >> 32;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   290
            productLow = product & 0xFFFFFFFFLL;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   291
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   292
# else /* no long-long */
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   293
        negative = 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   294
        if (myValue < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   295
            negative = -1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   296
            myValue = -myValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   297
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   298
        if (otherValue < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   299
            negative = -negative;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   300
            otherValue = -otherValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   301
        }
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
   302
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   303
#  if defined(__GNUC__) && defined(__mc68k__)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   304
        asm ("mulu%.l %3,%1:%0"
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   305
                : "=d"  ((unsigned long)(productLow)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   306
                  "=d"  ((unsigned long)(productHi))
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   307
                : "%0"  ((unsigned long)(myValue)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   308
                  "dmi" ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   309
#  else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   310
#   if defined (__GNUC__) && defined(__x86__)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   311
        asm ("mull %3"
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   312
                : "=a"  ((unsigned long)(productLow)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   313
                  "=d"  ((unsigned long)(productHi))
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   314
                : "%0"  ((unsigned long)(myValue)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   315
                  "rm"  ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   316
#   else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   317
#    if defined(__win32__) && defined(__BORLANDC__)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   318
        asm {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   319
            mov   eax, myValue
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   320
            mov   edx, otherValue
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   321
            mul   edx
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   322
            mov   productLow, eax
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   323
            mov   productHi, edx
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   324
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   325
#    else /* generic */
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   326
        {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   327
            unsigned INT pHH, pHL, pLH, pLL;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   328
            unsigned INT low1, low2, hi1, hi2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   329
            unsigned INT t;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   330
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   331
            /* unsigned multiply myValue * otherValue -> productHi, productLow
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   332
             *
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   333
             * this is too slow:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   334
             * since most machines can do 32*32 to 64 bit multiply,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   335
             * (or at least 32*32 with Overflow check)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   336
             * - need more assembler (inline) functions here
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   337
             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   338
#     if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   339
            low1 = low32Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   340
            hi1 = hi32Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   341
            low2 = low32Bits((unsigned INT)otherValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   342
            hi2 = hi32Bits((unsigned INT)otherValue);
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
   343
#      define LLMASK 0xC000000000000000LL
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   344
#     else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   345
            low1 = low16Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   346
            hi1 = hi16Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   347
            low2 = low16Bits((unsigned INT)otherValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   348
            hi2 = hi16Bits((unsigned INT)otherValue);
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
   349
#      define LLMASK 0xC0000000L
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   350
#     endif
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   351
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   352
            pLH = low1 * hi2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   353
            pHL = hi1 * low2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   354
            pLL = low1 * low2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   355
            pHH = hi1 * hi2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   356
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   357
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   358
             * the common case ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   359
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   360
            if ((pHL == 0)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   361
             && (pLH == 0)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   362
             && (pHH == 0)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   363
             && ((pLL & LLMASK) == 0)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   364
                if (negative < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   365
                    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   366
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   367
                RETURN ( __mkSmallInteger((INT)pLL) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   368
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   369
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   370
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   371
             *   pHH |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   372
             *   pLH          |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   373
             *   pHL          |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   374
             *   pLL                   |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   375
             */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   376
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   377
#     if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   378
            t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   379
            productLow = (t << 32) + low32Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   380
            productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   381
#     else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   382
            t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   383
            productLow = (t << 16) + low16Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   384
            productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   385
#     endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   386
        }
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   387
#    endif /* ! __win32__ */
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
   388
#   endif /* ! (__GNUC__ && __x86__) */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   389
#  endif /* ! (__GNUC__ && __mc68k__) */
4167
15e0629ba1f1 inline asm mul for WIN32
Claus Gittinger <cg@exept.de>
parents: 4065
diff changeset
   390
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   391
        if (productHi == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   392
            if (negative < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   393
                if (productLow <= -(_MIN_INT)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   394
                    RETURN ( __mkSmallInteger(-((INT)productLow)) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   395
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   396
            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   397
                if (productLow <= _MAX_INT) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   398
                    RETURN ( __mkSmallInteger(productLow) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   399
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   400
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   401
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   402
# endif /* ! USE_LONGLONG */
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   403
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   404
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   405
        RETURN (__MKLARGEINT128(negative, productLow, productHi));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   406
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   407
        RETURN (__MKLARGEINT64(negative, productLow, productHi));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   408
# endif
283
a897d331b4c1 *** empty log message ***
claus
parents: 282
diff changeset
   409
    } else if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   410
        OBJ newFloat;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   411
        double val = (double)myValue * __floatVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   412
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   413
        __qMKFLOAT(newFloat, val);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   414
        RETURN ( newFloat );
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   415
    } else if (__isShortFloat(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   416
        OBJ newFloat;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   417
        float val = (float)myValue * __shortFloatVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   418
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   419
        __qMKSFLOAT(newFloat, val);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   420
        RETURN ( newFloat );
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   421
    } else if (__isFractionLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   422
        OBJ t = __FractionInstPtr(aNumber)->f_numerator;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   423
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   424
        if (myValue == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   425
            RETURN(__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   426
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   427
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   428
        if (__isSmallInteger(t)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   429
            INT num = __intVal(t);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   430
            t = __FractionInstPtr(aNumber)->f_denominator;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   431
            if (__isSmallInteger(t)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   432
                INT prod = myValue * num;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   433
                if (prod / myValue == num) { // check for overflow
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   434
                    INT den = __intVal(t);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   435
                    INT quo = prod / den;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   436
                    if (quo * den == prod) {        // check for integer result
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   437
                        RETURN ( __mkSmallInteger(quo) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   438
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   439
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   440
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   441
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   442
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   443
#endif /* not __SCHTEAM__ */
2641
Claus Gittinger <cg@exept.de>
parents: 2640
diff changeset
   444
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   445
    ^ aNumber productFromInteger:self
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   446
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   447
    "
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   448
        3 * (1/2)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   449
        6 * (1/2)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   450
        6 * (-1/2)
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   451
   "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   452
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   453
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   454
+ aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   455
    "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
   456
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   457
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   458
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   459
    return context._RETURN( self.plus( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   460
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   461
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   462
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   463
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   464
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   465
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   466
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   467
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   468
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   469
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   470
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   471
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   472
# ifdef _ADD_IO_IO
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   473
        RETURN ( _ADD_IO_IO(self, aNumber) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   474
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   475
        REGISTER INT sum;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   476
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   477
        sum =  __intVal(self) + __intVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   478
        if (__ISVALIDINTEGER(sum)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   479
            RETURN ( __mkSmallInteger(sum) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   480
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   481
        RETURN ( __MKLARGEINT(sum) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   482
# endif
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   483
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   484
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   485
        OBJ newFloat;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   486
        double val = (double)__intVal(self) + __floatVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   487
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   488
        __qMKFLOAT(newFloat, val);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   489
        RETURN ( newFloat );
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   490
    }
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   491
    if (__isShortFloat(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   492
        OBJ newFloat;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   493
        float val = (float)__intVal(self) + __shortFloatVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   494
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   495
        __qMKSFLOAT(newFloat, val);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   496
        RETURN ( newFloat );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   497
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   498
#endif /* not __SCHTEAM__ */
3532
4b1a5cc57f8f added int op shortFloat inline
Claus Gittinger <cg@exept.de>
parents: 3458
diff changeset
   499
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   500
    ^ aNumber sumFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   501
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   502
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   503
- aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   504
    "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
   505
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   506
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   507
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   508
    return context._RETURN( self.minus( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   509
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   510
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   511
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   512
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   513
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   514
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   515
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   516
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   517
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   518
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   519
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   520
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   521
# ifdef _SUB_IO_IO
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   522
        RETURN ( _SUB_IO_IO(self, aNumber) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   523
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   524
        REGISTER INT diff =  __intVal(self) - __intVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   525
        if (__ISVALIDINTEGER(diff)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   526
            RETURN ( __mkSmallInteger(diff) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   527
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   528
        RETURN ( __MKLARGEINT(diff) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   529
# endif
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   530
    }
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   531
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   532
        OBJ newFloat;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   533
        double val = (double)__intVal(self) - __floatVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   534
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   535
        __qMKFLOAT(newFloat, val);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
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)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   539
        OBJ newFloat;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   540
        float val = (float)__intVal(self) - __shortFloatVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   541
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   542
        __qMKSFLOAT(newFloat, val);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
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__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   546
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   547
    ^ aNumber differenceFromInteger: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
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   550
/ aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   551
    "return the quotient of the receiver's value and the argument's value"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   552
a27a279701f8 Initial revision
claus
parents:
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.quotient( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   556
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   557
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   558
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   559
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   560
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   561
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   562
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   563
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   564
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   565
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   566
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   567
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   568
    INT t, val;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   569
    double dval;
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   570
    INT myValue = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   571
252
   572
    if (__isSmallInteger(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   573
        val = __intVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   574
        if (val != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   575
            t = myValue / val;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   576
# ifdef GOOD_OPTIMIZER
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   577
            if (myValue % val == 0) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   578
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   579
            /* this is stupid - all I want is to look for a remainder ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   580
               but most compilers are too stupid and generate an extra modulus
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   581
               instruction for "if (me % val)".
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   582
               Even if most divide instructions already leave the remainder in
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   583
               some register.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   584
               Therefore I use a multiplication which is faster than a modulo
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   585
               on most machines. Hint to GNU people :-)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   586
            */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   587
            if ((t * val) == myValue) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   588
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   589
                RETURN ( __mkSmallInteger(t) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   590
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   591
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   592
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   593
        if (__isFloatLike(aNumber)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   594
            dval = __floatVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   595
            if (dval != 0.0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   596
                OBJ newFloat;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   597
                double val = (double)myValue / dval;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   598
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   599
                __qMKFLOAT(newFloat, val);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   600
                RETURN ( newFloat );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   601
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   602
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   603
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   604
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   605
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   606
    aNumber isInteger ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   607
        aNumber == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   608
            ^ ZeroDivide raiseRequestWith:thisContext.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   609
        ].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   610
        ^ Fraction numerator:self denominator:aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   611
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   612
    ^ aNumber quotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   613
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   614
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   615
     8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   616
     9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   617
     9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   618
     9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   619
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   620
     -8 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   621
     -9 / 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   622
     -9 // 4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   623
     -9 quo:4
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   624
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   625
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   626
2
claus
parents: 1
diff changeset
   627
// aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   628
    "return the integer part of the quotient of the receiver's value
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   629
     and the argument's value.
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   630
     The result is truncated toward negative infinity
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   631
     and will be negative, if the operands signs differ.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   632
     The following is always true:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   633
        (receiver // aNumber) * aNumber + (receiver \\ aNumber) = receiver
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   634
14795
21ddbafc7a30 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14755
diff changeset
   635
     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
   636
     Especially surprising (because of truncation toward negative infinity):
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   637
        -1 // 10 -> -1 (because -(1/10) is truncated towards next smaller integer, which is -1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   638
        -10 // 3 -> -4 (because -(10/3) is truncated towards next smaller integer, which is -4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   639
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   640
     See #quo: which truncates toward zero and returns -2 in the above case 
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   641
     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
   642
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   643
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   644
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   645
    return context._RETURN( self.quotientTruncated( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   646
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   647
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   648
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   649
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   650
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   651
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   652
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   653
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   654
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   655
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   656
19994
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   657
    INT divisor, rslt;
1d96d9406342 compiler warnings
Claus Gittinger <cg@exept.de>
parents: 19860
diff changeset
   658
    INT dividend = __intVal(self);
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   659
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   660
    if (__isSmallInteger(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   661
        divisor = __intVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   662
        if (divisor != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   663
            rslt = dividend / divisor;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   664
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   665
             * Optimized to speed up positive result
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   666
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   667
            if (rslt <= 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   668
                if (rslt == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   669
                    if ((dividend ^ divisor) < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   670
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   671
                         * result (negative) has been truncated toward 0.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   672
                         * Return -1, because we truncate toward negative inf.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   673
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   674
                         rslt = -1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   675
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   676
                } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   677
                    /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   678
                     * If result (negative) has been truncated toward 0,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   679
                     * subtract 1, because we truncate toward negative inf.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   680
                     */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   681
                    if (divisor > 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   682
                        if (rslt * divisor > dividend) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   683
                            rslt--;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   684
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   685
                    } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   686
                        if (rslt * divisor < dividend) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   687
                            rslt--;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   688
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   689
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   690
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   691
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   692
            RETURN ( __mkSmallInteger(rslt) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   693
        }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   694
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   695
        if (__isFractionLike(aNumber)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   696
            OBJ t = __FractionInstPtr(aNumber)->f_numerator;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   697
            if (__isSmallInteger(t)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   698
                INT num = __intVal(t);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   699
                t = __FractionInstPtr(aNumber)->f_denominator;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   700
                if (__isSmallInteger(t)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   701
                    INT den = __intVal(t);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   702
                    INT prod;
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   703
#if 0 && defined(__GNUC__) // supported from GCC 5
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   704
                    if (!__builtin_mul_overflow(myself, den, &prod)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   705
                        goto out;   // overflow, try harder...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   706
                    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   707
#else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   708
                    prod = dividend * den;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   709
                    // make sure, that no overflow occurred
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   710
                    if (prod / den != dividend) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   711
                        goto out;   // overflow, try harder...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   712
                    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   713
#endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   714
                    rslt = prod / num;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   715
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   716
                    /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   717
                     * Optimized to speed up positive result
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   718
                     */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   719
                    if (rslt <= 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   720
                        if (rslt == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   721
                            if ((dividend ^ num) < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   722
                                /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   723
                                 * result (negative) has been truncated toward 0.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   724
                                 * Return -1, because we truncate toward negative inf.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   725
                                 */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   726
                                 rslt = -1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   727
                            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   728
                        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   729
                            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   730
                             * If result (negative) has been truncated toward 0,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   731
                             * subtract 1, because we truncate toward negative inf.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   732
                             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   733
                            if (num > 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   734
                                if (rslt * num > prod) rslt--;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   735
                            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   736
                                if (rslt * num < prod) rslt--;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   737
                            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   738
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   739
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   740
                    RETURN ( __mkSmallInteger(rslt) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   741
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   742
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   743
        }
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   744
    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   745
out:;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   746
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   747
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   748
    (aNumber = 0) ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   749
        ^ ZeroDivide raiseRequestWith:thisContext.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   750
    ].
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   751
    ^ aNumber integerQuotientFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   752
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   753
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   754
     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
   755
     -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
   756
     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
   757
     -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
   758
     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
   759
     -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
   760
     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
   761
     -1 // -2   ~~ 0 ifTrue:[self halt].
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   762
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   763
     -7 // (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   764
     -7 quo: (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   765
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   766
     7 // (-4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   767
     7 quo: (-4/3)
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   768
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   769
     10000 // 3600000 ~~ 0 ifTrue:[self halt].
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   770
     12 // (1 / 1000000000000000000)
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   771
     12 // (1 / 100000000000000)
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   772
     12 // 0.00000000000001s
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   773
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   774
     9 quo:4   => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   775
     -9 quo:4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   776
     9 quo:-4  => -2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   777
     -9 quo:-4 => 2
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   778
    "
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   779
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   780
    "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
   781
!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   782
2
claus
parents: 1
diff changeset
   783
\\ aNumber
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   784
    "Answer the integer remainder m defined by division with truncation toward
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   785
     negative infinity.
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   786
     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
   787
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   788
     The returned remainder has the same sign as aNumber.
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   789
     The following is always true:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   790
        (receiver // aNumber) * aNumber + (receiver \\ aNumber) = receiver
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   791
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   792
     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
   793
     Especially surprising:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   794
        -1 \\ 10 -> 9  (because -(1/10) is truncated towards next smaller integer, which is -1,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   795
                        and -1 multiplied by 10 gives -10, so we have to add 9 to get the original -1).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   796
        -10 \\ 3 -> 2 (because -(10/3) is truncated towards next smaller integer, which is -4,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   797
                        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
   798
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   799
     See #rem: which is the corresponding remainder for division via #quo:.
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   800
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
   801
     Redefined here for speed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   802
a27a279701f8 Initial revision
claus
parents:
diff changeset
   803
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   804
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   805
    return context._RETURN( self.remainder( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   806
#else
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   807
    /*
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   808
     * notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   809
     * the following inline code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   810
     * and exists as an optimization, to speed up those cases.
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   811
     *
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   812
     * Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   813
     * mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   814
     * (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   815
     */
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
   816
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   817
    INT dividend, divisor, rem;
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   818
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   819
    if (__isSmallInteger(aNumber)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   820
        && (divisor = __intVal(aNumber)) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   821
        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   822
         * Note that the sign of something modulo a negative number is undefined
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   823
         * in C!
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   824
         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   825
        dividend = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   826
        rem = dividend % divisor;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   827
        if (rem) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   828
            if ((rem ^ divisor) < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   829
                /* sign of remainder is different from sign of divisor */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   830
                rem = -rem;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   831
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   832
            if ((dividend ^ divisor) < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   833
                /* different signs, so division would have returned a
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   834
                 * negative number.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   835
                 * C rounds toward zero, this code will simulate
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   836
                 * rounding towards negative infinity.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   837
                 */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   838
                rem = divisor - rem;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   839
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   840
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   841
        RETURN ( __mkSmallInteger(rem) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   842
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   843
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   844
%}.
2
claus
parents: 1
diff changeset
   845
    (aNumber = 0) ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   846
        ^ ZeroDivide raiseRequestWith:thisContext.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   847
    ].
14003
727df70aa9f5 changed: #\\
Claus Gittinger <cg@exept.de>
parents: 13991
diff changeset
   848
    ^ aNumber moduloFromInteger:self
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   849
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   850
    "
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3914
diff changeset
   851
     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
   852
     -9 \\ 4 == 3 ifFalse:[self halt].
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   853
     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
   854
     -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
   855
     (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
   856
     (-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
   857
     1000 \\ 3600000 == 1000 ifFalse:[self halt]
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   858
    "
13006
fee441070661 changed:
Claus Gittinger <cg@exept.de>
parents: 12977
diff changeset
   859
14003
727df70aa9f5 changed: #\\
Claus Gittinger <cg@exept.de>
parents: 13991
diff changeset
   860
    "Modified: / 12-02-2012 / 20:43:40 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   861
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   862
a27a279701f8 Initial revision
claus
parents:
diff changeset
   863
abs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   864
    "return the absolute value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   865
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   866
a27a279701f8 Initial revision
claus
parents:
diff changeset
   867
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   868
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   869
    return context._RETURN( self.abs());
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   870
#else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   871
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   872
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   873
    if (val >= 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   874
        RETURN (self);
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   875
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   876
    if (val != _MIN_INT) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   877
        RETURN ( __mkSmallInteger(-val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   878
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   879
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   880
    RETURN( __MKLARGEINT(-_MIN_INT));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   881
#endif
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   882
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   883
    ^ super abs
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   884
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   885
a27a279701f8 Initial revision
claus
parents:
diff changeset
   886
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   887
    "return the negative value of the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   888
     reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   889
a27a279701f8 Initial revision
claus
parents:
diff changeset
   890
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   891
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   892
    return context._RETURN( self.negated());
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   893
#else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   894
    INT val = __intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   895
a27a279701f8 Initial revision
claus
parents:
diff changeset
   896
    if (val != _MIN_INT) {
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
   897
        RETURN ( __mkSmallInteger(- val) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   898
    }
3430
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   899
    /* only reached for minVal */
e42beefa71e7 better abs & negated
Claus Gittinger <cg@exept.de>
parents: 3189
diff changeset
   900
    RETURN (__MKLARGEINT( -_MIN_INT));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   901
#endif
324
290cfb34ec93 *** empty log message ***
claus
parents: 314
diff changeset
   902
%}.
5410
859c010edb47 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5240
diff changeset
   903
    ^ 0 - self
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   904
!
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   905
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   906
quo:aNumber
18849
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   907
    "return the integer part of the quotient of the receiver's value
646aee8aa03a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18846
diff changeset
   908
     and the argument's value. The result is truncated towards zero
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
   909
     and negative, if the operands signs differ..
6067
e4c03d14a5de comment
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
   910
     The following is always true:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   911
        (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
   912
     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
   913
     for negative results, the remainder is ignored.
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   914
     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
   915
     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
   916
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   917
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   918
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   919
    return context._RETURN( self.quotient(aNumber));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   920
#else
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   921
    if (__isSmallInteger(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   922
        INT val = __intVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   923
        if (val != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   924
            RETURN ( __mkSmallInteger(__intVal(self) / val) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   925
        }
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   926
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   927
        if (__isFractionLike(aNumber)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   928
            OBJ t = __FractionInstPtr(aNumber)->f_numerator;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   929
            if (__isSmallInteger(t)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   930
                INT num = __intVal(t);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   931
                t = __FractionInstPtr(aNumber)->f_denominator;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   932
                if (__isSmallInteger(t)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   933
                    INT den = __intVal(t);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   934
                    INT myself = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   935
                    INT prod;
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   936
#if 0 && defined(__GNUC__) // supported from GCC 5
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   937
                    if (__builtin_mul_overflow(myself, den, &prod)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   938
                        RETURN ( __mkSmallInteger(prod / num ));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   939
                    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   940
#else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   941
                    prod = myself * den;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   942
                    // make sure, that no overflow occurred
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   943
                    if (prod / den == myself) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   944
                        RETURN ( __mkSmallInteger(prod / num ));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   945
                    }
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   946
#endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   947
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   948
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   949
        }
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   950
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   951
#endif /* not __SCHTEAM__ */
1036
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
    (aNumber = 0) ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   954
        ^ ZeroDivide raiseRequestWith:thisContext.
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   955
    ].
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   956
    ^ self retry:#quo: coercing:aNumber
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   957
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   958
    "
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   959
     9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   960
     -9 // 4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   961
     9 quo:4
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   962
     -9 quo:4
18815
085878786453 #BUGFIX
Stefan Vogel <sv@exept.de>
parents: 18760
diff changeset
   963
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   964
     -7 // (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   965
     -7 quo: (4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   966
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   967
     7 // (-4/3)
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
   968
     7 quo: (-4/3)
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   969
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   970
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   971
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
   972
21155
248f28201689 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21107
diff changeset
   973
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   974
!SmallInteger methodsFor:'bit operators'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   975
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   976
bitAnd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   977
    "return the bitwise-and of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   978
a27a279701f8 Initial revision
claus
parents:
diff changeset
   979
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   980
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
   981
    return context._RETURN( self.bitAnd(anInteger));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
   982
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   983
    /* anding the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   984
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   985
        RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   986
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
   987
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   988
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   989
    anInteger class == LargeInteger ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
   990
        ^ anInteger bitAnd:self
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
   991
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   992
    ^ self retry:#bitAnd: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   993
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   994
    "(2r001010100 bitAnd:2r00001111) radixPrintStringRadix:2"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   995
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   996
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   997
bitClear:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
   998
    "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
   999
     returning the receiver with bits of the argument cleared.
19070
9cabcfcb9ada #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19069
diff changeset
  1000
     (i.e. the same as self bitAnd:aMaskInteger bitInvert).
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1001
     The method's name may be misleading: the receiver is not changed,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1002
     but a new number is returned. Should be named #withBitCleared:"
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1003
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1004
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1005
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1006
    return context._RETURN( self.bitClear(anInteger));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1007
#else
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1008
    /* anding the tags doesn't change it */
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1009
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1010
        RETURN ( ((OBJ) (((INT)self & ~(INT)anInteger) | TAG_INT)) );
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1011
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1012
#endif /* not __SCHTEAM__ */
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1013
%}.
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1014
    ^ self retry:#bitClear: coercing:anInteger
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1015
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1016
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1017
     (2r001010100 bitClear:2r00001111) radixPrintStringRadix:2
5458
2aa89d4fad64 example
Claus Gittinger <cg@exept.de>
parents: 5447
diff changeset
  1018
     (2r111111111 bitClear:2r00001000) radixPrintStringRadix:2
19070
9cabcfcb9ada #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19069
diff changeset
  1019
9cabcfcb9ada #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19069
diff changeset
  1020
     (2r001010100 bitAnd:2r00001111 bitInvert) radixPrintStringRadix:2
3156
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1021
    "
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1022
!
3d63afe752e5 added #bitClear:
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  1023
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1024
bitCount
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1025
    "return the number of 1-bits in the receiver"
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1026
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1027
%{  /* NOCONTEXT */
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1028
#ifdef __SCHTEAM__
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1029
    long _v1, _v2;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1030
    long _self = self.longValue();
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1031
    long _cnt;
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1032
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1033
    _v1 = _self & 0xFFFFFFFF;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1034
    _v1 = _v1 - ((_v1 >> 1) & 0x55555555);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1035
    _v1 = (_v1 & 0x33333333) + ((_v1 >> 2) & 0x33333333);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1036
    _v1 = ((_v1 + (_v1 >> 4)) & 0x0F0F0F0F);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1037
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  1038
    _v2 = (_self >> 32) & 0xFFFFFFFF;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1039
    _v2 = _v2 - ((_v2 >> 1) & 0x55555555);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1040
    _v2 = (_v2 & 0x33333333) + ((_v2 >> 2) & 0x33333333);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1041
    _v2 = ((_v2 + (_v2 >> 4)) & 0x0F0F0F0F);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1042
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1043
    _cnt = ((_v1 * 0x01010101) >> 24) + ((_v2 * 0x01010101) >> 24);
18948
cab22236fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18947
diff changeset
  1044
    return __c__._RETURN( STInteger._qnew( (byte)(_cnt) ) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1045
#else
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1046
    unsigned int _cnt;
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1047
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1048
    // popcnt is slower
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1049
# if 0 // defined(__GNUC__) && (defined(__x86__) || defined(__x86_64__))
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1050
#  define ALGORIHTM_4
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1051
# else
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1052
#  define ALGORIHTM_3
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1053
# endif
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1054
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1055
# ifdef ALGORITHM_1
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1056
    // old k&r code; might be better if only one or two bits are set
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1057
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1058
    unsigned INT _self = __intVal(self);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1059
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1060
    _cnt = 0;
11666
f30bc3b65e88 tricky bitCount
Claus Gittinger <cg@exept.de>
parents: 11519
diff changeset
  1061
    while (_self) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1062
        _cnt++;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1063
        _self = _self & (_self - 1);
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1064
    }
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1065
# else
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1066
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1067
#  ifdef ALGORITHM_2
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1068
    // seems to be faster on the average (and has better worst case)
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1069
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1070
    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
  1071
    unsigned INT _self = __intVal(self);
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1072
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1073
    _cnt = 0;
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1074
    while (_self) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1075
        _cnt += table[ _self & 0x0F ];
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1076
        _self >>= 4;
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1077
    }
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1078
#  else
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1079
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1080
#   ifdef ALGORIHTM_3
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1081
    // the fastest, but hard (impossible) to understand (google for fastest bit count)
18898
0dc54d84ac92 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18897
diff changeset
  1082
    unsigned INT _self = __intVal(self);
0dc54d84ac92 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18897
diff changeset
  1083
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1084
#    if __POINTER_SIZE__ == 8
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1085
    unsigned int _v1, _v2;
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1086
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1087
    _v1 = _self & 0xFFFFFFFF;
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1088
    _v1 = _v1 - ((_v1 >> 1) & 0x55555555);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1089
    _v1 = (_v1 & 0x33333333) + ((_v1 >> 2) & 0x33333333);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1090
    _v1 = ((_v1 + (_v1 >> 4)) & 0x0F0F0F0F);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1091
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1092
    _v2 = (unsigned int)(_self >> 32);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1093
    _v2 = _v2 - ((_v2 >> 1) & 0x55555555);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1094
    _v2 = (_v2 & 0x33333333) + ((_v2 >> 2) & 0x33333333);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1095
    _v2 = ((_v2 + (_v2 >> 4)) & 0x0F0F0F0F);
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1096
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1097
    _cnt = ((_v1 * 0x01010101) >> 24) + ((_v2 * 0x01010101) >> 24);
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1098
#    else
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1099
    _cnt = _self - ((_self >> 1) & 0x55555555);
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1100
    _cnt = (_cnt & 0x33333333) + ((_cnt >> 2) & 0x33333333);
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1101
    _cnt = ((_cnt + (_cnt >> 4)) & 0x0F0F0F0F);
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1102
    _cnt = (_cnt * 0x01010101) >> 24;
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1103
#    endif
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1104
#   else
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1105
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1106
#    ifdef ALGORIHTM_4
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1107
     // using the popcnt instruction (x86 only); strange enough, this is slower than ALGO3
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1108
#     if __POINTER_SIZE__ == 8
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1109
    unsigned INT _v;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1110
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1111
#    define _POPCNT(__op)                      \
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1112
    ({                                          \
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1113
        INT __rslt;                             \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1114
        asm("xor     %%rax,%%rax        \n      \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1115
             popcnt %1,%%rax           \n      \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1116
                        "  : "=a" (__rslt)      \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1117
                           : "g" ((INT)(__op))    \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1118
                           : "cc");             \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1119
        (OBJ)__rslt;                            \
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1120
     })
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1121
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1122
    _v = (INT)self;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1123
    _cnt = _POPCNT(_v);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1124
    _cnt--; // one too many due to tag
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1125
#     else
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1126
#    define _POPCNT(__op)                      \
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1127
    ({                                          \
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1128
        INT __rslt;                             \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1129
        asm("xor     %%eax,%%eax        \n      \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1130
             popcnt  %1,%%eax           \n      \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1131
                        "  : "=a" (__rslt)      \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1132
                           : "g" ((INT)(__v))   \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1133
                           : "cc");             \
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1134
        (OBJ)__rslt;                            \
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1135
     })
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1136
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1137
    _v = (INT)self;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1138
    _cnt = _POPCNT(_v);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1139
    _cnt--; // one too many due to tag
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1140
#     endif
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1141
#    else
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1142
      error error error
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1143
#    endif
15309
6154eb7935b5 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15275
diff changeset
  1144
#   endif
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1145
#  endif
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1146
# endif
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1147
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1148
    RETURN ( __MKSMALLINT(_cnt));
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1149
#endif /* not __SCHTEAM__ */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1150
%}.
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1151
    ^ super bitCount.
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1152
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1153
    "
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  1154
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1155
     1 to:1000000 do:[:n |
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1156
        self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
13909
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
  1157
     ].
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
  1158
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1159
     #( 16r00000000
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1160
        16r00010000 16r00100000 16r01000000 16r10000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1161
        16r00020000 16r00200000 16r02000000 16r20000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1162
        16r00040000 16r00400000 16r04000000 16r40000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1163
        16r00080000 16r00800000 16r08000000 16r80000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1164
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1165
        16rFFFFFFFF 16r7FFFFFFF 16r3FFFFFFF 16r1FFFFFFF
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1166
        16rEEEEEEEE 16r7EEEEEEE 16r3EEEEEEE 16r1EEEEEEE
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1167
        16rDDDDDDDD 16r7DDDDDDD 16r3DDDDDDD 16r1DDDDDDD
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1168
        16rCCCCCCCC 16r7CCCCCCC 16r3CCCCCCC 16r1CCCCCCC
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1169
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1170
        16r8000000000010000 16r8000000000100000 16r8000000001000000 16r8000000010000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1171
        16r8000000000020000 16r8000000000200000 16r8000000002000000 16r8000000020000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1172
        16r8000000000040000 16r8000000000400000 16r8000000004000000 16r8000000040000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1173
        16r8000000000080000 16r8000000000800000 16r8000000008000000 16r8000000080000000
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1174
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1175
        16r80000000FFFFFFFF 16r800000007FFFFFFF 16r800000003FFFFFFF 16r800000001FFFFFFF
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1176
        16r80000000EEEEEEEE 16r800000007EEEEEEE 16r800000003EEEEEEE 16r800000001EEEEEEE
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1177
        16r80000000DDDDDDDD 16r800000007DDDDDDD 16r800000003DDDDDDD 16r800000001DDDDDDD
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1178
        16r80000000CCCCCCCC 16r800000007CCCCCCC 16r800000003CCCCCCC 16r800000001CCCCCCC
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1179
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1180
        16rFFFFFFFFFFFFFFFF 16r7FFFFFFFFFFFFFFF 16r3FFFFFFFFFFFFFFF 16r1FFFFFFFFFFFFFFF
13909
8a4aee47b4ca changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13908
diff changeset
  1181
     ) do:[:n |
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1182
        self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1183
     ]
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1184
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1185
     1 to:10000000 do:[:n |
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1186
        (n bitCount)
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1187
     ]
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1188
    "
13908
Claus Gittinger <cg@exept.de>
parents: 13386
diff changeset
  1189
13912
8a9a892c83a3 changed: #bitCount
Claus Gittinger <cg@exept.de>
parents: 13911
diff changeset
  1190
    "Modified: / 09-01-2012 / 19:12:41 / cg"
11493
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1191
!
6496a8ef2fc9 +bitCount
Claus Gittinger <cg@exept.de>
parents: 10972
diff changeset
  1192
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1193
bitInvert
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1194
    "return the value of the receiver with all bits inverted.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1195
     The method's name may be misleading: the receiver is not changed,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1196
     but a new number is returned. Could be named #withBitsInverted"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1197
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1198
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1199
#ifdef __SCHTEAM__
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1200
    long _self = self.longValue();
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1201
    return __c__._RETURN( STInteger._new( ~_self ) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1202
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1203
    /* invert anything except tag bits */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1204
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1205
#endif /* not __SCHTEAM__ */
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  1206
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1207
    ^ super bitInvert
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1208
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1209
19069
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1210
bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1211
    "return a new integer, where the low 8 bits are masked and complemented.
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1212
     This returns an unsigned version of what bitInvert would return.
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1213
     (i.e. same as self bitInvert bitAnd:16rFF)"
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1214
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1215
%{  /* NOCONTEXT */
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1216
#ifdef __SCHTEAM__
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1217
    long _self = self.longValue();
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1218
    return __c__._RETURN( STInteger._new( ~_self & 0xFF) );
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1219
#else
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1220
    /* invert anything except tag bits */
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1221
    RETURN ( (OBJ) (((INT)self ^ ~TAG_MASK) & (INT)(__mkSmallInteger(0xFF))) );
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1222
#endif /* not __SCHTEAM__ */
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1223
%}.
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1224
    ^ super bitInvertByte
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  1225
19069
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1226
    "
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1227
     16r7f bitInvert
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1228
     16r7f bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1229
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1230
     16r80 bitInvert
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1231
     16r80 bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1232
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1233
     16rff bitInvert
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1234
     16rff bitInvertByte
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1235
    "
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1236
!
0c0fcb9e0760 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19060
diff changeset
  1237
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1238
bitOr:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1239
    "return the bitwise-or of the receiver and the argument, anInteger"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1240
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1241
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1242
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1243
    return context._RETURN( self.bitOr( anInteger ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1244
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1245
    /* oring the tags doesn't change it */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1246
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1247
        RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1248
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1249
#endif /* not __SCHTEAM__ */
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1250
%}.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1251
    ^ self retry:#bitOr: coercing:anInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1252
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1253
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1254
     (2r000000100 bitOr:2r00000011) radixPrintStringRadix:2
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1255
     (0 bitOr:16r20000000) hexPrintString
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1256
     (0 bitOr:16r40000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1257
     (0 bitOr:16r80000000) hexPrintString
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  1258
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1259
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1260
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1261
bitReversed
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1262
    "swap (i.e. reverse) bits in an integer
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1263
     i.e. a.b.c.d....x.y.z -> z.y.x...b.a.d.c."
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1264
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1265
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1266
#ifndef __SCHTEAM__
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1267
    unsigned INT v = __intVal(self);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1268
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1269
# if __POINTER_SIZE__ == 8
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1270
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1271
    v = ((v >> 1) & 0x5555555555555555) | ((v & 0x5555555555555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1272
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1273
    v = ((v >> 2) & 0x3333333333333333) | ((v & 0x3333333333333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1274
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1275
    v = ((v >> 4) & 0x0F0F0F0F0F0F0F0F) | ((v & 0x0F0F0F0F0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1276
    // swap bytes
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1277
    v = ((v >> 8) & 0x00FF00FF00FF00FF) | ((v & 0x00FF00FF00FF00FF) << 8);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1278
    // swap 2-byte pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1279
    v = ((v >> 16) & 0x0000FFFF0000FFFF) | (( v & 0x0000FFFF0000FFFF) << 16);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1280
    // swap 4-byte long pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1281
    v = ((v >> 32) & 0x00000000FFFFFFFF) | (( v & 0x00000000FFFFFFFF) << 32);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1282
# else
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1283
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1284
    v = ((v >> 1) & 0x55555555) | ((v & 0x55555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1285
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1286
    v = ((v >> 2) & 0x33333333) | ((v & 0x33333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1287
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1288
    v = ((v >> 4) & 0x0F0F0F0F) | ((v & 0x0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1289
    // swap bytes
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1290
    v = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1291
    // swap 2-byte long pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1292
    v = ((v >> 16) & 0x0000FFFF) | ((v & 0x0000FFFF) << 16);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1293
# endif
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1294
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1295
    if (v <= _MAX_INT) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1296
        RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1297
    }
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1298
    RETURN (__MKUINT(v));
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1299
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1300
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1301
    ^ super bitReversed
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1302
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1303
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1304
     2r1001 bitReversed printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1305
     2r100111010011 bitReversed printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1306
     -1 bitReversed printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1307
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1308
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1309
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1310
bitReversed16
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1311
    "swap (i.e. reverse) the low 16 bits in an integer
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1312
     the high bits are ignored and clear in the result
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1313
     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
  1314
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1315
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1316
#ifndef __SCHTEAM__
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1317
    unsigned INT v = __intVal(self) & 0xFFFF;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1318
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1319
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1320
    v = ((v >> 1) & 0x55555555) | ((v & 0x55555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1321
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1322
    v = ((v >> 2) & 0x33333333) | ((v & 0x33333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1323
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1324
    v = ((v >> 4) & 0x0F0F0F0F) | ((v & 0x0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1325
    // swap bytes
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1326
    v = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1327
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1328
    if (v <= _MAX_INT) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1329
        RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1330
    }
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1331
    RETURN (__MKUINT(v));
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1332
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1333
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1334
    ^ super bitReversed16
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1335
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1336
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1337
     2r1001 bitReversed16 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1338
     2r100111010011 bitReversed16 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1339
     -1 bitReversed16 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1340
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1341
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1342
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1343
bitReversed32
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1344
    "swap (i.e. reverse) the low 32 bits in an integer
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1345
     the high bits are ignored and clear in the result
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1346
     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
  1347
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1348
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1349
#ifndef __SCHTEAM__
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1350
    unsigned INT v = __intVal(self) & 0xFFFFFFFF;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1351
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1352
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1353
    v = ((v >> 1) & 0x55555555) | ((v & 0x55555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1354
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1355
    v = ((v >> 2) & 0x33333333) | ((v & 0x33333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1356
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1357
    v = ((v >> 4) & 0x0F0F0F0F) | ((v & 0x0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1358
    // swap bytes
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1359
    v = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1360
    // swap 2-byte long pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1361
    v = ((v >> 16) & 0x0000FFFF) | ((v & 0x0000FFFF) << 16);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1362
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1363
    if (v <= _MAX_INT) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1364
        RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1365
    }
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1366
    RETURN (__MKUINT(v));
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1367
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1368
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1369
    ^ super bitReversed32
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1370
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1371
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1372
     2r1001 bitReversed32 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1373
     2r100111010011 bitReversed32 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1374
     -1 bitReversed32 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1375
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1376
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1377
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1378
bitReversed8
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1379
    "swap (i.e. reverse) the low 8 bits in an integer
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1380
     the high bits are ignored and clear in the result
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1381
     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
  1382
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1383
%{  /* NOCONTEXT */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1384
#ifndef __SCHTEAM__
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1385
    unsigned INT v = __intVal(self) & 0xFF;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1386
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1387
    // swap odd and even bits
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1388
    v = ((v >> 1) & 0x55555555) | ((v & 0x55555555) << 1);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1389
    // swap consecutive pairs
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1390
    v = ((v >> 2) & 0x33333333) | ((v & 0x33333333) << 2);
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  1391
    // swap nibbles ...
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1392
    v = ((v >> 4) & 0x0F0F0F0F) | ((v & 0x0F0F0F0F) << 4);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1393
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1394
    if (v <= _MAX_INT) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1395
        RETURN ( __mkSmallInteger(v) );
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1396
    }
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1397
    RETURN (__MKUINT(v));
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1398
#endif /* not __SCHTEAM__ */
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1399
%}.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1400
    ^ super bitReversed8
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1401
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1402
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1403
     2r1001 bitReversed8 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1404
     2r10011101 bitReversed8 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1405
     2r111110011101 bitReversed8 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1406
     -1 bitReversed8 printStringRadix:2
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1407
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1408
!
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  1409
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1410
bitShift:shiftCount
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1411
    "return the value of the receiver shifted by shiftCount bits;
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  1412
     leftShift if shiftCount > 0; rightShift otherwise.
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1413
     Notice: the result of bitShift: on negative receivers is not
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1414
             defined in the language standard (since the implementation
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1415
             is free to choose any internal representation for integers).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1416
             However, ST/X preserves the sign."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1417
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1418
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1419
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1420
    return context._RETURN( self.bitShift( shiftCount ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1421
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1422
    INT bits, count;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1423
252
  1424
    if (__isSmallInteger(shiftCount)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1425
        bits = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1426
        if (bits == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1427
            RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1428
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1429
        count = __intVal(shiftCount);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1430
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1431
        if (count > 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1432
            INT sign = 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1433
            if (bits < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1434
                bits = -bits;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1435
                sign = -1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1436
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1437
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1438
             * a left shift
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1439
             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1440
# if defined(USE_LONGLONG_FOR_SHIFT)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1441
            if (count <= N_INT_BITS) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1442
                unsigned LONGLONG result;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1443
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1444
                result = (unsigned LONGLONG)bits;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1445
                result <<= count;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1446
                if (result <= _MAX_INT) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1447
                    if (sign < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1448
                        RETURN ( __MKINT(-result) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1449
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1450
                    RETURN ( __mkSmallInteger(result) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1451
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1452
                {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1453
                    RETURN (__MKLARGEINT64(sign, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1454
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1455
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1456
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1457
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1458
             * check for overflow
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1459
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1460
            if (count < (N_INT_BITS-1)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1461
                if (! (bits >> (N_INT_BITS - 1 - count))) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1462
                    INT result = bits << count;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1463
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1464
                    if (sign < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1465
                        RETURN ( __MKINT(-result) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1466
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1467
                    RETURN ( __mkSmallInteger(result) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1468
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1469
                /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1470
                 * so, there is an overflow ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1471
                 * handle it as largeInteger
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1472
                 */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1473
                /* FALL THROUGH */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1474
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1475
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1476
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1477
            if (count == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1478
                RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1479
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1480
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1481
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1482
             * right shifts cannot overflow
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1483
             *
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1484
             * some machines ignore shifts bigger than
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1485
             * the number of bits in an int ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1486
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1487
            count = -count;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1488
            if (count > (N_INT_BITS-1)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1489
                RETURN (__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1490
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1491
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1492
            RETURN ( __mkSmallInteger(bits >> count) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1493
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1494
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1495
#endif /* not __SCHTEAM__ */
85
claus
parents: 77
diff changeset
  1496
%}.
claus
parents: 77
diff changeset
  1497
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1498
        ^ (LargeInteger value:self) bitShift:shiftCount
85
claus
parents: 77
diff changeset
  1499
    ].
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1500
    ^ self bitShift:shiftCount asInteger   "/ is this a good idea ?
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1501
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1502
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1503
bitTest:aMask
5782
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1504
    "return true, if any bit from aMask is set in the receiver.
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1505
     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
  1506
     is non-0, false otherwise."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1507
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1508
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1509
#ifdef __SCHTEAM__
18232
Claus Gittinger <cg@exept.de>
parents: 18227
diff changeset
  1510
    return context._RETURN(
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1511
            ( self.bitAnd( aMask ) == STInteger._0 )
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1512
            ? STObject.False : STObject.True );
18232
Claus Gittinger <cg@exept.de>
parents: 18227
diff changeset
  1513
    /* NOTREACHED */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1514
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1515
    /* and all bits except tag */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1516
    if (__isSmallInteger(aMask)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1517
        RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1518
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1519
#endif /* not __SCHTEAM__ */
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1520
%}.
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1521
    aMask class == LargeInteger ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1522
        ^ (aMask bitAnd:self) ~~ 0
4613
a722d598c1bb faster and:/bitTest: with a largeInteger
Claus Gittinger <cg@exept.de>
parents: 4523
diff changeset
  1523
    ].
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1524
    ^ self retry:#bitTest: coercing:aMask
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1525
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1526
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1527
     2r10001 bitTest:2r00001
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1528
     2r10001 bitTest:2r00010
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1529
     2r10001 bitTest:2r00100
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1530
     2r10001 bitTest:2r01000
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1531
     2r10001 bitTest:2r10000
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1532
     2r10001 bitTest:2r10001
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  1533
     2r10001 bitTest:2r10010
11519
657e60b50dce comment in bitTest:
Claus Gittinger <cg@exept.de>
parents: 11506
diff changeset
  1534
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1535
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1536
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1537
bitXor:anInteger
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1538
    "return the bitwise-exclusive-or of the receiver and the argument, anInteger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1539
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1540
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1541
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  1542
    return context._RETURN( self.bitXor( anInteger ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1543
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1544
    /* xoring the tags turns it off - or it in again */
252
  1545
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1546
        RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1547
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1548
#endif /* not __SCHTEAM__ */
1716
52fc3e02c5bd use new MKLARGEINT64 to generate 64 bit result;
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  1549
%}.
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1550
    ^ self retry:#bitXor: coercing:anInteger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1551
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1552
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1553
highBit
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  1554
    "return the bitIndex of the highest bit set.
19601
bcce77592dae #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19486
diff changeset
  1555
     The returned bitIndex starts at 1 for the least significant bit.
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1556
     Returns 0 if no bit is set."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1557
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1558
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1559
#ifdef __SCHTEAM__
18234
34f00359de08 experimental java support
Claus Gittinger <cg@exept.de>
parents: 18232
diff changeset
  1560
    {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1561
        long bits = self.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1562
        int bitNr = 0;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1563
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1564
        if (bits != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1565
            if ((bits & 0xFFFFFFFF00000000L) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1566
                bitNr += 32; bits >>= 32;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1567
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1568
            if ((bits & 0xFFFF0000L) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1569
                bitNr += 16; bits >>= 16;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1570
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1571
            if ((bits & 0xFF00) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1572
                bitNr += 8; bits >>= 8;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1573
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1574
            if ((bits & 0xF0) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1575
                bitNr += 4; bits >>= 4;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1576
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1577
            if ((bits & 0xC) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1578
                bitNr += 2; bits >>= 2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1579
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1580
            if ((bits & 0x2) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1581
                bitNr += 1; bits >>= 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1582
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1583
            bitNr += 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1584
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1585
        return context._RETURN( STInteger._new(bitNr) );
18234
34f00359de08 experimental java support
Claus Gittinger <cg@exept.de>
parents: 18232
diff changeset
  1586
    }
34f00359de08 experimental java support
Claus Gittinger <cg@exept.de>
parents: 18232
diff changeset
  1587
    /* NOTREACHED */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1588
#else
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1589
    unsigned INT bits;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1590
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1591
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1592
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1593
    if (bits == 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1594
        RETURN ( __mkSmallInteger(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1595
    }
2785
3d222249bd61 alpha64 changes
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  1596
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1597
# ifdef __BSR
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1598
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1599
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1600
     * 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
  1601
     * (but saves a few code-bytes, though)
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1602
     */
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1603
    index = __BSR(bits);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1604
# else
4955
a294a8a19434 slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4954
diff changeset
  1605
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1606
    index = 0;
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1607
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1608
#  if __POINTER_SIZE__ == 8
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1609
    if (bits & 0xFFFFFFFF00000000L) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1610
        index += 32; bits >>= 32;
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1611
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1612
#  endif
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1613
    if (bits & 0xFFFF0000L) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1614
        index += 16; bits >>= 16;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1615
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1616
    if (bits & 0xFF00) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1617
        index += 8; bits >>= 8;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1618
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1619
    if (bits & 0xF0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1620
        index += 4; bits >>= 4;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1621
    }
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1622
    if (bits & 0xC) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1623
        index += 2; bits >>= 2;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1624
    }
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1625
    if (bits & 0x2) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1626
        index += 1; bits >>= 1;
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1627
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1628
# endif /* no BSR instruction */
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1629
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1630
    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
  1631
#endif /* not __SCHTEAM__ */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1632
%}.
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1633
    ^ super highBit
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1634
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1635
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1636
     2r0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1637
     2r1 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1638
     2r10 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1639
     2r100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1640
     2r1000 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1641
     2r100000000000 highBit
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  1642
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1643
     ((0 to:64) collect:[:s | 1 bitShift:s])
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1644
        collect:[:n | n highBit]
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1645
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1646
     (((0 to:64) collect:[:s | 1 bitShift:s])
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1647
        collect:[:n | n highBit]) = (1 to:65)
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1648
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1649
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1650
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1651
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1652
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1653
            2r1 highBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1654
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1655
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1656
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1657
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1658
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1659
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1660
            2r1111 highBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1661
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1662
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1663
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1664
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1665
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1666
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1667
            2r11111111111111 highBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1668
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1669
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1670
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1671
    "
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1672
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1673
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1674
            2r11111111111111111111111111 highBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1675
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1676
     ]
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1677
    "
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1678
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1679
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1680
     2r000100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1681
     2r010100 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1682
     2r000001 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1683
     0 highBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1684
     SmallInteger maxVal highBit
4951
9943e85aa62a better #highBit
Claus Gittinger <cg@exept.de>
parents: 4827
diff changeset
  1685
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1686
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1687
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1688
lowBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1689
    "return the bitIndex of the lowest bit set. The returned bitIndex
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1690
     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
  1691
     Returns 0 if no bit is set."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1692
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1693
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1694
#ifdef __SCHTEAM__
18370
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  1695
    long bits = self.longValue();
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  1696
    int index = 0;
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  1697
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  1698
    if (bits != 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1699
        if ((bits & 0xFFFFFFFFL)==0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1700
            index += 32; bits >>= 32;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1701
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1702
        if ((bits & 0xFFFFL)==0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1703
            index += 16; bits >>= 16;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1704
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1705
        if ((bits & 0xFFL)==0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1706
            index += 8; bits >>= 8;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1707
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1708
        if ((bits & 0xFL)==0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1709
            index += 4; bits >>= 4;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1710
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1711
        if ((bits & 0x3L)==0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1712
            index += 2; bits >>= 2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1713
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1714
        if ((bits & 0x1L)==0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1715
            index += 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1716
        }
18370
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  1717
    }
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  1718
    return __c__._RETURN( STInteger._qnew( index ) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1719
#else
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1720
    unsigned INT bits;
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1721
    int index;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1722
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  1723
    bits = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1724
    if (bits == 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1725
        RETURN ( __mkSmallInteger(0) );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1726
    }
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1727
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1728
# ifdef __BSF
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1729
    /*
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1730
     * so much for CISC CPUS:
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1731
     * 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
  1732
     * (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
  1733
     * but saves a few code-bytes, though.
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1734
     */
6482
8b325f4a00fa checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6481
diff changeset
  1735
    index = __BSF(bits);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1736
    RETURN ( __mkSmallInteger(index + 1) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1737
# else
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1738
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1739
    index = 1;
2431
09f32798910f better lowBit
Claus Gittinger <cg@exept.de>
parents: 2430
diff changeset
  1740
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1741
#  if __POINTER_SIZE__ == 8
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1742
    if ((bits<<32) == 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1743
        index += 32; bits >>= 32;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1744
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1745
#  endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1746
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1747
    if ((bits & 0xFFFF)==0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1748
        index += 16; bits >>= 16;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1749
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1750
    if ((bits & 0xFF)==0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1751
        index += 8; bits >>= 8;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1752
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1753
    if ((bits & 0xF)==0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1754
        index += 4; bits >>= 4;
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  1755
    }
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1756
    if ((bits & 0x3)==0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1757
        index += 2; bits >>= 2;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1758
    }
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1759
    if ((bits & 0x1)==0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1760
        index += 1;
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1761
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1762
# endif
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1763
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  1764
    RETURN ( __mkSmallInteger(index) );
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1765
#endif /* not __SCHTEAM__ */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1766
%}.
18370
0ffb12e5f1b4 comments only
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  1767
    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
  1768
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1769
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1770
     0 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1771
     2r0001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1772
     2r0010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1773
     2r0100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1774
     2r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1775
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1776
     2r000100 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1777
     2r010010 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1778
     2r100001 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1779
     16r1000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1780
     16r1000000 lowBit
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1781
     16r1000000000000000 lowBit
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1782
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1783
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1784
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1785
            2r1000 lowBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1786
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1787
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1788
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1789
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1790
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1791
            2r11110000000 lowBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1792
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1793
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1794
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1795
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1796
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1797
            2r1000000000000 lowBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1798
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1799
     ]
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6417
diff changeset
  1800
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1801
     Time millisecondsToRun:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1802
        1000000 timesRepeat:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1803
            2r1000000000000000000000000000 lowBit
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1804
        ]
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  1805
     ]
4954
af47cd256ddf slightly better lowBit & highBit on intel
Claus Gittinger <cg@exept.de>
parents: 4953
diff changeset
  1806
    "
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1807
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  1808
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1809
rightShift:shiftCount
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1810
    "return the value of the receiver shifted by shiftCount bits;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1811
     right shift if shiftCount > 0; left shift  otherwise.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1812
     Notice: the result of bitShift: on negative receivers is not
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1813
             defined in the language standard (since the implementation
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1814
             is free to choose any internal representation for integers).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1815
             However, ST/X preserves the sign."
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1816
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1817
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1818
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1819
#else
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1820
    INT bits, count;
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1821
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1822
    if (__isSmallInteger(shiftCount)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1823
        bits = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1824
        if (bits == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1825
            RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1826
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1827
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1828
        count = __intVal(shiftCount);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1829
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1830
        if (count < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1831
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1832
             * a left shift
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1833
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1834
            count = -count;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1835
# if defined(USE_LONGLONG_FOR_SHIFT)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1836
            if (count <= N_INT_BITS) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1837
                unsigned LONGLONG result;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1838
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1839
                result = (unsigned LONGLONG)bits;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1840
                result <<= count;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1841
                if (result <= _MAX_INT) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1842
                    RETURN ( __mkSmallInteger(result) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1843
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1844
                {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1845
                    RETURN (__MKLARGEINT64(1, (INT)(result >> 32), (INT)(result & 0xFFFFFFFF)));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1846
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1847
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1848
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1849
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1850
             * check for overflow
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1851
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1852
            if (count < (N_INT_BITS-1)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1853
                if (! (bits >> (N_INT_BITS - 1 - count))) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1854
                    RETURN ( __mkSmallInteger(bits << count) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1855
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1856
                /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1857
                 * so, there is an overflow ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1858
                 * handle it as largeInteger
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1859
                 */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1860
                /* FALL THROUGH */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1861
            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  1862
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1863
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1864
            if (count == 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1865
                RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1866
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1867
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1868
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1869
             * right shifts cannot overflow
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1870
             *
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1871
             * some machines ignore shifts bigger than
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1872
             * the number of bits in an int ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1873
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1874
            if (count > (N_INT_BITS-1)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1875
                RETURN (__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1876
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1877
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1878
            RETURN ( __mkSmallInteger(bits >> count) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1879
        }
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1880
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  1881
#endif /* not __SCHTEAM__ */
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1882
%}.
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1883
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1884
        ^ (LargeInteger value:self) rightShift:shiftCount
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1885
    ].
16448
52a24c07dc59 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16294
diff changeset
  1886
    ^ self rightShift:shiftCount asInteger   "/ is this a good idea ?
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1887
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1888
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1889
    "
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1890
        16 rightShift:2
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1891
         4 rightShift:-2
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  1892
    "
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1893
! !
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1894
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1895
!SmallInteger methodsFor:'bit operators - indexed'!
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1896
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1897
bitAt:anIntegerIndex
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1898
    "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
  1899
     Notice: the result of bitAt: on negative receivers is not
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1900
             defined in the language standard (since the implementation
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1901
             is free to choose any internal representation for integers)"
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1902
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1903
%{  /* NOCONTEXT */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1904
#ifdef __SCHTEAM__
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1905
    return context._RETURN( self.bitAt(anIntegerIndex));
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1906
#else
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1907
    if (__isSmallInteger(anIntegerIndex)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1908
        INT idx = __smallIntegerVal(anIntegerIndex);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1909
        if (idx > 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1910
            if (idx > N_INT_BITS) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1911
                RETURN(__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1912
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1913
            RETURN((__smallIntegerVal(self) & ((INT)1 << (idx-1))) ? __mkSmallInteger(1) : __mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1914
        }
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1915
    }
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1916
#endif /* not __SCHTEAM__ */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1917
%}.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1918
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1919
    ^ SubscriptOutOfBoundsError
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1920
            raiseRequestWith:anIntegerIndex
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1921
            errorString:'index out of bounds'
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1922
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1923
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1924
     16r000000001 bitAt:0 -> error
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1925
     16r000000001 bitAt:1
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1926
     16r000000001 bitAt:2
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1927
     16r000008000 bitAt:16
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1928
     16r000800000 bitAt:24
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1929
     16r008000000 bitAt:28
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1930
     16r010000000 bitAt:29
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1931
     16r020000000 bitAt:30
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1932
     16r040000000 bitAt:31
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1933
     16r080000000 bitAt:32
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1934
     16r100000000 bitAt:33
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1935
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1936
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1937
" Smalltalk implementation:
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1938
    |mask|
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1939
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1940
    anIntegerIndex <= 0 ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1941
        ^ SubscriptOutOfBoundsSignal
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1942
                raiseRequestWith:anIntegerIndex
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1943
                errorString:'index out of bounds'
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1944
    ].
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1945
    (anIntegerIndex > SmallInteger maxBits) ifTrue:[^ 0].
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1946
    mask := 1 bitShift:(anIntegerIndex - 1).
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1947
    ((self bitAnd:mask) == 0) ifTrue:[^ 0].
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1948
    ^ 1
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1949
"
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1950
!
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1951
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1952
clearBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1953
    "return a new integer where the specified bit is off.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1954
     Bits are counted from 1 starting with the least significant.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1955
     The method's name may be misleading: the receiver is not changed,
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1956
     but a new number is returned. Should be named #withBitCleared:"
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1957
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1958
%{  /* NOCONTEXT */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1959
#ifndef __SCHTEAM__
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1960
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1961
        int index = __intVal(anInteger);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1962
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1963
        if (index > 0) {
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1964
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1965
            if (index <= 62)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1966
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1967
            if (index <= 30)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1968
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1969
            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1970
                INT mask = __MASKSMALLINT( ((INT)1 << (index-1)));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1971
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1972
                RETURN ( ((OBJ) ((INT)self & ~(INT)mask)) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1973
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1974
            RETURN (self);  /* nothing to do ... */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  1975
        }
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1976
    }
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1977
#endif /* not __SCHTEAM__ */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1978
%}.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1979
    ^ super clearBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1980
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1981
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1982
     (16r401 clearBit:1     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1983
     (16r401 clearBit:0     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1984
     (16r3fffffff clearBit:1) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1985
     (16r3fffffff clearBit:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1986
     (16r3fffffff clearBit:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1987
     (16r3fffffff clearBit:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1988
     (16r3fffffff bitAt:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1989
     (16r3fffffff bitAt:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1990
     (16r3fffffff bitAt:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1991
     (16r40000001 clearBit:1) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1992
     (16rF0000001 clearBit:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1993
     (16rF0000001 clearBit:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1994
     (16rF0000001 clearBit:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1995
     (16rF0000001 clearBit:32) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1996
     (16r1F0000001 clearBit:33) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1997
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1998
!
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  1999
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2000
invertBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2001
    "return a new number where the specified bit is inverted.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2002
     Bits are counted from 1 starting with the least significant.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2003
     The method's name may be misleading: the receiver is not changed,
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2004
     but a new number is returned. Should be named #withBitInverted:"
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2005
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2006
%{  /* NOCONTEXT */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2007
#ifndef __SCHTEAM__
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2008
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2009
        int index = __intVal(anInteger);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2010
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2011
        if (index > 0) {
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2012
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2013
            if (index <= 62)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2014
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2015
            if (index <= 30)
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2016
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2017
            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2018
                INT mask = __MASKSMALLINT((INT)1 << (index-1));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2019
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2020
                RETURN ( ((OBJ) ((INT)self ^ (INT)mask)) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2021
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2022
        }
19051
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2023
    }
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2024
#endif /* not __SCHTEAM__ */
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2025
%}.
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2026
    ^ super invertBit:anInteger
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2027
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2028
    "
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2029
     (16r401 invertBit:2     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2030
     (16r401 invertBit:1     ) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2031
     (16r30000000 invertBit:1) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2032
     (16r40000000 invertBit:0) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2033
     (16r0 invertBit:29) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2034
     (16r0 invertBit:30) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2035
     (16r0 invertBit:31) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2036
     (16r0 invertBit:32) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2037
     (16r0 invertBit:33) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2038
     (16r0 invertBit:100) hexPrintString
29a3a26970e8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19050
diff changeset
  2039
    "
10972
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2040
!
bd9df21d6654 speed up #rightShift:
Stefan Vogel <sv@exept.de>
parents: 10947
diff changeset
  2041
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2042
setBit:anInteger
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8919
diff changeset
  2043
    "return a new integer where the specified bit is on.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2044
     Bits are counted from 1 starting with the least significant.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2045
     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
  2046
     but a new number is returned. Should be named #withBitSet:"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2047
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2048
%{  /* NOCONTEXT */
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2049
#ifndef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2050
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2051
        int index = __intVal(anInteger);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2052
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2053
        if (index > 0) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2054
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2055
            if (index <= 62)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2056
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2057
            if (index <= 30)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2058
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2059
            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2060
                INT mask = __MASKSMALLINT((INT)1 << (index-1));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2061
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2062
                RETURN ( ((OBJ) ((INT)self | (INT)mask)) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2063
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2064
        }
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2065
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2066
#endif /* not __SCHTEAM__ */
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2067
%}.
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5458
diff changeset
  2068
    ^ super setBit:anInteger
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2069
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2070
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2071
     (16r401 setBit:2     ) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2072
     (16r30000000 setBit:1) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2073
     (16r40000000 setBit:0) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2074
     (16r0 setBit:29) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2075
     (16r0 setBit:30) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2076
     (16r0 setBit:31) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2077
     (16r0 setBit:32) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2078
     (16r0 setBit:33) hexPrintString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2079
     (16r0 setBit:100) hexPrintString
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 4967
diff changeset
  2080
    "
6417
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  2081
! !
10effd5ab612 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6416
diff changeset
  2082
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2083
!SmallInteger methodsFor:'byte access'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2084
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2085
byteSwapped
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2086
    "lsb -> msb;
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2087
     i.e. a.b.c.d -> d.c.b.a"
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2088
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2089
    SmallInteger maxBytes == 8 ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2090
        ^ self byteSwapped64
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2091
    ] ifFalse:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2092
        ^ self byteSwapped32
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2093
    ].
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2094
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2095
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2096
     16r11223344 byteSwapped hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2097
     16r44332211 byteSwapped hexPrintString
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2098
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2099
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2100
    "Created: / 09-01-2012 / 23:01:33 / cg"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2101
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2102
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2103
byteSwapped16
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2104
    "for 16bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2105
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2106
     i.e. a.b -> b.a"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2107
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2108
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2109
#ifndef __SCHTEAM__
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2110
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2111
    unsigned INT swapped;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2112
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2113
    swapped = ((v>>8)&0xFF) | ((v & 0xFF)<<8);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2114
    RETURN (__mkSmallInteger(swapped));
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2115
#endif /* not __SCHTEAM__ */
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2116
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2117
    ^ super byteSwapped16
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2118
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2119
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2120
     16r1122 byteSwapped16 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2121
     16r2211 byteSwapped16 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2122
     16r332211 byteSwapped16 hexPrintString
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2123
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2124
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2125
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2126
byteSwapped32
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2127
    "for 32bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2128
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2129
     i.e. a.b.c.d -> d.c.b.a"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2130
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2131
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2132
#ifndef __SCHTEAM__
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2133
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2134
    unsigned INT swapped;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2135
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2136
# undef HAVE_BSWAP
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2137
# if __POINTER_SIZE__ == 4
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2138
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2139
#  if defined(USE_BSWAP) && defined(__BORLANDC__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2140
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2141
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2142
    _asm {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2143
        mov eax, v
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2144
        bswap eax
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2145
        mov swapped, eax
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2146
    };
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2147
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2148
#  if defined(USE_BSWAP) && defined(__VISUALC__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2149
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2150
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2151
    _asm {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2152
        mov eax, v
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2153
        xchg al, ah
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2154
        rol eax, 16
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2155
        xchg al, ah
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2156
        mov swapped, eax
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2157
    };
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2158
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2159
#  if defined(USE_BSWAP) && defined(__GNUC__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2160
#   define HAVE_BSWAP
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2161
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  2162
    asm("movl %1, %%eax \n\
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2163
         bswap %%eax    \n\
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2164
         movl %%eax, %0 \n\
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2165
        "
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2166
        : "=rm"  (swapped)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2167
        : "rm"   (v));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2168
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2169
# endif /* __POINTER_SIZE__ == 4 */
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2170
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2171
# if __POINTER_SIZE__ == 8
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2172
    v &= 0xFFFFFFFF;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2173
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  2174
#  if defined(__x86_64__) && defined(__GNUC__) && !defined(__CLANG__)
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2175
#   define HAVE_BSWAP
19133
Claus Gittinger <cg@exept.de>
parents: 19070
diff changeset
  2176
16537
d05618865bab class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16521
diff changeset
  2177
    asm("movq %1, %%rax \n\
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2178
         bswap %%eax    \n\
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2179
         movq %%rax, %0 \n\
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2180
        "
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2181
        : "=rm"  (swapped)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2182
        : "rm"   (v));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2183
#  endif
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2184
# endif
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2185
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2186
# ifndef HAVE_BSWAP
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2187
    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
  2188
# endif
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2189
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2190
    RETURN (__MKUINT(swapped));
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2191
#endif /* not __SCHTEAM__ */
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2192
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2193
    ^ super byteSwapped32
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2194
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2195
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2196
     16r11223344 byteSwapped32 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2197
     16r44332211 byteSwapped32 hexPrintString
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2198
    "
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2199
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2200
    "Created: / 09-01-2012 / 23:01:33 / cg"
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2201
!
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2202
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2203
byteSwapped64
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2204
    "for 64bit values only:
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2205
     lsb -> msb;
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2206
     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
  2207
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2208
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2209
#ifndef __SCHTEAM__
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2210
    unsigned INT v = __intVal(self);
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2211
    unsigned INT swapped;
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2212
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2213
# if __POINTER_SIZE__ == 4
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2214
    //   xxxxxxxx 00000000 00000000 00000000 -> 00000000 00000000 00000000 xxxxxxxx
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2215
    //            xxxxxxxx                                        xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2216
    //                     xxxxxxxx                      xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2217
    //                              xxxxxxxx    xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2218
    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
  2219
    RETURN(__MKLARGEINT64(1, 0, swapped));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2220
# else
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2221
    //   xxxxxxxx 00000000 00000000 00000000 -> 00000000 00000000 00000000 xxxxxxxx
15910
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2222
    //            xxxxxxxx                                        xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2223
    //                     xxxxxxxx                      xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2224
    //                              xxxxxxxx    xxxxxxxx
33ea5acc0934 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15600
diff changeset
  2225
    swapped =  (v>>56) | ((v>>40)&0xFF00) | ((v>>24) & 0xFF0000) | ((v>>8) & 0xFF000000)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2226
                | ((v & 0xFF000000)<<8) | ((v & 0x00FF0000)<<24) | ((v & 0x0000FF00)<<40)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2227
                | ((v & 0xFF)<<56);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2228
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2229
    RETURN(__MKUINT( swapped ));
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2230
#endif /* not __SCHTEAM__ */
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2231
%}.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2232
    ^ super byteSwapped64
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2233
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2234
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2235
     16r11223344 byteSwapped64 hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2236
     16r44332211 byteSwapped64 hexPrintString
13991
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2237
    "
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2238
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2239
    "Created: / 09-01-2012 / 23:01:33 / cg"
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2240
!
647fe34ce5a1 added: byteSwapped
Claus Gittinger <cg@exept.de>
parents: 13913
diff changeset
  2241
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2242
digitAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2243
    "return 8 bits of value, starting at byte index"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2244
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2245
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2246
#ifdef __SCHTEAM__
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2247
    int idx0Based = index.intValue() - 1;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2248
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2249
    if (idx0Based <= 7) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2250
        long myVal = self.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2251
        if (myVal < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2252
            myVal = -myVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2253
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2254
        int byteVal = (int)((myVal >> (idx0Based * 8)) & 0xFF);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2255
        return __c__._RETURN( STInteger._qnew(byteVal) );
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2256
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2257
    if (idx0Based > 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2258
        return __c__._RETURN( STInteger._0 );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2259
    }
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2260
#else
357
claus
parents: 329
diff changeset
  2261
    REGISTER INT val;
claus
parents: 329
diff changeset
  2262
    INT idx;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2263
252
  2264
    if (__isSmallInteger(index)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2265
        val = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2266
        if (val < 0)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2267
            val = -val;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2268
        switch (idx = __intVal(index)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2269
            case 1:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2270
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2271
            case 2:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2272
                val = (val >> 8);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2273
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2274
            case 3:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2275
                val = (val >> 16);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2276
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2277
            case 4:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2278
                val = (val >> 24);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2279
                break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2280
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2281
            case 5:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2282
                val = (val >> 32);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2283
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2284
            case 6:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2285
                val = (val >> 40);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2286
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2287
            case 7:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2288
                val = (val >> 48);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2289
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2290
            case 8:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2291
                val = (val >> 56);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2292
                break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2293
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2294
            default:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2295
                if (idx < 1)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2296
                    goto bad;   /* sorry */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2297
                RETURN (__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2298
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2299
        RETURN ( __mkSmallInteger( val & 0xFF) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2300
    }
357
claus
parents: 329
diff changeset
  2301
  bad: ;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2302
#endif /* not __SCHTEAM__ */
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2303
%}.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2304
    index > 0 ifFalse:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2305
        "
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2306
         index less than 1 - not allowed
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2307
        "
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2308
        ^ self primitiveFailed
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2309
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2310
    ^ 0
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  2311
357
claus
parents: 329
diff changeset
  2312
    "
claus
parents: 329
diff changeset
  2313
     (16r12345678 digitAt:1) printStringRadix:16
claus
parents: 329
diff changeset
  2314
     (16r12345678 digitAt:3) printStringRadix:16
claus
parents: 329
diff changeset
  2315
     (16r12345678 digitAt:15) printStringRadix:16
claus
parents: 329
diff changeset
  2316
     (16r12345678 digitAt:0) printStringRadix:16
claus
parents: 329
diff changeset
  2317
     (16r12345678 digitAt:-10) printStringRadix:16
claus
parents: 329
diff changeset
  2318
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2319
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2320
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2321
digitByteAt:index
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2322
    "return 8 bits of my signed value, starting at byte index.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2323
     For positive receivers, this is the same as #digitAt:;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2324
     for negative ones, the actual bit representation is returned."
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2325
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2326
%{  /* NOCONTEXT */
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2327
#ifdef __SCHTEAM__
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2328
    int idx0Based = index.intValue() - 1;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2329
    long myVal = self.longValue();
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2330
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2331
    if (idx0Based <= 7) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2332
        int byteVal = (int)((myVal >> (idx0Based * 8)) & 0xFF);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2333
        return __c__._RETURN( STInteger._qnew(byteVal) );
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2334
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2335
    if (idx0Based > 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2336
        if (myVal < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2337
            return __c__._RETURN( STInteger._M1 );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2338
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2339
            return __c__._RETURN( STInteger._0 );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2340
        }
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2341
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2342
#else
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2343
    REGISTER INT val;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2344
    INT idx;
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2345
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2346
    if (__isSmallInteger(index)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2347
        val = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2348
        switch (idx = __intVal(index)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2349
            case 1:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2350
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2351
            case 2:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2352
                val = (val >> 8);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2353
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2354
            case 3:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2355
                val = (val >> 16);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2356
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2357
            case 4:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2358
                val = (val >> 24);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2359
                break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2360
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2361
            case 5:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2362
                val = (val >> 32);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2363
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2364
            case 6:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2365
                val = (val >> 40);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2366
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2367
            case 7:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2368
                val = (val >> 48);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2369
                break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2370
            case 8:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2371
                val = (val >> 56);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2372
                break;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2373
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2374
            default:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2375
                if (idx < 1)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2376
                    goto bad;   /* sorry */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2377
                if (val < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2378
                    RETURN (__mkSmallInteger(0xFF));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2379
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2380
                RETURN (__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2381
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2382
        RETURN ( __mkSmallInteger( val & 0xFF) );
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2383
    }
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2384
  bad: ;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2385
#endif /* not __SCHTEAM__ */
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2386
%}.
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2387
    index > 0 ifFalse:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2388
        "
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2389
         index less than 1 - not allowed
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2390
        "
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2391
        ^ self primitiveFailed
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2392
    ].
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2393
    ^ 0
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2394
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2395
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2396
     (10 digitByteAt:1) printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2397
     (10 digitByteAt:3) printStringRadix:16
3892
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2398
     (-10 digitByteAt:1) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2399
     (-10 digitByteAt:3) printStringRadix:16
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2400
    "
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2401
!
ed306e60dfec added #digitByteAt:
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
  2402
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2403
digitBytes
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2404
    "return a byteArray filled with the receiver's bits
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2405
     (8 bits of the absolute value per element),
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2406
     least significant byte is first"
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2407
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2408
    |absValue
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2409
     b1 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2410
     b2 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2411
     b3 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2412
     b4 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2413
     b5 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2414
     b6 "{ Class: SmallInteger }"
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2415
     b7 "{ Class: SmallInteger }" digitByteArray|
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2416
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2417
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2418
     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
  2419
     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
  2420
     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
  2421
    "
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2422
    self == 0 ifTrue: [
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2423
        ^ ByteArray with:0.
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2424
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2425
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2426
    self < 0 ifTrue: [
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2427
        absValue := self negated
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2428
    ] ifFalse: [
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2429
        absValue := self.
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2430
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2431
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2432
    b1 := absValue bitAnd:16rFF.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2433
    absValue := absValue bitShift:-8.
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2434
    absValue == 0 ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2435
        digitByteArray := ByteArray with:b1
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2436
    ] ifFalse:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2437
        b2 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2438
        absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2439
        absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2440
            digitByteArray := ByteArray with:b1 with:b2
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2441
        ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2442
            b3 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2443
            absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2444
            absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2445
                digitByteArray := ByteArray with:b1 with:b2 with:b3
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2446
            ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2447
                b4 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2448
                absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2449
                absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2450
                    digitByteArray := ByteArray with:b1 with:b2 with:b3 with:b4
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2451
                ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2452
                    b5 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2453
                    absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2454
                    absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2455
                        digitByteArray := ByteArray new:5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2456
                        digitByteArray at:1 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2457
                        digitByteArray at:2 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2458
                        digitByteArray at:3 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2459
                        digitByteArray at:4 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2460
                        digitByteArray at:5 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2461
                    ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2462
                        b6 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2463
                        absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2464
                        absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2465
                            digitByteArray := ByteArray new:6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2466
                            digitByteArray at:1 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2467
                            digitByteArray at:2 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2468
                            digitByteArray at:3 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2469
                            digitByteArray at:4 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2470
                            digitByteArray at:5 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2471
                            digitByteArray at:6 put:b6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2472
                        ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2473
                            b7 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2474
                            absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2475
                            absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2476
                                digitByteArray := ByteArray new:7.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2477
                                digitByteArray at:1 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2478
                                digitByteArray at:2 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2479
                                digitByteArray at:3 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2480
                                digitByteArray at:4 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2481
                                digitByteArray at:5 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2482
                                digitByteArray at:6 put:b6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2483
                                digitByteArray at:7 put:b7.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2484
                            ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2485
                                digitByteArray := ByteArray new:8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2486
                                digitByteArray at:1 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2487
                                digitByteArray at:2 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2488
                                digitByteArray at:3 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2489
                                digitByteArray at:4 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2490
                                digitByteArray at:5 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2491
                                digitByteArray at:6 put:b6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2492
                                digitByteArray at:7 put:b7.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2493
                                digitByteArray at:8 put:absValue.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2494
                            ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2495
                        ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2496
                    ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2497
                ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2498
            ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2499
        ]
10487
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2500
    ].
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2501
f6287f4b83c9 Redefined #digitBytes without using an intermediate LargeInteger
Stefan Vogel <sv@exept.de>
parents: 10342
diff changeset
  2502
    ^ digitByteArray
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2503
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2504
    "
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2505
      16r12 digitBytes hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2506
      16r1234 digitBytes hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2507
      16r12345678 digitBytes hexPrintString
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2508
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2509
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2510
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2511
digitBytesMSB
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2512
    "return a byteArray filled with the receiver's bits
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2513
     (8 bits of the absolute value per element),
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2514
     most significant byte is first"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2515
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2516
    |absValue
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2517
     b1 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2518
     b2 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2519
     b3 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2520
     b4 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2521
     b5 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2522
     b6 "{ Class: SmallInteger }"
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2523
     b7 "{ Class: SmallInteger }" digitByteArray|
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2524
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2525
    "
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2526
     could have simply created a 4-byte largeinteger and normalize it.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2527
     The code below does the normalize right away, avoiding the
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2528
     overhead of producing any intermediate byte-arrays (and the scanning)
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2529
    "
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2530
    self == 0 ifTrue: [
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2531
        ^ ByteArray with:0.
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2532
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2533
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2534
    self < 0 ifTrue: [
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2535
        absValue := self negated
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2536
    ] ifFalse: [
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2537
        absValue := self.
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2538
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2539
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2540
    b1 := absValue bitAnd:16rFF.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2541
    absValue := absValue bitShift:-8.
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2542
    absValue == 0 ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2543
        digitByteArray := ByteArray with:b1
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2544
    ] ifFalse:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2545
        b2 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2546
        absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2547
        absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2548
            digitByteArray := ByteArray with:b2 with:b1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2549
        ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2550
            b3 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2551
            absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2552
            absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2553
                digitByteArray := ByteArray with:b3 with:b2 with:b1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2554
            ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2555
                b4 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2556
                absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2557
                absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2558
                    digitByteArray := ByteArray with:b4 with:b3 with:b2 with:b1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2559
                ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2560
                    b5 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2561
                    absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2562
                    absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2563
                        digitByteArray := ByteArray new:5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2564
                        digitByteArray at:1 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2565
                        digitByteArray at:2 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2566
                        digitByteArray at:3 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2567
                        digitByteArray at:4 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2568
                        digitByteArray at:5 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2569
                    ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2570
                        b6 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2571
                        absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2572
                        absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2573
                            digitByteArray := ByteArray new:6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2574
                            digitByteArray at:1 put:b6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2575
                            digitByteArray at:2 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2576
                            digitByteArray at:3 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2577
                            digitByteArray at:4 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2578
                            digitByteArray at:5 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2579
                            digitByteArray at:6 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2580
                        ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2581
                            b7 := absValue bitAnd:16rFF.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2582
                            absValue := absValue bitShift:-8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2583
                            absValue == 0 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2584
                                digitByteArray := ByteArray new:7.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2585
                                digitByteArray at:1 put:b7.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2586
                                digitByteArray at:2 put:b6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2587
                                digitByteArray at:3 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2588
                                digitByteArray at:4 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2589
                                digitByteArray at:5 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2590
                                digitByteArray at:6 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2591
                                digitByteArray at:7 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2592
                            ] ifFalse:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2593
                                digitByteArray := ByteArray new:8.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2594
                                digitByteArray at:1 put:absValue.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2595
                                digitByteArray at:2 put:b7.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2596
                                digitByteArray at:3 put:b6.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2597
                                digitByteArray at:4 put:b5.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2598
                                digitByteArray at:5 put:b4.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2599
                                digitByteArray at:6 put:b3.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2600
                                digitByteArray at:7 put:b2.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2601
                                digitByteArray at:8 put:b1.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2602
                            ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2603
                        ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2604
                    ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2605
                ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2606
            ]
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2607
        ]
15568
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2608
    ].
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2609
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2610
    ^ digitByteArray
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2611
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2612
    "
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2613
      16r12 digitBytesMSB hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2614
      16r1234 digitBytesMSB hexPrintString
e6ce93f948be new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15560
diff changeset
  2615
      16r12345678 digitBytesMSB hexPrintString
4827
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2616
    "
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2617
!
905b98a07798 New: #digitBytes and #digitBytesMSB:
Claus Gittinger <cg@exept.de>
parents: 4661
diff changeset
  2618
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2619
digitLength
19321
1948c58602d0 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19318
diff changeset
  2620
    "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
  2621
     For negative receivers, the result is not defined by the language standard.
1948c58602d0 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19318
diff changeset
  2622
     ST/X returns the digitLength of its absolute value."
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2623
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2624
%{  /* NOCONTEXT */
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2625
#ifdef __SCHTEAM__
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2626
    long val = self.longValue();
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2627
    int offs = 0;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2628
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2629
    if (val < 0) val = -val;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2630
    if ((val & 0xFFFFFFFF00000000L) != 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2631
        val >>= 32;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2632
        offs = 4;
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2633
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2634
    if ((val & 0xFFFF0000) != 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2635
        if ((val & 0xFF000000) != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2636
            offs += 4;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2637
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2638
            offs += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2639
        }
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2640
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2641
        if ((val & 0x0000FF00)!= 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2642
            offs += 2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2643
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2644
            offs += 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2645
        }
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2646
    }
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2647
    return __c__._RETURN( STInteger._qnew(offs) );
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2648
#else
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2649
    INT val = __intVal(self);
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2650
    int offs = 0;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2651
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2652
    if (val < 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2653
        val = -val;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2654
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2655
# if __POINTER_SIZE__ == 8
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2656
    if (val & 0xFFFFFFFF00000000L) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2657
        val >>= 32;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2658
        offs = 4;
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2659
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2660
# endif
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2661
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2662
    if (val & 0xFFFF0000) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2663
        if (val & 0xFF000000) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2664
            RETURN ( __mkSmallInteger(4+offs));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2665
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2666
            RETURN ( __mkSmallInteger(3+offs));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2667
        }
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2668
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2669
        if (val & 0x0000FF00) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2670
            RETURN ( __mkSmallInteger(2+offs));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2671
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2672
            RETURN ( __mkSmallInteger(1+offs));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2673
        }
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2674
    }
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  2675
#endif /* not SCHTEAM */
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2676
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2677
    ^ self abs highBit - 1 // 8 + 1
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2678
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2679
    "
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2680
     16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2681
     -16rFF00000000000000 digitLength
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2682
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2683
     16rFF000000 digitLength
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2684
     16rFF0000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2685
     16rFF00 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2686
     16rFF digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2687
     -16rFF000000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2688
     -16rFF0000 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2689
     -16rFF00 digitLength
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  2690
     -16rFF digitLength
2815
6a562d0fb864 tined #digitLength
Claus Gittinger <cg@exept.de>
parents: 2791
diff changeset
  2691
    "
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2692
!
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2693
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2694
swapBytes
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2695
    "swap bytes pair-wise in a positive integer
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2696
     i.e. a.b.c.d -> b.a.d.c.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2697
     The name may be misleading; actually a new integer is returned,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2698
     and the receiver is not modified.
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  2699
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2700
     Redefined here for speed.
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2701
     Swapping of negative integers is undefined and therefore not supported.
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2702
     This case is handled in the superclass."
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2703
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2704
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2705
#ifndef __SCHTEAM__
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2706
    unsigned INT v = __intVal(self);
16885
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2707
c8a865e3c540 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16873
diff changeset
  2708
    if ((INT)v >= 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2709
        unsigned INT swapped;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2710
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2711
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2712
        swapped = ((v >> 8) & 0x00FF00FF00FF00FF) | ((v & 0x00FF00FF00FF00FF) << 8);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2713
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2714
        swapped = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2715
# endif /* __POINTER_SIZE__ */
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2716
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2717
        //if (__ISVALIDINTEGER(swapped)) {   // sorry, but this does not work here if (INT)swapped would be negative
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2718
        if (swapped <= _MAX_INT) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2719
            RETURN ( __mkSmallInteger(swapped) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2720
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2721
        RETURN (__MKUINT(swapped));
15322
986b2cc65f2e class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15309
diff changeset
  2722
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2723
#endif
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2724
%}.
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2725
    ^ super swapBytes
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2726
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2727
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2728
     -1 swapBytes hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2729
     16r11223344 swapBytes hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2730
     16r44332211 swapBytes hexPrintString
16873
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  2731
     self maxVal swapBytes hexPrintString
50dc076eea8f class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 16537
diff changeset
  2732
     self maxVal swapBytes swapBytes hexPrintString
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2733
     16r1122334455667788 swapBytes hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2734
     16r11223344556677889900 swapBytes hexPrintString
14167
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2735
    "
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2736
4f6fd7a72967 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14003
diff changeset
  2737
    "Created: / 09-01-2012 / 23:01:33 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2738
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2739
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2740
!SmallInteger methodsFor:'catching messages'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2741
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2742
basicAt:index
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2743
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2744
     defined here since basicAt: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2745
14540
84fc4b759ad8 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14492
diff changeset
  2746
    ^ self notIndexed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2747
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2748
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2749
basicAt:index put:anObject
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2750
    "catch indexed access - report an error
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2751
     defined here since basicAt:put: in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2752
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2753
    self notIndexed
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2754
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2755
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2756
basicSize
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2757
    "return the number of indexed instvars - SmallIntegers have none.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2758
     Defined here since basicSize in Object ommits the SmallInteger check."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2759
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2760
    ^ 0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2761
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2762
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2763
size
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2764
    "return the number of indexed instvars - SmallIntegers have none."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2765
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2766
    ^ 0
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2767
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2768
5240
2a91958ba1f1 categories
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  2769
!SmallInteger methodsFor:'coercing & converting'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2770
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2771
asCharacter
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2772
    "Return a character with the receiver as ascii (actually: unicode) value"
41
a14247b04d03 *** empty log message ***
claus
parents: 13
diff changeset
  2773
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2774
    ^ Character value:self
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2775
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2776
    "
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2777
     Character value:16r61
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2778
     Character value:16r161
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2779
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2780
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2781
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2782
asFloat
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2783
    "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
  2784
     Redefined for performance (machine can do it faster)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2785
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2786
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2787
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2788
    return context._RETURN( STDouble._new((double)(self.longValue())) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2789
#else
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2790
    OBJ newFloat;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  2791
    double dVal = (double)__intVal(self);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2792
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  2793
    __qMKFLOAT(newFloat, dVal);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2794
    RETURN ( newFloat );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2795
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2796
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2797
    ^ self primitiveFailed
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2798
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2799
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2800
asLargeInteger
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2801
    "return a LargeInteger with same value as receiver.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2802
     Not for general use:
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2803
       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
  2804
       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
  2805
       This exists only as a helper for some algorithms and converters"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2806
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2807
    ^ LargeInteger value:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2808
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2809
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2810
asShortFloat
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  2811
    "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
  2812
     Redefined for performance (machine can do it faster)"
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2813
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2814
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2815
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2816
    return context._RETURN( STFloat._new((float)(self.longValue())) );
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2817
#else
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2818
    OBJ dummy = @global(ShortFloat);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2819
    OBJ newFloat;
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2820
    float fVal = (float)__intVal(self);
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2821
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  2822
    __qMKSFLOAT(newFloat, fVal);
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2823
    RETURN ( newFloat );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2824
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2825
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2826
    ^ self primitiveFailed
1199
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2827
!
c37d927155e2 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1137
diff changeset
  2828
18676
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2829
asUnsignedInt
18947
1d8cd5b315b2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18946
diff changeset
  2830
    "return an integer representing my unsigned INT value.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2831
     Notice, that the returned integer's size
18676
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2832
     depends heavily on the underlying INT size;
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2833
     You will get 16rFFFFFFFF on 32bit machines,
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2834
     but 16rFFFFFFFFFFFFFFFF on 64 bit machines.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2835
     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
  2836
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2837
%{  /* NOCONTEXT */
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2838
    INT iVal = __intVal(self);
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2839
    OBJ uiVal;
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2840
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2841
    uiVal = __MKUINT( (unsigned INT)iVal );
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2842
    RETURN ( uiVal );
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2843
%}.
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2844
    ^ self primitiveFailed
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2845
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2846
    "
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2847
     -1 asUnsignedInt hexPrintString -> 'FFFFFFFFFFFFFFFF'
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2848
     -16r8000 asUnsignedInt hexPrintString -> ''FFFFFFFFFFFF8000''
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2849
    "
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2850
!
151a213c4113 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18592
diff changeset
  2851
8408
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2852
codePoint
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2853
    "for compatibility with Characters.
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2854
     (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
  2855
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2856
    ^ self
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2857
!
61f12d6c1ab0 juergen gmeiners bug fix for bug #69
Claus Gittinger <cg@exept.de>
parents: 8365
diff changeset
  2858
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2859
coerce:aNumber
18846
1dfa7fa17f87 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18816
diff changeset
  2860
    "convert the argument aNumber into an instance of the receiver's class and return it."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2861
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2862
    ^ aNumber asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2863
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2864
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2865
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2866
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2867
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2868
    ^ 20
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2869
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2870
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2871
signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2872
    "return a smallInteger from sign-extending the 24'th bit.
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2873
     May be useful for communication interfaces"
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2874
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2875
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2876
#ifndef __SCHTEAM__
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2877
    INT i = __intVal(self);
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2878
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  2879
    if (i & 0x800000L) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2880
        i = i | ~((INT)0xFFFFFF);
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2881
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2882
        i = i & 0x7FFFFF;
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2883
    }
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2884
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2885
    RETURN (__mkSmallInteger(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2886
#endif
12866
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2887
%}.
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2888
    ^ self primitiveFailed
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2889
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2890
    "
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2891
     16rFFFFFF signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2892
     16r800000 signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2893
     16r7FFFFF signExtended24BitValue
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2894
    "
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2895
!
42e5e690c197 added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 12787
diff changeset
  2896
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2897
signExtendedByteValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2898
    "return a smallInteger from sign-extending the 8'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2899
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2900
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2901
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2902
#ifndef __SCHTEAM__
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  2903
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2904
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2905
    if (i & 0x80) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2906
        i = i | ~((INT)0xFF);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2907
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2908
        i = i & 0x7F;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2909
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2910
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2911
    RETURN (__mkSmallInteger(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2912
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2913
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2914
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2915
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2916
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2917
     16rFF signExtendedByteValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2918
     16r80 signExtendedByteValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2919
     16r7F signExtendedByteValue
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2920
    "
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2921
!
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2922
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2923
signExtendedLongValue
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2924
    "return a smallInteger from sign-extending the 32'th bit.
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2925
     May be useful for communication interfaces"
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2926
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2927
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2928
#ifndef __SCHTEAM__
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2929
    INT i = __intVal(self);
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2930
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  2931
    if (i & 0x80000000L) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2932
        i = i | ~((INT)0xFFFFFFFF);
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2933
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2934
        i = i & 0x7FFFFFFFL;
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2935
    }
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2936
19264
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  2937
    RETURN (__MKINT(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2938
#endif
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2939
%}.
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2940
    ^ self primitiveFailed
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2941
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2942
    "
19264
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  2943
     16rFFFFFFFF signExtendedLongValue -> -1
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  2944
     16r80000000 signExtendedLongValue -> -2147483648
11160ea2c8b3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19263
diff changeset
  2945
     16r7FFFFFFF signExtendedLongValue -> 2147483647
15083
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2946
    "
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2947
!
0b700edf1d1b class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 14795
diff changeset
  2948
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2949
signExtendedShortValue
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2950
    "return a smallInteger from sign-extending the 16'th bit.
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2951
     May be useful for communication interfaces"
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2952
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2953
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2954
#ifndef __SCHTEAM__
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  2955
    INT i = __intVal(self);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2956
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2957
    if (i & 0x8000) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2958
        i = i | ~((INT)0xFFFF);
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2959
    } else {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2960
        i = i & 0x7FFF;
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2961
    }
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2962
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8908
diff changeset
  2963
    RETURN (__mkSmallInteger(i));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2964
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2965
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  2966
    ^ self primitiveFailed
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2967
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2968
    "
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2969
     16rFFFF signExtendedShortValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2970
     16r8000 signExtendedShortValue
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  2971
     16r7FFF signExtendedShortValue
1336
041485f6757a sign extension support
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2972
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2973
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2974
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2975
!SmallInteger methodsFor:'comparing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2976
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2977
< aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2978
    "return true, if the argument is greater than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2979
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2980
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  2981
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  2982
    return context._RETURN( self.ltP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2983
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2984
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2985
# ifdef POSITIVE_ADDRESSES
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2986
        RETURN ( (__intVal(self) < __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2987
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2988
        /* tag bit does not change ordering */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2989
        RETURN ( ((INT)self < (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  2990
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2991
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2992
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  2993
        RETURN ( ((double)__intVal(self) < __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2994
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  2995
#endif /* not __SCHTEAM__ */
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  2996
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2997
    ^ aNumber lessFromInteger:self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2998
    "^ self retry:#< coercing:aNumber"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  2999
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3000
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3001
<= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3002
    "return true, if the argument is greater or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3003
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3004
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3005
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3006
    return context._RETURN( self.leP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3007
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3008
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3009
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3010
# ifdef POSITIVE_ADDRESSES
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3011
        RETURN ( (__intVal(self) <= __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3012
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3013
        /* tag bit does not change ordering */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3014
        RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3015
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3016
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3017
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3018
        RETURN ( ((double)__intVal(self) <= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3019
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3020
#endif /* not __SCHTEAM__ */
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3021
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3022
    ^ (self > aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3023
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3024
    "Modified: / 31.7.2002 / 10:07:17 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3025
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3026
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3027
= aNumber
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3028
    "return true, if the argument represents the same numeric value
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3029
     as the receiver, false otherwise"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3030
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3031
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3032
#ifdef __SCHTEAM__
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3033
    if (aNumber.isNumber()) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3034
        return context._RETURN( aNumber.eqvP( self.longValue() ));
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3035
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3036
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3037
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3038
    if (aNumber == self) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3039
        RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3040
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3041
    if (! __isNonNilObject(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3042
        /* a smallint or nil */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3043
        RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3044
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3045
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3046
    if (__qIsFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3047
        RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3048
    }
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3049
    if (__qIsShortFloat(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3050
        RETURN ( ((double)__intVal(self) == __shortFloatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3051
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3052
#endif /* not __SCHTEAM__ */
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3053
%}.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3054
    ^ aNumber equalFromInteger:self
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3055
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3056
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3057
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3058
    "return true, if the argument is less than the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3059
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3060
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3061
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3062
    return context._RETURN( self.gtP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3063
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3064
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3065
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3066
# ifdef POSITIVE_ADDRESSES
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3067
        RETURN ( (__intVal(self) > __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3068
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3069
        /* tag bit does not change ordering */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3070
        RETURN ( ((INT)self > (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3071
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3072
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3073
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3074
        RETURN ( ((double)__intVal(self) > __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3075
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3076
#endif /* not __SCHTEAM__ */
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3077
%}.
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3078
    ^ (aNumber < self)
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3079
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3080
    "Modified: / 31.7.2002 / 10:07:05 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3081
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3082
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3083
>= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3084
    "return true, if the argument is less or equal"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3085
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3086
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3087
#ifdef __SCHTEAM__
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3088
    return context._RETURN( self.geP( aNumber ));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3089
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3090
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3091
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3092
# ifdef POSITIVE_ADDRESSES
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3093
        RETURN ( (__intVal(self) >= __intVal(aNumber)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3094
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3095
        /* tag bit does not change ordering */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3096
        RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3097
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3098
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3099
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3100
        RETURN ( ((double)__intVal(self) >= __floatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3101
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3102
#endif /* not __SCHTEAM__ */
5930
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3103
%}.
d7728046c2e1 compare fallBacks changed to enable VW compatible double dispatching
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3104
    ^ (self < aNumber) not
6676
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3105
15f2e3080e13 double dispatch fallback code in comparing fixed
Claus Gittinger <cg@exept.de>
parents: 6482
diff changeset
  3106
    "Modified: / 31.7.2002 / 10:07:11 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3107
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3108
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3109
hash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3110
    "return an integer useful for hashing on value"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3111
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3112
    self >= 0 ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3113
    ^ self negated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3114
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3115
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3116
hashMultiply
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3117
    "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
  3118
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3119
    |low|
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3120
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3121
    low := self bitAnd: 16r3FFF.
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3122
    ^ (9741 * low
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3123
      + ((9741 * (self bitShift: -14) + (101 * low) bitAnd: 16383) * 16384))
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3124
        bitAnd: 16r0FFFFFFF
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3125
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3126
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3127
     1 hashMultiply
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3128
     2 hashMultiply
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3129
     3 hashMultiply
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3130
     100 hashMultiply
17247
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3131
    "
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3132
!
e4e29302c10a class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17036
diff changeset
  3133
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3134
identityHash
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3135
    "return an integer useful for hashing on identity"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3136
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  3137
     self >= 0 ifTrue:[^ self].
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  3138
     ^ self negated
1963
ea26c7b9ca1d experimental: new hash value for smallInts
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3139
1964
20bb7197d19f oops - the last one was no good
Claus Gittinger <cg@exept.de>
parents: 1963
diff changeset
  3140
    "Modified: 11.11.1996 / 18:42:14 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3141
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3142
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3143
max:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3144
    "return the receiver or the argument, whichever is greater"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3145
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3146
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3147
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3148
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3149
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3150
# if TAG_INT == 1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3151
        /* tag bit does not change ordering */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3152
        if ((INT)(self) > (INT)(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3153
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3154
        if (__intVal(self) > __intVal(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3155
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3156
        {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3157
            RETURN ( self );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3158
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3159
        RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3160
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3161
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3162
        if ( (double)__intVal(self) > __floatVal(aNumber) ) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3163
            RETURN ( self );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3164
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3165
        RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3166
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3167
#endif /* not __SCHTEAM__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3168
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3169
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3170
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3171
    (self > aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3172
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3173
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3174
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3175
min:aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3176
    "return the receiver or the argument, whichever is smaller"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3177
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3178
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3179
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3180
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3181
    if (__isSmallInteger(aNumber)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3182
# if TAG_INT == 1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3183
        /* tag bit does not change ordering */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3184
        if ((INT)(self) < (INT)(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3185
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3186
        if (__intVal(self) < __intVal(aNumber))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3187
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3188
        {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3189
            RETURN ( self );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3190
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3191
        RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3192
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3193
    if (__isFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3194
        if ( (double)__intVal(self) < __floatVal(aNumber) ) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3195
            RETURN ( self );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3196
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3197
        RETURN ( aNumber );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3198
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3199
#endif /* not __SCHTEAM__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3200
%}.
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3201
    "/ fallback for non-smallInteger argument
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3202
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3203
    (self < aNumber) ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3204
    ^ aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3205
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3206
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3207
~= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3208
    "return true, if the arguments value is not equal to mine"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3209
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3210
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3211
#ifdef __SCHTEAM__
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3212
    if (aNumber.isNumber()) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3213
        return context._RETURN( (aNumber.isEqv( self.longValue() )) ? STObject.False : STObject.True);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3214
        /* NOTREACHED */
18699
24b9c15dc6aa steam stuff
Claus Gittinger <cg@exept.de>
parents: 18676
diff changeset
  3215
    }
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  3216
#else
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3217
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3218
    if (aNumber == self) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3219
        RETURN ( false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3220
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3221
    if (! __isNonNilObject(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3222
        /* a smallint or nil */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3223
        RETURN ( true );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3224
    }
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3225
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3226
    if (__qIsFloatLike(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3227
        RETURN ( ((double)__intVal(self) != __floatVal(aNumber)) ? true : false );
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3228
    }
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3229
    if (__qIsShortFloat(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3230
        RETURN ( ((double)__intVal(self) != __shortFloatVal(aNumber)) ? true : false );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3231
    }
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  3232
#endif /* not __SCHTEAM__ */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3233
%}.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  3234
    ^ (self = aNumber) not
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3235
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3236
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3237
!SmallInteger methodsFor:'copying'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3238
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3239
deepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3240
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3241
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3242
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3243
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3244
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3245
10947
e01ba2c3533f deepCopy change
ab
parents: 10487
diff changeset
  3246
deepCopyUsing:aDictionary postCopySelector:postCopySelector
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3247
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3248
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3249
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3250
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3251
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3252
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3253
shallowCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3254
    "return a shallow copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3255
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3256
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3257
    ^ self
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
simpleDeepCopy
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3261
    "return a deep copy of myself
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3262
     - reimplemented here since smallintegers are unique"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3263
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3264
    ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3265
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3266
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  3267
214
2e4defd713f9 *** empty log message ***
claus
parents: 159
diff changeset
  3268
!SmallInteger methodsFor:'iteration'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3269
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3270
timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  3271
    "evaluate the argument, aBlock self times.
claus
parents: 329
diff changeset
  3272
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3273
357
claus
parents: 329
diff changeset
  3274
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3275
#ifndef __SCHTEAM__
357
claus
parents: 329
diff changeset
  3276
    REGISTER INT tmp;
claus
parents: 329
diff changeset
  3277
    static struct inlineCache blockVal = __ILC0(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3278
357
claus
parents: 329
diff changeset
  3279
    tmp = __intVal(self);
claus
parents: 329
diff changeset
  3280
    if (tmp > 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3281
        if (__isBlockLike(aBlock)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3282
         && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(0))) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3283
            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3284
                REGISTER OBJFUNC codeVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3285
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3286
                /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3287
                 * specially tuned version for compiled blocks,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3288
                 * (the most common case)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3289
                 */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3290
                if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3291
# ifdef PARANOIA
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3292
                 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3293
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3294
                ) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3295
#                   define BLOCK_ARG  aBlock
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3296
                    {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3297
# ifdef __UNROLL_LOOPS__
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3298
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3299
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3300
                         * you are not supposed to program like this - I know what I do
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3301
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3302
                        while (tmp > 8) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3303
                            if (InterruptPending != nil) goto interrupted0;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3304
        continue0:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3305
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3306
                            if (InterruptPending != nil) goto interrupted1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3307
        continue1:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3308
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3309
                            if (InterruptPending != nil) goto interrupted2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3310
        continue2:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3311
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3312
                            if (InterruptPending != nil) goto interrupted3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3313
        continue3:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3314
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3315
                            if (InterruptPending != nil) goto interrupted4;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3316
        continue4:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3317
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3318
                            if (InterruptPending != nil) goto interrupted5;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3319
        continue5:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3320
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3321
                            if (InterruptPending != nil) goto interrupted6;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3322
        continue6:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3323
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3324
                            if (InterruptPending != nil) goto interrupted7;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3325
        continue7:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3326
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3327
                            tmp -= 8;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3328
                        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3329
# endif /* __UNROLL_LOOPS__ */
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3330
                        do {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3331
                            if (InterruptPending != nil) goto interruptedX;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3332
        continueX:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3333
                            (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3334
                        } while(--tmp);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3335
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3336
                        RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3337
                        if (0) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3338
# ifdef __UNROLL_LOOPS__
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3339
                            interrupted0:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3340
                                                __interruptL(@line); goto continue0;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3341
                            interrupted1:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3342
                                                __interruptL(@line); goto continue1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3343
                            interrupted2:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3344
                                                __interruptL(@line); goto continue2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3345
                            interrupted3:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3346
                                                __interruptL(@line); goto continue3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3347
                            interrupted4:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3348
                                                __interruptL(@line); goto continue4;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3349
                            interrupted5:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3350
                                                __interruptL(@line); goto continue5;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3351
                            interrupted6:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3352
                                                __interruptL(@line); goto continue6;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3353
                            interrupted7:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3354
                                                __interruptL(@line); goto continue7;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3355
# endif /* __UNROLL_LOOPS__ */
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3356
                            interruptedX:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3357
                                                __interruptL(@line); goto continueX;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3358
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3359
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3360
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3361
            }
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  3362
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3363
#           undef BLOCK_ARG
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3364
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3365
#           define BLOCK_ARG  aBlock
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3366
#           define IBLOCK_ARG nil
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3367
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3368
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3369
             * sorry - must check for the blocks code within the loops;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3370
             * it could be recompiled or flushed (in the interrupt)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3371
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3372
            do {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3373
                REGISTER OBJFUNC codeVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3374
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3375
                if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3376
                    /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3377
                     * arg is a compiled block with code -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3378
                     * directly call it without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3379
                     * however, if there is an interrupt, refetch the code pointer.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3380
                     */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3381
                    /* stay here, while no interrupts are pending ... */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3382
                    do {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3383
                        (*codeVal)(BLOCK_ARG);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3384
                        if (InterruptPending != nil) goto outerLoop;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3385
                    } while (--tmp);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3386
                    RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3387
                } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3388
                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3389
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3390
                    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3391
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3392
                         * arg is a compiled block with bytecode -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3393
                         * directly call interpreter without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3394
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3395
                        __interpret(aBlock, 0, nil, IBLOCK_ARG, nil, nil);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3396
                    } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3397
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3398
                         * arg is something else - call it with #value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3399
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3400
                        (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3401
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3402
                }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3403
    outerLoop: ;
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3404
            } while (--tmp);
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3405
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3406
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3407
#           undef IBLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3408
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3409
            RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3410
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3411
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3412
        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3413
         * not a block-like thingy - call it with #value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3414
         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3415
        do {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3416
            if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3417
            (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3418
        } while(--tmp);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3419
        RETURN (self);
357
claus
parents: 329
diff changeset
  3420
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3421
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3422
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  3423
    ^ super timesRepeat:aBlock
357
claus
parents: 329
diff changeset
  3424
claus
parents: 329
diff changeset
  3425
"/    |count "{ Class: SmallInteger }" |
claus
parents: 329
diff changeset
  3426
"/
claus
parents: 329
diff changeset
  3427
"/    count := self.
claus
parents: 329
diff changeset
  3428
"/    [count > 0] whileTrue:[
claus
parents: 329
diff changeset
  3429
"/        aBlock value.
claus
parents: 329
diff changeset
  3430
"/        count := count - 1
claus
parents: 329
diff changeset
  3431
"/    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3432
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3433
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3434
to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3435
    "reimplemented as primitive for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3436
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3437
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3438
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3439
    REGISTER INT tmp, step;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3440
    REGISTER INT final;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3441
    static struct inlineCache blockVal = __ILC1(0);
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3442
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3443
    if (__bothSmallInteger(incr, stop)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3444
        tmp = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3445
        final = __intVal(stop);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3446
        step = __intVal(incr);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3447
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3448
        if (__isBlockLike(aBlock)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3449
         && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3450
            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3451
                REGISTER OBJFUNC codeVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3452
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3453
                /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3454
                 * specially tuned version for static compiled blocks, called with
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3455
                 * home on the stack (the most common case)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3456
                 */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3457
                if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3458
# ifdef PARANOIA
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3459
                 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3460
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3461
                ) {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3462
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3463
#                   define BLOCK_ARG  aBlock
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3464
                    {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3465
                        if (step < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3466
                            if (step == -1) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3467
                                while (tmp >= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3468
                                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3469
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3470
                                    tmp--;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3471
                                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3472
                            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3473
                                while (tmp >= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3474
                                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3475
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3476
                                    tmp += step;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3477
                                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3478
                            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3479
                        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3480
                            if (step == 1) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3481
                                while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3482
                                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3483
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3484
                                    tmp++;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3485
                                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3486
                            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3487
                                while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3488
                                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3489
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3490
                                    tmp += step;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3491
                                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3492
                            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3493
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3494
                        RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3495
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3496
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3497
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3498
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3499
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3500
             * sorry - must check for the blocks code within the loops;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3501
             * it could be recompiled or flushed (in the interrupt)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3502
             */
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3503
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3504
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3505
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3506
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3507
#           define IBLOCK_ARG nil
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3508
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3509
            if (step < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3510
                while (tmp >= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3511
                    REGISTER OBJFUNC codeVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3512
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3513
                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3514
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3515
                    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3516
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3517
                         * arg is a compiled block with code -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3518
                         * directly call it without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3519
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3520
                        (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3521
                    } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3522
                        if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3523
                            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3524
                             * arg is a compiled block with bytecode -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3525
                             * directly call interpreter without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3526
                             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3527
# ifdef PASS_ARG_POINTER
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3528
                            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3529
                                OBJ idx;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3530
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3531
                                idx = __mkSmallInteger(tmp);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3532
                                __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3533
                            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3534
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3535
                            __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3536
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3537
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3538
                        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3539
                            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3540
                             * arg is something else - call it with #value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3541
                             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3542
                            (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3543
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3544
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3545
                    tmp += step;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3546
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3547
            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3548
                while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3549
                    REGISTER OBJFUNC codeVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3550
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3551
                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3552
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3553
                    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3554
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3555
                         * arg is a compiled block with code -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3556
                         * directly call it without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3557
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3558
                        (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3559
                    } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3560
                        if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3561
                            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3562
                             * arg is a compiled block with bytecode -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3563
                             * directly call interpreter without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3564
                             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3565
# ifdef PASS_ARG_POINTER
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3566
                            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3567
                                OBJ idx;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3568
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3569
                                idx = __mkSmallInteger(tmp);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3570
                                __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3571
                            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3572
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3573
                            __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3574
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3575
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3576
                        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3577
                            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3578
                             * arg is something else - call it with #value:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3579
                             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3580
                            (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3581
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3582
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3583
                    tmp += step;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3584
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3585
            }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3586
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3587
#           undef BLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3588
#           undef IBLOCK_ARG
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3589
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3590
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3591
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3592
             * arg is something else - call it with #value:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3593
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3594
            if (step < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3595
                while (tmp >= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3596
                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3597
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3598
                    (*blockVal.ilc_func)(aBlock,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3599
                                         @symbol(value:),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3600
                                         nil, &blockVal,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3601
                                         __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3602
                    tmp += step;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3603
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3604
            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3605
                while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3606
                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3607
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3608
                    (*blockVal.ilc_func)(aBlock,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3609
                                         @symbol(value:),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3610
                                         nil, &blockVal,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3611
                                         __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3612
                    tmp += step;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3613
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3614
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3615
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3616
        RETURN ( self );
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3617
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3618
#endif
1672
1b56d6e95c9e changes to call dynamic compiled code right after compilation.
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  3619
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3620
    "/
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3621
    "/ 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
  3622
    "/ pass on to super ...
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3623
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3624
    ^ super to:stop by:incr do:aBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3625
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3626
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3627
     1 to:10 by:3 do:[:i | i printNewline]
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3628
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3629
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3630
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3631
to:stop do:aBlock
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3632
    "evaluate aBlock for every integer between (and including) the receiver
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3633
     and the argument, stop.
357
claus
parents: 329
diff changeset
  3634
     Reimplemented as primitive for speed"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3635
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3636
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3637
#ifndef __SCHTEAM__
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3638
    REGISTER INT tmp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3639
    INT final;
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3640
    static struct inlineCache blockVal = __ILC1(0);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3641
252
  3642
    if (__isSmallInteger(stop)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3643
        tmp = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3644
        final = __intVal(stop);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3645
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3646
        if (__isBlockLike(aBlock)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3647
         && (__BlockInstPtr(aBlock)->b_nargs == __mkSmallInteger(1))) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3648
            {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3649
                /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3650
                 * specially tuned version for the most common case,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3651
                 * where called with home on the stack
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3652
                 */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3653
                REGISTER OBJFUNC codeVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3654
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3655
                if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
2254
5e3cb9e7e682 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2216
diff changeset
  3656
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3657
#                   define BLOCK_ARG  aBlock
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3658
                    {
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3659
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3660
# ifdef PARANOIA
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3661
                        if (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3662
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3663
                        {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3664
                            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3665
                             * static compiled blocks ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3666
                             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3667
# ifdef __UNROLL_LOOPS__
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3668
                            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3669
                             * The following code is designed to run as fast as possible;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3670
                             *  - taken branches only if interrupts are pending
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3671
                             *  - only forward branches (which are usually predicted as not taken)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3672
                             *  - unrolled the loop
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3673
                             *
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3674
                             * you are not supposed to program like this - I know what I do
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3675
                             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3676
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3677
                            INT t8 = (INT)(__mkSmallInteger(tmp+8));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3678
                            tmp = (INT)(__mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3679
                            final = (INT)(__mkSmallInteger(final));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3680
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3681
                            INT t8 = tmp+8;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3682
#  endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3683
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3684
                            for (;;) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3685
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3686
                                while (t8 <= final) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3687
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3688
                                    t8 += (INT)(__MASKSMALLINT(8));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3689
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3690
                                    t8 += 8;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3691
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3692
                                    if (InterruptPending != nil) goto interrupted0;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3693
        continue0:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3694
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3695
                                    (*codeVal)(BLOCK_ARG, tmp);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3696
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3697
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3698
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3699
                                    if (InterruptPending != nil) goto interrupted1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3700
        continue1:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3701
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3702
                                    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(1)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3703
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3704
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+1));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3705
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3706
                                    if (InterruptPending != nil) goto interrupted2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3707
        continue2:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3708
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3709
                                    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(2)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3710
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3711
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+2));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3712
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3713
                                    if (InterruptPending != nil) goto interrupted3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3714
        continue3:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3715
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3716
                                    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(3)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3717
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3718
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+3));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3719
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3720
                                    if (InterruptPending != nil) goto interrupted4;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3721
        continue4:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3722
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3723
                                    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(4)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3724
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3725
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+4));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3726
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3727
                                    if (InterruptPending != nil) goto interrupted5;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3728
        continue5:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3729
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3730
                                    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(5)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3731
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3732
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+5));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3733
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3734
                                    if (InterruptPending != nil) goto interrupted6;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3735
        continue6:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3736
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3737
                                    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(6)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3738
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3739
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+6));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3740
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3741
                                    if (InterruptPending != nil) goto interrupted7;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3742
        continue7:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3743
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3744
                                    (*codeVal)(BLOCK_ARG, tmp+(INT)(__MASKSMALLINT(7)) );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3745
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3746
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp+7));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3747
#  endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3748
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3749
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3750
                                    tmp += (INT)(__MASKSMALLINT(8));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3751
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3752
                                    tmp += 8;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3753
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3754
                                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3755
                                while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3756
                                    if (InterruptPending != nil) goto interruptedX;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3757
        continueX:
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3758
#  if TAG_INT==1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3759
                                    (*codeVal)(BLOCK_ARG, tmp);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3760
                                    tmp += (INT)(__MASKSMALLINT(1));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3761
#  else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3762
                                    (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3763
                                    tmp++;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3764
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3765
                                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3766
                                RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3767
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3768
                                if (0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3769
                                    /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3770
                                     * no discussion about those gotos ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3771
                                     * ... its better for your CPU's pipelines
20819
b64a4707d4ea #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20339
diff changeset
  3772
                                     * (if you don't understand why, just don't argue).
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3773
                                     */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3774
                                    interrupted7:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3775
                                                    __interruptL(@line); goto continue7;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3776
                                    interrupted6:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3777
                                                    __interruptL(@line); goto continue6;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3778
                                    interrupted5:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3779
                                                    __interruptL(@line); goto continue5;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3780
                                    interrupted4:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3781
                                                    __interruptL(@line); goto continue4;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3782
                                    interrupted3:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3783
                                                    __interruptL(@line); goto continue3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3784
                                    interrupted2:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3785
                                                    __interruptL(@line); goto continue2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3786
                                    interrupted1:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3787
                                                    __interruptL(@line); goto continue1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3788
                                    interrupted0:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3789
                                                    __interruptL(@line); goto continue0;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3790
                                    interruptedX:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3791
                                                    __interruptL(@line); goto continueX;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3792
                                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3793
                            }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3794
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3795
                            while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3796
                                if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3797
                                (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3798
                                tmp ++;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3799
                            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3800
                            RETURN (self);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3801
# endif /* __UNROLL_LOOPS__ */
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3802
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3803
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3804
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3805
                         * mhmh - seems to be a block with dynamic code
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3806
                         * must refetch, to allow dynamic recompilation or code flush.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3807
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3808
                        while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3809
                            if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3810
                            if ((codeVal = __BlockInstPtr(aBlock)->b_code) == (OBJFUNC)nil) break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3811
                            (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3812
                            tmp ++;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3813
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3814
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3815
                        if (tmp > final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3816
                            RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3817
                        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3818
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3819
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3820
            }
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3821
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3822
#           undef BLOCK_ARG
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3823
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3824
#           define BLOCK_ARG  aBlock
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3825
#           define IBLOCK_ARG nil
1036
d79dc9e4c6f5 binary storage stuff is not needed here
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3826
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3827
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3828
             * sorry - must check for the blocks code within the loops;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3829
             * it could be recompiled or flushed (in the interrupt)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3830
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3831
            while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3832
                REGISTER OBJFUNC codeVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3833
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3834
                if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3835
                    /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3836
                     * arg is a compiled block with code -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3837
                     * directly call it without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3838
                     */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3839
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3840
                    /* stay here, while no interrupts are pending ... */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3841
                    do {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3842
                        (*codeVal)(BLOCK_ARG, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3843
                        if (InterruptPending != nil) goto outerLoop;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3844
                        tmp++;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3845
                    } while (tmp <= final);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3846
                    RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3847
                } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3848
                    if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3849
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3850
                    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3851
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3852
                         * arg is a compiled block with bytecode -
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3853
                         * directly call interpreter without going through Block>>value
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3854
                         */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3855
# ifdef PASS_ARG_POINTER
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3856
                        {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3857
                            OBJ idx;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3858
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3859
                            idx = __mkSmallInteger(tmp);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3860
                            __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3861
                        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3862
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3863
                        __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __mkSmallInteger(tmp));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3864
# endif
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3865
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3866
                    } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3867
                        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3868
                         * arg is something else - call it with #value:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3869
                         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3870
                        (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3871
                    }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3872
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3873
            outerLoop: ;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3874
                tmp++;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3875
            }
2650
8a31202275ff oops - last optimization was wrong
Claus Gittinger <cg@exept.de>
parents: 2649
diff changeset
  3876
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3877
#           undef BLOCK_ARG
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  3878
#           undef IBLOCK_ARG
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3879
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3880
            RETURN (self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3881
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3882
        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3883
         * arg is something else - call it with #value:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3884
         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3885
        while (tmp <= final) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3886
            if (InterruptPending != nil) __interruptL(@line);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3887
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3888
            (*blockVal.ilc_func)(aBlock,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3889
                                         @symbol(value:),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3890
                                         nil, &blockVal,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3891
                                         __mkSmallInteger(tmp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3892
            tmp++;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3893
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3894
        RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3895
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3896
#endif /* not __SCHTEAM__ */
400
claus
parents: 394
diff changeset
  3897
%}.
2187
37b82d044439 care for blocks being recompiled, or code being flushed while
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  3898
400
claus
parents: 394
diff changeset
  3899
    "/
claus
parents: 394
diff changeset
  3900
    "/ 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
  3901
    "/ pass on to super ...
400
claus
parents: 394
diff changeset
  3902
    "/
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3903
    ^ super to:stop do:aBlock
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  3904
216
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3905
    "
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3906
     1 to:10 do:[:i | i printNewline]
a8abff749575 *** empty log message ***
claus
parents: 214
diff changeset
  3907
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3908
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3909
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  3910
!SmallInteger methodsFor:'misc math'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3911
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3912
bernoulli
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3913
    "returns the nth Bernoulli number.
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3914
     The series runs this:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3915
         1/6, 1/30, 1/42, 1/30, 5/66, 691/2730, etc
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3916
     Uses a table of the first 20 bernoulli numbers.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3917
     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
  3918
     Used with taylor series for tan"
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3919
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3920
    |table p|
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3921
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3922
    table := #(
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3923
                (1 6)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3924
                (-1 30)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3925
                (1 42)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3926
                (-1 30)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3927
                (5 66)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3928
                (-691 2730)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3929
                (7 6)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3930
                (-3617 510)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3931
                (43867 798)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3932
                (-174611 330)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3933
                (854513 138)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3934
                (-236364091 2730)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3935
                (8553103 6)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3936
                (-23749461029 870)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3937
                (8615841276005 14322)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3938
                (-7709321041217 510)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3939
                (2577687858367 6)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3940
                (-26315271553053477373 1919190)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3941
                (2929993913841559 6)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3942
                (-261082718496449122051 13530)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3943
              ).
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3944
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3945
    self even ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3946
        self == 0 ifTrue:[^1].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3947
        p := table at:(self / 2).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3948
        ^ 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
  3949
    ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3950
    self == 1 ifTrue:[ ^ (1 / 2) ].
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3951
    ^ 0.
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3952
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3953
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3954
     0 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3955
     1 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3956
     2 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3957
     3 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3958
     4 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3959
     5 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3960
     6 bernoulli
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  3961
     8 bernoulli
7438
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3962
     38 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3963
     40 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3964
     41 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3965
     42 bernoulli
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3966
    "
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3967
!
f5f6fd13b1df code refactoring for metaNumbers and complete double dispatch.
Claus Gittinger <cg@exept.de>
parents: 7356
diff changeset
  3968
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3969
divMod:aNumber
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3970
    "return an array filled with
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3971
        (self // aNumber) and (self \\ aNumber).
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3972
     The returned remainder has the same sign as aNumber.
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3973
     The following is always true:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3974
        (receiver // something) * something + (receiver \\ something) = receiver
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3975
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3976
     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
  3977
     Especially surprising:
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3978
        -1 \\ 10 -> 9  (because -(1/10) is truncated towards next smaller integer, which is -1,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3979
                        and -1 multiplied by 10 gives -10, so we have to add 9 to get the original -1).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3980
        -10 \\ 3 -> 2 (because -(10/3) is truncated towards next smaller integer, which is -4,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3981
                        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
  3982
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  3983
     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
  3984
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3985
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  3986
#ifndef __SCHTEAM__
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3987
    INT val, div, mod, mySelf;
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3988
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3989
    if (__isSmallInteger(aNumber)
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3990
     && ((val = __intVal(aNumber)) > 0)
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  3991
     && ((mySelf = __intVal(self)) >= 0)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3992
        div = mySelf / val;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3993
        mod = mySelf % val;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3994
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  3995
        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
  3996
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  3997
#endif
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3998
%}.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  3999
    ^ super divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4000
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4001
    "
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4002
     10 // 3           -> 3
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4003
     10 \\ 3           -> 1
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4004
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4005
     10 // -3          -> -4
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4006
     10 \\ -3          -> -2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4007
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4008
     -10 // 3          -> -4
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4009
     -10 \\ 3          -> 2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4010
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4011
     -10 // -3         -> 3
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4012
     -10 \\ -3         -> -1
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4013
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4014
     -78 \\ 10         2
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4015
     -78 // 10         -8
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4016
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4017
     10 divMod:3       -> #(3 1)   because 3*3 + 1 = 10
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4018
     10 divMod:-3      -> #(-4 -2) because -4*-3 + (-2) = 10
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4019
     -10 divMod:3      -> #(-4 2)  because -4*3 + 2 = -10
17033
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4020
     -10 divMod:-3     -> #(3 -1)  because -3*3 + (-1) = -10
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4021
9190f2b40619 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16885
diff changeset
  4022
     1000000000000000000000 divMod:3   -> #(333333333333333333333 1)
17036
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4023
     1000000000000000000000 divMod:-3  -> #(-333333333333333333334 -2)
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4024
     -1000000000000000000000 divMod:3  -> #(-333333333333333333334 2)
ef45fc0336fc class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17034
diff changeset
  4025
     -1000000000000000000000 divMod:-3 -> #(333333333333333333333 -1)
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4026
     100 factorial divMod:103
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4027
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4028
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  4029
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4030
gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4031
    "return the greatest common divisor (Euclid's algorithm).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4032
     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
  4033
     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
  4034
     some code. (thanx to MessageTally)"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4035
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4036
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4037
#ifndef __SCHTEAM__
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4038
    if (__isSmallInteger(anInteger)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4039
        INT orgArg, ttt, selfInt, orgSelfInt, temp;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4040
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4041
        ttt = orgArg = __intVal(anInteger);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4042
        if (ttt) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4043
            selfInt = orgSelfInt = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4044
            while (ttt != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4045
                temp = selfInt % ttt;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4046
                selfInt = ttt;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4047
                ttt = temp;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4048
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4049
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4050
             * since its not defined in C, what the sign of
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4051
             * a modulus result is when the arg is negative,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4052
             * change it explicitely here ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4053
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4054
            if (orgArg < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4055
                /* result should be negative */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4056
                if (orgSelfInt > 0) selfInt = -selfInt;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4057
            } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4058
                /* result should be positive */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4059
                if (orgSelfInt < 0) selfInt = -selfInt;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4060
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4061
            RETURN ( __mkSmallInteger(selfInt) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4062
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4063
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4064
#endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4065
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4066
    ^ super gcd:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4067
!
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4068
2430
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4069
gcd_helper:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4070
    "same as gcd - see knuth & Integer>>gcd:"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4071
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4072
    ^ self gcd:anInteger
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4073
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4074
    "Created: 1.3.1997 / 16:58:01 / cg"
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4075
!
cbbf16de1bd7 better gcd for large numbers.
Claus Gittinger <cg@exept.de>
parents: 2254
diff changeset
  4076
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4077
intlog10
14492
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4078
    "return the truncation of log10 of the receiver.
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4079
     The same as (self log:10) floor.
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4080
     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
  4081
     to print a number/and for conversion to a LargeInteger.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7267
diff changeset
  4082
     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
  4083
     (i.e. without log)."
2
claus
parents: 1
diff changeset
  4084
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  4085
    self > 0 ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4086
        self < 10000 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4087
            self < 10 ifTrue:[^ 0].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4088
            self < 100 ifTrue:[^ 1].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4089
            self < 1000 ifTrue:[^ 2].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4090
            ^ 3
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4091
        ].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4092
        self < 100000000 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4093
            self < 100000 ifTrue:[^ 4].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4094
            self < 1000000 ifTrue:[^ 5].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4095
            self < 10000000 ifTrue:[^ 6].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4096
            ^ 7
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4097
        ].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4098
        self < 1000000000 ifTrue:[^ 8].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4099
        SmallInteger maxBytes == 4 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4100
            "/ on a 32 bit machine, SmallInt cannot be larger
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4101
            ^ 9
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4102
        ].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4103
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4104
        "/ 64 bit machine
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4105
        self < 100000000000000 ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4106
            self < 10000000000 ifTrue:[^ 9].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4107
            self < 100000000000 ifTrue:[^ 10].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4108
            self < 1000000000000 ifTrue:[^ 11].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4109
            self < 10000000000000 ifTrue:[^ 12].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4110
            ^ 13
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4111
        ].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4112
        self < 1000000000000000 ifTrue:[^ 14].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4113
        self < 10000000000000000 ifTrue:[^ 15].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4114
        self < 100000000000000000 ifTrue:[^ 16].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4115
        self < 1000000000000000000 ifTrue:[^ 17].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4116
        ^ 18.
14492
a1b5c788c219 changed:
Claus Gittinger <cg@exept.de>
parents: 14167
diff changeset
  4117
    ].
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4118
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  4119
    ^ self class
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4120
        raise:#domainErrorSignal
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4121
        receiver:self
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4122
        selector:#intlog10
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4123
        arguments:#()
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4124
        errorString:'logarithm of negative integer'
15600
da24d2390c03 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15568
diff changeset
  4125
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4126
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4127
      99 intlog10
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4128
      100 intlog10
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4129
      101 intlog10
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4130
      (101 log:10) floor
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4131
      120 intlog10
6344
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  4132
      -1 intlog10
f49b43e5b724 Raise more specific errors
Stefan Vogel <sv@exept.de>
parents: 6144
diff changeset
  4133
    "
2
claus
parents: 1
diff changeset
  4134
! !
claus
parents: 1
diff changeset
  4135
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4136
!SmallInteger methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4137
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4138
asBCD
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4139
    "return an integer which represents the BCD encoded value of the receiver;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4140
     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
  4141
     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
  4142
     This conversion is useful for some communication protocols,
16041
989a985b6f61 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16039
diff changeset
  4143
     or control systems, which represent numbers this way..."
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4144
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4145
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4146
#ifndef __SCHTEAM__
18410
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4147
    // the following code is a leftover from times when division was expensive;
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4148
    // in modern cpu's, conditional branches are often more expensive than divisions,
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4149
    // so it is questionable, if the effort below is still worth it.
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4150
    // (and asBCD is really used seldom in some serial communication protocols
6806b6ba1316 changed digitAt
Claus Gittinger <cg@exept.de>
parents: 18401
diff changeset
  4151
    // for control systems)
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4152
    int i;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4153
    INT _10000000s = 0, _1000000s = 0;
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4154
    INT _100000s = 0, _10000s = 0, _1000s = 0;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4155
    INT _100s = 0, _10s = 0, _1s = 0;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4156
    INT b = __intVal(self);
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4157
    unsigned INT rslt;
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4158
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4159
    if (b <= 99999999) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4160
        if (b <= 255) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4161
            // the most common case: convert bytes
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4162
            for (i=7; i>=0; i--) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4163
                if (_100s >= 5)       _100s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4164
                if (_10s >= 5)        _10s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4165
                if (_1s >= 5)         _1s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4166
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4167
                _100s    =    (_100s<<1)       | (_10s >> 3 & 1);       _100s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4168
                _10s     =    (_10s<<1)        | (_1s >> 3 & 1);        _10s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4169
                _1s      =    (_1s<<1)         | (b >> 7 & 1);          _1s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4170
                b <<= 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4171
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4172
            rslt = (_100s<<8) | (_10s<<4) | _1s;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4173
            RETURN (__MKSMALLINT( rslt) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4174
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4175
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4176
        for (i=26; i>=0; i--) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4177
            if (_10000000s >= 5)  _10000000s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4178
            if (_1000000s >= 5)   _1000000s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4179
            if (_100000s >= 5)    _100000s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4180
            if (_10000s >= 5)     _10000s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4181
            if (_1000s >= 5)      _1000s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4182
            if (_100s >= 5)       _100s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4183
            if (_10s >= 5)        _10s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4184
            if (_1s >= 5)         _1s += 3;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4185
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4186
            _10000000s =  (_10000000s<<1)  | (_1000000s >> 3 & 1);  _10000000s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4187
            _1000000s =   (_1000000s<<1)   | (_100000s >> 3 & 1);   _1000000s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4188
            _100000s =    (_100000s<<1)    | (_10000s >> 3 & 1);    _100000s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4189
            _10000s  =    (_10000s<<1)     | (_1000s >> 3 & 1);     _10000s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4190
            _1000s   =    (_1000s<<1)      | (_100s >> 3 & 1);      _1000s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4191
            _100s    =    (_100s<<1)       | (_10s >> 3 & 1);       _100s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4192
            _10s     =    (_10s<<1)        | (_1s >> 3 & 1);        _10s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4193
            _1s      =    (_1s<<1)         | (b >> 26 & 1);         _1s &= 0xF;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4194
            b <<= 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4195
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4196
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4197
        rslt = (_10000000s<<28)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4198
               | (_1000000s<<24) | (_100000s<<20) | (_10000s<<16)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4199
               | (_1000s<<12) | (_100s<<8) | (_10s<<4) | _1s;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4200
        RETURN (__MKUINT( rslt) );
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4201
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4202
#endif
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4203
%}.
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4204
    ^ super asBCD.
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4205
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4206
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4207
      99999999 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4208
      12812345 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4209
      128123 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4210
      128901 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4211
      12890 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4212
      1289 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4213
      999 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4214
      256 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4215
      255 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4216
      128 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4217
      162 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4218
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4219
      999999999 asBCD hexPrintString
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4220
      128123456 asBCD hexPrintString
16039
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4221
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4222
    "
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4223
!
483922f17924 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15910
diff changeset
  4224
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4225
printOn:aStream
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  4226
    "append my printstring (base 10) to aStream."
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4227
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4228
    aStream nextPutAll:(self printString)
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4229
!
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4230
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4231
printOn:aStream base:base showRadix:showRadix
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  4232
    "append a string representation of the receiver in the specified numberBase to aStream
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  4233
     (if showRadix is true, with initial XXr)
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4234
     The base argument should be between 2 and 36."
6144
35b772717356 check for bad radix
james
parents: 6092
diff changeset
  4235
20141
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4236
    |absBase|
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4237
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4238
    (base isInteger and:[absBase := base abs. absBase between:2 and:36]) ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4239
        showRadix ifTrue:[
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4240
            absBase printOn:aStream.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4241
            aStream nextPut:$r.
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4242
        ].
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4243
        aStream nextPutAll:(self printStringRadix:base)
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4244
    ] ifFalse:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4245
        super printOn:aStream base:base showRadix:true.
11792
6782c723834a changed #printOn:based:showRadix:
Stefan Vogel <sv@exept.de>
parents: 11728
diff changeset
  4246
    ].
5988
Claus Gittinger <cg@exept.de>
parents: 5954
diff changeset
  4247
12977
fbf5437b15fb changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12876
diff changeset
  4248
    "Created: / 07-09-2001 / 13:54:40 / cg"
fbf5437b15fb changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12876
diff changeset
  4249
    "Modified: / 02-08-2010 / 12:25:20 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4250
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4251
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4252
printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4253
    "return my printstring (base 10)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4254
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4255
    "since this was heavily used in some applications,
68
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  4256
     here is an exception to the rule of basing printString
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  4257
     upon the printOn: method."
59faa75185ba *** empty log message ***
claus
parents: 62
diff changeset
  4258
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4259
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4260
#ifdef __SCHTEAM__
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4261
    return context._RETURN( new STString( java.lang.Long.toString(self.longValue()) ));
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4262
#else
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  4263
    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
  4264
    char *cp;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4265
    OBJ newString = nil;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4266
    INT myValue;
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4267
    int negative = 0;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4268
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4269
    if (self == __MKSMALLINT(0)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4270
        RETURN (@global(ZeroString));
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4271
//        RETURN (__MKSTRING_L("0", 1));
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4272
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4273
    myValue = __intVal(self);
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4274
    if (myValue < 0) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4275
        negative = 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4276
        myValue = -myValue;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4277
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4278
    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
  4279
    *cp-- = '\0';
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  4280
    for ( ; myValue != 0; cp--) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4281
        *cp = '0' + (myValue % 10);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4282
        myValue /= 10;
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4283
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4284
    if (negative) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4285
        *cp-- = '-';
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4286
    }
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4287
    newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4288
    if (newString != nil) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4289
        RETURN (newString);
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4290
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4291
#endif /* not __SCHTEAM__ */
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4292
%}.
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4293
    "/ only arrive here,
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4294
    "/  when having memory problems (i.e. no space for string) ...
282
94f5c3a6230d *** empty log message ***
claus
parents: 252
diff changeset
  4295
    ^ super printString
3704
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4296
4dd3cb7ae956 SmallInteger>>printString now twice as fast (for andi and olbi)
Claus Gittinger <cg@exept.de>
parents: 3684
diff changeset
  4297
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4298
     1234 printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4299
     0    printString
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4300
     -100 printString
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4301
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4302
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 123456789012 printString ]] 180 180 180 170 180
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4303
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 12345678 printString ]]     140 150 140 150 140
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4304
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 1234 printString ]]         130 140 130 130 130
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4305
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 12 printString ]]           130 120 120 120 110
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4306
    Time millisecondsToRun:[ 1000000 timesRepeat:[ 5 printString ]]            110 110 100 110 90
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4307
    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
  4308
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4309
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4310
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4311
printStringRadix:base
20141
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4312
    "return my printstring (optimized for bases 16, 10 and 8).
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4313
     Print digits > 0 as uppercase chars if base > 0,
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4314
     as lowercase chars if base < 0."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4315
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4316
    |s|
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4317
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4318
%{
18401
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4319
#ifdef __SCHTEAM__
20141
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4320
    int __base = base.intValue().abs();
18401
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4321
    long myValue = self.longValue();
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4322
    java.lang.String __s;
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4323
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4324
    switch (__base) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4325
        case 2:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4326
            __s = java.lang.Long.toBinaryString(myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4327
            break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4328
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4329
        case 8:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4330
            __s = java.lang.Long.toOctalString(myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4331
            break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4332
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4333
        case 10:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4334
            __s = java.lang.Long.toString(myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4335
            break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4336
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4337
        case 16:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4338
            __s = java.lang.Long.toHexString(myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4339
            break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4340
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4341
        default:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4342
        {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4343
            boolean negative = false;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4344
            __s = "";
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4345
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4346
            if ((__base > 36) || (__base < 2)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4347
                throw new SmalltalkError("invalid base: ", base);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4348
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4349
            if (myValue < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4350
                negative = true;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4351
                myValue = -myValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4352
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4353
            while (myValue != 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4354
                int digit;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4355
                char ch;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4356
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4357
                digit = (int)(myValue % __base);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4358
                if (digit <= 9) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4359
                    ch = (char)('0' + digit);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4360
                } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4361
                    ch = (char)('A' + digit - 10);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4362
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4363
                __s = ch + __s;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4364
                myValue = myValue / __base;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4365
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4366
            if (negative) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4367
                __s = "-" + __s;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4368
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4369
            break;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4370
        }
18401
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4371
    }
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4372
    return context._RETURN( new STString( __s ));
4eee1a43ffb7 comments only
Claus Gittinger <cg@exept.de>
parents: 18395
diff changeset
  4373
#else
20141
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4374
    static char ucDigits[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
063019f72480 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19994
diff changeset
  4375
    static char lcDigits[] = "0123456789abcdefghijklmnopqrstuvwxyz";
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4376
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4377
    if (__isSmallInteger(base)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4378
        char *digits;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4379
        INT __base;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4380
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4381
        if (self == __MKSMALLINT(0)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4382
            RETURN (@global(ZeroString));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4383
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4384
        __base = __intVal(base);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4385
        if (__base < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4386
            __base = - __base;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4387
            digits = lcDigits;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4388
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4389
            digits = ucDigits;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4390
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4391
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4392
        if ((__base < sizeof(ucDigits)) && (__base > 1)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4393
            char buffer[64+5];  /* for 64bit machines, base 2, plus sign, plus 0-byte */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4394
            char *cp;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4395
            OBJ newString;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4396
            int negative = 0;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4397
            INT myValue = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4398
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4399
            if (myValue < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4400
                negative = 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4401
                myValue = -myValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4402
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4403
            cp = buffer + sizeof(buffer) - 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4404
            *cp-- = '\0';
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4405
            for (; myValue != 0; cp--) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4406
                *cp = digits[myValue % __base];
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4407
                myValue /= __base;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4408
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4409
            if (negative) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4410
                *cp-- = '-';
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4411
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4412
            newString = __MKSTRING_L(cp+1, (buffer + sizeof(buffer) - 2 - cp));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4413
            if (newString != nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4414
                RETURN (newString);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4415
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4416
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4417
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4418
#endif /* not __SCHTEAM__ */
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  4419
%}.
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4420
    "/ arrive here, for bad base,
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4421
    "/ or when having memory problems (i.e. no space for string) ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4422
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4423
    "/
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4424
    "/ fall back for seldom used bases
20330
01cc21bb516f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20262
diff changeset
  4425
    "/ Notice: cannot use super>>printStringRadix: here,
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4426
    "/ since that would lead to endless recursion ...
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4427
    "/ (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
  4428
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4429
    s := WriteStream on:(String new:10).
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4430
    super printOn:s base:base.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4431
    ^ s contents.
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4432
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4433
    "
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4434
      127 printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4435
      127 printStringRadix:-16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4436
      -127 printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4437
      -127 printStringRadix:-16
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4438
      123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4439
      123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4440
      123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4441
      123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4442
      123 printStringRadix:2
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4443
      123 printStringRadix:1
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  4444
      35 printStringRadix:36
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  4445
      123 printStringRadix:37
3705
f4e7b2db4d4b new printStringRadix:
Claus Gittinger <cg@exept.de>
parents: 3704
diff changeset
  4446
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4447
      -127 printStringRadix:16
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4448
      -123 printStringRadix:12
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4449
      -123 printStringRadix:10
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4450
      -123 printStringRadix:8
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4451
      -123 printStringRadix:3
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4452
      -123 printStringRadix:2
20330
01cc21bb516f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20262
diff changeset
  4453
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4454
      16r3FFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4455
      16r7FFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4456
      16rFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4457
      16r3FFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4458
      16r7FFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4459
      16rFFFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4460
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4461
      -16r3FFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4462
      -16r40000000 printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4463
      -16r7FFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4464
      -16r80000000 printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4465
      -16rFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4466
      -16r3FFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4467
      -16r7FFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4468
      -16rFFFFFFFFFFFFFFFF printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4469
      -16r4000000000000000 printStringRadix:16
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4470
      -16r8000000000000000 printStringRadix:16
3189
f07145cc8ef7 Have to call "super #printOn:base:" in #printString.
Stefan Vogel <sv@exept.de>
parents: 3156
diff changeset
  4471
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4472
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4473
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4474
printfPrintString:formatString
7746
4a4208ef7699 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7471
diff changeset
  4475
    "non-standard, but sometimes useful.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4476
     return a printed representation of the receiver
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4477
     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
  4478
     No checking for string overrun - the resulting string
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
  4479
     must be shorter than 256 chars or else ...
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  4480
     This method is NONSTANDARD and may be removed without notice;
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4481
     it is provided to allow special conversions in very special situations.
2781
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  4482
     Notice that a conversion may not be portable; for example,
eca37ca06b66 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2770
diff changeset
  4483
     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
  4484
     on 64bit mingw or visualc, %lld is required,
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  4485
     while other systems may be happy with a %d.
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4486
     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
  4487
     Use at your own risk (if at all).
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  4488
     WARNNG: this goes directly to the C-printf function and may therefore be inherently unsafe.
11923
bf02cbdab69f changed #printfPrintString:
Claus Gittinger <cg@exept.de>
parents: 11792
diff changeset
  4489
     Please use the printf: method, which is safe as it is completely implemented in Smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4490
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  4491
%{  /* STACK: 400 */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4492
#ifndef __SCHTEAM__
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4493
    char buffer[256];
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  4494
    OBJ s;
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4495
    int len;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4496
12482
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  4497
    if (__isStringLike(formatString)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4498
        /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4499
         * actually only needed on sparc: since thisContext is
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4500
         * in a global register, which gets destroyed by printf,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4501
         * manually save it here - very stupid ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4502
         */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4503
        __BEGIN_PROTECT_REGISTERS__
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4504
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4505
        len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __intVal(self));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4506
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4507
        __END_PROTECT_REGISTERS__
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4508
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4509
        if (len < 0) goto fail;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4510
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4511
        s = __MKSTRING_L(buffer, len);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4512
        if (s != nil) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4513
            RETURN (s);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4514
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4515
    }
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4516
fail: ;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4517
#endif /* not __SCHTEAM__ */
314
7581a5c57224 *** empty log message ***
claus
parents: 305
diff changeset
  4518
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4519
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4520
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4521
    "
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4522
        123 printfPrintString:'%%d -> %d'
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4523
        123 printfPrintString:'%%6d -> %6d'
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4524
        123 printfPrintString:'%%x -> %x'
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4525
        123 printfPrintString:'%%4x -> %4x'
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4526
        123 printfPrintString:'%%04x -> %04x'
8417
dcba76518224 Security: use snprintf() instead of sprintf() to avoid overwrites.
Stefan Vogel <sv@exept.de>
parents: 8408
diff changeset
  4527
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4528
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  4529
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4530
!SmallInteger methodsFor:'private'!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4531
18382
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4532
setSign:aNumber
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4533
    "private: for protocol completeness with LargeIntegers.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  4534
     Returns a smallInteger with my absValue and the sign of the argument.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  4535
     The method's name may be misleading: the receiver is not changed,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  4536
     but a new number is returned."
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4537
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4538
    |absVal|
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4539
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4540
    absVal := self abs.
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4541
    aNumber < 0 ifTrue:[
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4542
        ^ absVal negated
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4543
    ].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4544
    aNumber == 0 ifTrue:[^ 0].
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4545
    ^ absVal
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4546
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4547
    "
8908
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4548
     -4 sign:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4549
     -4 sign:0
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4550
     -4 sign:1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4551
     -4 sign:-1
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4552
     -4 sign:0
68017b13590b 64bit cleanup
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  4553
     -4 sign:1
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4554
    "
18382
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4555
!
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4556
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4557
sign:aNumber
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4558
    <resource: #obsolete>
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4559
    "private: for protocol completeness with LargeIntegers.
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  4560
     Returns a smallInteger with my absValue and the sign of the argument.
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  4561
     The method's name may be misleading: the receiver is not changed,
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  4562
     but a new number is returned."
18382
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4563
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4564
    ^ self setSign:aNumber
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4565
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4566
    "
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4567
     -4 sign:-1
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4568
     -4 sign:0
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4569
     -4 sign:1
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4570
     -4 sign:-1
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4571
     -4 sign:0
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4572
     -4 sign:1
4b0ff5d95702 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 18370
diff changeset
  4573
    "
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4574
! !
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  4575
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4576
!SmallInteger methodsFor:'special modulo arithmetic'!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4577
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4578
plus32:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4579
    "return the sum of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4580
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4581
     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
  4582
     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
  4583
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4584
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4585
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4586
    INT sum;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4587
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4588
    sum =  __unsignedLongIntVal(self) + __unsignedLongIntVal(aNumber);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4589
# if __POINTER_SIZE__ == 8
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4590
    sum &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4591
# endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4592
    RETURN ( __MKUINT(sum));
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4593
#endif /* not __SCHTEAM__ */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4594
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4595
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4596
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4597
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4598
     16r7FFFFFFF + 1          2147483648
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4599
     16r7FFFFFFF plus32: 1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4600
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4601
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4602
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4603
plus:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4604
    "return the sum of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4605
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4606
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4607
     smallInteger range is returned (i.e. the low bits of the sum).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4608
     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
  4609
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4610
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4611
%{  /* NOCONTEXT */
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4612
#ifdef __SCHTEAM__
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4613
    {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4614
        long myValue = self.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4615
        long otherValue = aNumber.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4616
        long sum = myValue + otherValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4617
        return context._RETURN( STInteger._new(sum) );
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4618
    }
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4619
    /* NOT REACHED */
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4620
#else
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4621
    if (__isSmallInteger(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4622
        INT sum;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4623
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4624
        sum =  __intVal(self) + __intVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4625
        if (!__ISVALIDINTEGER(sum)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4626
            /* keep the sign */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4627
            sum %= _MAX_INT;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4628
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4629
        RETURN ( __mkSmallInteger(sum));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4630
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4631
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4632
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4633
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4634
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4635
    "
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4636
        5 plus:-1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4637
        5 plus:1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4638
        1 plus:-5
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4639
        self maxVal plus:1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4640
        self maxVal + 1
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4641
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4642
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4643
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4644
subtract:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4645
    "return the difference of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4646
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4647
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4648
     smallInteger range is returned (i.e. the low bits of the sum).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4649
     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
  4650
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4651
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4652
%{  /* NOCONTEXT */
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4653
#ifdef __SCHTEAM__
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4654
    {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4655
        long myValue = self.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4656
        long otherValue = aNumber.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4657
        long diference = myValue - otherValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4658
        return context._RETURN( STInteger._new(diference) );
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4659
    }
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4660
    /* NOT REACHED */
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4661
#else
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4662
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4663
    if (__isSmallInteger(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4664
        INT diff;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4665
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4666
        diff = __intVal(self) - __intVal(aNumber);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4667
        if (!__ISVALIDINTEGER(diff)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4668
            /* keep the sign */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4669
            diff %= _MAX_INT;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4670
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4671
        RETURN ( __mkSmallInteger(diff));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4672
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4673
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4674
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4675
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4676
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4677
    "
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4678
        -1 subtract:5
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4679
        5 subtract:1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4680
        1 subtract:-5
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4681
        self minVal subtract:1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4682
        self minVal - 1
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4683
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4684
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4685
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4686
times:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4687
    "return the product of the receiver and the argument, as SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4688
     The argument must be another SmallInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4689
     If the result overflows the smallInteger range, the value modulo the
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4690
     smallInteger range is returned (i.e. the low bits of the product).
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4691
     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
  4692
     and can therefore speed things up by not going through LargeIntegers."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4693
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4694
%{  /* NOCONTEXT */
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4695
#ifdef __SCHTEAM__
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4696
    {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4697
        long myValue = self.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4698
        long otherValue = aNumber.longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4699
        long product = myValue * otherValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4700
        return context._RETURN( STInteger._new(product) );
18255
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4701
    }
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4702
    /* NOT REACHED */
aedbc27ea6c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  4703
#else
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4704
    INT myValue, otherValue;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4705
    unsigned INT productLow, productHi;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4706
    int negative;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4707
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4708
#   define low16Bits(foo)  ((foo) & 0xFFFF)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4709
#   define hi16Bits(foo)   ((foo) >> 16)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4710
#   define low32Bits(foo)  ((foo) & 0xFFFFFFFFL)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4711
#   define hi32Bits(foo)   ((foo) >> 32)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4712
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4713
    /*
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4714
     * can we use long long arithmetic ?
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4715
     *
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4716
     * long-long arithmetic seems to be buggy with some systems
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4717
     * (took me a while to find this out :-(
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4718
     * (try 10000 * 10000)
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4719
     */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4720
# if defined(__sparc__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4721
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4722
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4723
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4724
# if defined(__i386__) && defined(__GNUC__) && (__GNUC__ >= 2)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4725
#  define USE_LONGLONG_FOR_MUL
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4726
# endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4727
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4728
    if (__isSmallInteger(aNumber)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4729
        myValue = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4730
        otherValue = __intVal(aNumber);
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4731
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4732
# if defined(USE_LONGLONG_FOR_MUL)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4733
        {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4734
#  if defined(__alpha__) && !defined(__alpha64__)
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4735
#   define LONGLONG      INT64
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4736
#  else
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4737
#   define LONGLONG      long long
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4738
#  endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4739
            LONGLONG product;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4740
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4741
            product = (LONGLONG)myValue * (LONGLONG)otherValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4742
            if (product < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4743
                RETURN ( __mkSmallInteger(-(INT)(-product & _MAX_INT)));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4744
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4745
            RETURN ( __mkSmallInteger((INT)(product & _MAX_INT)));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4746
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4747
# else /* no long-long */
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4748
        negative = 1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4749
        if (myValue < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4750
            negative = -1;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4751
            myValue = -myValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4752
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4753
        if (otherValue < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4754
            negative = -negative;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4755
            otherValue = -otherValue;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4756
        }
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4757
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4758
#  if defined(__GNUC__) && defined(__mc68k__)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4759
        asm ("mulu%.l %3,%1:%0"
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4760
                : "=d"  ((unsigned long)(productLow)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4761
                  "=d"  ((unsigned long)(productHi))
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4762
                : "%0"  ((unsigned long)(myValue)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4763
                  "dmi" ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4764
#  else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  4765
#   if defined (__GNUC__) && defined(__x86__)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4766
        asm ("mull %3"
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4767
                : "=a"  ((unsigned long)(productLow)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4768
                  "=d"  ((unsigned long)(productHi))
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4769
                : "%0"  ((unsigned long)(myValue)),
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4770
                  "rm"  ((unsigned long)(otherValue)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4771
#   else
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  4772
#    if defined(__win32__) && defined(__BORLANDC__)
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4773
        asm {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4774
            mov   eax, myValue
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4775
            mov   edx, otherValue
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4776
            mul   edx
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4777
            mov   productLow, eax
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4778
            mov   productHi, edx
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4779
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4780
#    else /* generic */
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4781
        {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4782
            unsigned INT pHH, pHL, pLH, pLL;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4783
            unsigned INT low1, low2, hi1, hi2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4784
            unsigned INT t;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4785
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4786
            /* unsigned multiply myValue * otherValue -> productHi, productLow
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4787
             *
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4788
             * this is too slow:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4789
             * since most machines can do 32*32 to 64 bit multiply,
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4790
             * (or at least 32*32 with Overflow check)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4791
             * - need more assembler (inline) functions here
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4792
             */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4793
#     if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4794
            low1 = low32Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4795
            hi1 = hi32Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4796
            low2 = low32Bits((unsigned INT)otherValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4797
            hi2 = hi32Bits((unsigned INT)otherValue);
20333
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4798
#      undef LLMASK
8b2b36463804 #QUALITY by cg
Claus Gittinger <cg@exept.de>
parents: 20330
diff changeset
  4799
#      define LLMASK 0xC000000000000000LL
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4800
#     else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4801
            low1 = low16Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4802
            hi1 = hi16Bits((unsigned INT)myValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4803
            low2 = low16Bits((unsigned INT)otherValue);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4804
            hi2 = hi16Bits((unsigned INT)otherValue);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4805
#      define LLMASK 0xC0000000
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4806
#     endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4807
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4808
            pLH = low1 * hi2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4809
            pHL = hi1 * low2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4810
            pLL = low1 * low2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4811
            pHH = hi1 * hi2;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4812
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4813
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4814
             * the common case ...
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4815
             */
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4816
            if ((pHL == 0)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4817
             && (pLH == 0)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4818
             && (pHH == 0)
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4819
             && ((pLL & LLMASK) == 0)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4820
                if (negative < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4821
                    RETURN ( __mkSmallInteger(- ((INT)pLL)) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4822
                }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4823
                RETURN ( __mkSmallInteger((INT)pLL) );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4824
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4825
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4826
            /*
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4827
             *   pHH |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4828
             *   pLH          |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4829
             *   pHL          |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4830
             *   pLL                   |--------|--------|
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4831
             */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4832
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4833
#     if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4834
            t = low32Bits(pLH) + low32Bits(pHL) + hi32Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4835
            productLow = (t << 32) + low32Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4836
            productHi = pHH + hi32Bits(t) + hi32Bits(pHL) + hi32Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4837
#     else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4838
            t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4839
            productLow = (t << 16) + low16Bits(pLL);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4840
            productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4841
#     endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4842
        }
19860
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  4843
#    endif /* ! __win32__ */
324edacff5cc unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents: 19601
diff changeset
  4844
#   endif /* ! (__GNUC__ && __x86__) */
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4845
#  endif /* ! (__GNUC__ && __mc68k__) */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4846
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4847
        if (negative < 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4848
            RETURN ( __mkSmallInteger(-(INT)(productLow & _MAX_INT)));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4849
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4850
        RETURN ( __mkSmallInteger((INT)(productLow & _MAX_INT)));
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4851
# endif /* ! USE_LONGLONG */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4852
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4853
#endif /* not __SCHTEAM__ */
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4854
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4855
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4856
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4857
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4858
    "
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4859
        5 times:-1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4860
        5 times:1
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4861
        self maxVal-1 times:2
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4862
        self maxVal-1 times:-2
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4863
        self maxVal-1 * 2  bitAnd:16r3fffffff
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4864
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4865
! !
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4866
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4867
!SmallInteger methodsFor:'special modulo bit operators'!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4868
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4869
bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4870
    "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
  4871
     (changes the sign)"
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4872
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4873
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4874
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4875
    unsigned INT v;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4876
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4877
    v = __intVal(self);
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4878
    v = ~v;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4879
# if __POINTER_SIZE__ == 8
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4880
    v &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4881
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4882
    RETURN ( __MKUINT(v) );
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4883
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4884
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4885
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4886
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4887
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4888
     1 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4889
     16r40000000 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4890
     16r80000000 bitInvert32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4891
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4892
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4893
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4894
bitRotate32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4895
    "return the value of the receiver rotated by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4896
     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
  4897
     Rotates through the sign bit.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4898
     Useful for crypt algorithms, or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4899
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4900
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4901
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4902
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4903
    unsigned INT bits;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4904
    int count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4905
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4906
    if (__isSmallInteger(shiftCount)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4907
        count = __intVal(shiftCount);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4908
        count = count % 32;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4909
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4910
        bits = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4911
        if (count > 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4912
            bits = (bits << count) | (bits >> (32-count));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4913
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4914
            bits = (bits >> (-count)) | (bits << (32-(-count)));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4915
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4916
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4917
        bits &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4918
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4919
        RETURN (__MKUINT(bits));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4920
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4921
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4922
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4923
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4924
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4925
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4926
     128 rotate32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4927
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4928
     1 rotate32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4929
     1 rotate32:2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4930
     1 rotate32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4931
     1 rotate32:32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4932
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4933
     1 rotate32:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4934
     1 rotate32:-2
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4935
     1 rotate32:-3
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4936
     1 rotate32:-32
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4937
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4938
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4939
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4940
bitShift32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4941
    "return the value of the receiver shifted by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4942
     but only within 32 bits, shifting into/out-of the sign bit.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4943
     May be useful for communication interfaces, to create ST-numbers
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4944
     from a signed 32bit int value given as individual bytes,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4945
     or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4946
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4947
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4948
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4949
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4950
    INT bits, count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4951
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4952
    if (__isSmallInteger(shiftCount)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4953
        count = __intVal(shiftCount);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4954
        if (count >= 32) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4955
            RETURN (__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4956
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4957
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4958
        bits = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4959
        if (count > 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4960
            bits = bits << count;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4961
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4962
            bits = bits >> (-count);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4963
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4964
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4965
        bits &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4966
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  4967
        RETURN (__MKINT(bits));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4968
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4969
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4970
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4971
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4972
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4973
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4974
     128 bitShift:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4975
     128 bitShift32:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4976
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4977
     1 bitShift:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4978
     1 bitShift32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4979
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4980
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4981
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4982
bitXor32:aNumber
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4983
    "return the xor of the receiver and the argument.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4984
     The argument must be another SmallInteger or a 4-byte LargeInteger.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4985
     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
  4986
     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
  4987
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4988
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  4989
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4990
    INT rslt;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4991
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4992
    rslt =  __unsignedLongIntVal(self) ^ __unsignedLongIntVal(aNumber);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4993
# if __POINTER_SIZE__ == 8
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4994
    rslt &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4995
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  4996
    RETURN ( __MKUINT(rslt));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4997
#endif
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4998
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  4999
    self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5000
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5001
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5002
     16r7FFFFFFF bitXor: 16r80000000          4294967295
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5003
     16r7FFFFFFF bitXor32: 16r80000000
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5004
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5005
!
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5006
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5007
unsignedBitShift32:shiftCount
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5008
    "return the value of the receiver shifted by shiftCount bits,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5009
     but only within 32 unsigned bits.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5010
     May be useful for communication interfaces, to create ST-numbers
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5011
     from an unsigned 32bit int value given as individual byte,
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5012
     or to emulate C/Java semantics."
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5013
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5014
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5015
#ifndef __SCHTEAM__
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5016
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5017
    unsigned INT bits;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5018
    INT count;
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5019
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5020
    if (__isSmallInteger(shiftCount)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5021
        count = __intVal(shiftCount);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5022
        if (count >= 32) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5023
            RETURN (__mkSmallInteger(0));
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5024
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5025
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5026
        bits = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5027
        if (count > 0) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5028
            bits = bits << count;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5029
        } else {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5030
            bits = bits >> (-count);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5031
        }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5032
# if __POINTER_SIZE__ == 8
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5033
        bits &= 0xFFFFFFFFL;
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5034
# endif
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5035
        RETURN (__MKUINT(bits));
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5036
    }
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5037
#endif
16294
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5038
%}.
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5039
    ^ self primitiveFailed
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5040
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5041
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5042
     128 unsignedBitShift:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5043
     128 unsignedBitShift32:24
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5044
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5045
     1 unsignedBitShift:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5046
     1 unsignedBitShift32:31
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5047
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5048
     -1 unsignedBitShift32:-1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5049
     -1 unsignedBitShift32:1
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5050
    "
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5051
! !
a08b0365a4f1 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 16041
diff changeset
  5052
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5053
!SmallInteger methodsFor:'testing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5054
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5055
between:min and:max
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5056
    "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
  5057
     and less than or equal to the argument max.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5058
     - reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5059
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5060
%{  /* NOCONTEXT */
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5061
#ifdef __SCHTEAM__
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5062
    if (STObject.bothSmallInteger(min, max)) {
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5063
        long myVal = ((STInteger)self).longValue();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5064
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5065
        if (myVal >= ((STInteger)min).longValue()) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5066
            if (myVal <= ((STInteger)max).longValue()) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5067
                return __c__._RETURN_true();
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5068
            }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5069
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5070
        return __c__._RETURN_false();
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5071
    }
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5072
#else /* not SCHTEAM */
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5073
    if (__bothSmallInteger(min, max)) {
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5074
# if TAG_INT == 1
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5075
        // tag bit does not change the magnitude order
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5076
        if ((INT)self < (INT)(min)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5077
             RETURN ( false );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5078
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5079
        if ((INT)self > (INT)(max)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5080
             RETURN ( false );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5081
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5082
        RETURN ( true );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5083
# else
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5084
        REGISTER INT selfVal;
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5085
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5086
        selfVal = __intVal(self);
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5087
        if (selfVal < __intVal(min)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5088
             RETURN ( false );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5089
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5090
        if (selfVal > __intVal(max)) {
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5091
             RETURN ( false );
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5092
        }
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5093
        RETURN ( true );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5094
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5095
    }
18289
Claus Gittinger <cg@exept.de>
parents: 18255
diff changeset
  5096
#endif /* not SCHTEAM */
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5097
%}.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5098
    (self < min) ifTrue:[^ false].
18395
b9ba2c56b13b comment
Claus Gittinger <cg@exept.de>
parents: 18382
diff changeset
  5099
    (max < self) ifTrue:[^ false].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5100
    ^ true
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5101
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5102
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5103
even
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5104
    "return true, if the receiver is even"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5105
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5106
%{  /* NOCONTEXT */
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5107
#ifdef __SCHTEAM__
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5108
    return __c__._RETURN( self.isEven() ? STObject.True : STObject.False );
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5109
    /* NOTREACHED */
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5110
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5111
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true );
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5112
#endif /* not SCHTEAM */
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5113
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5114
    ^ super even
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5115
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5116
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5117
isPowerOfTwo
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5118
    "return true, if the receiver is a power of 2"
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5119
19057
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5120
    "/ 0 is not a power of two, because ld(0) is -INF
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5121
    ^ ((self bitAnd:(self - 1)) == 0) and:[self ~~ 0]
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5122
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5123
    "
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5124
     0 isPowerOfTwo
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5125
     1 isPowerOfTwo
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5126
     2 isPowerOfTwo
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  5127
     3 isPowerOfTwo
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  5128
     4 isPowerOfTwo
19057
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5129
     5 isPowerOfTwo
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  5130
     16r8000000000000000 isPowerOfTwo
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  5131
     16r8000000000000001 isPowerOfTwo
19057
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5132
     16r40000000 isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5133
     16r80000000 isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 19051
diff changeset
  5134
     16r100000000 isPowerOfTwo
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5135
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5136
     10000 factorial isPowerOfTwo
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14540
diff changeset
  5137
     |n| n := 10000 factorial. Time millisecondsToRun:[1000 timesRepeat:[ n isPowerOfTwo]]
13386
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5138
    "
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5139
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5140
    "Modified: / 20-06-2011 / 12:41:18 / cg"
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5141
!
6986799e2da1 moved: #isPowerOfTwo
Claus Gittinger <cg@exept.de>
parents: 13006
diff changeset
  5142
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5143
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5144
    "return true, if the receiver is less than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5145
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5146
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5147
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5148
#ifdef __SCHTEAM__
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5149
    return context._RETURN( self.isLt_0() ? STObject.True : STObject.False);
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  5150
    /* NOTREACHED */
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  5151
#else
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5152
# if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5153
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5154
    RETURN ( ((INT)(self) < 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5155
# else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5156
    RETURN ( (__intVal(self) < 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5157
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5158
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5159
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5160
    ^ self < 0
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5161
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5162
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5163
nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5164
    "return the power of 2 at or above the receiver.
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5165
     Useful for padding.
19060
2fe260c4796a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19057
diff changeset
  5166
     Notice, that for a powerOf2, the receiver is returned.
19263
6b090dfa8c32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 19133
diff changeset
  5167
     Also notice, that (because it is used for padding),
19060
2fe260c4796a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19057
diff changeset
  5168
     0 is returned for zero."
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5169
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5170
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5171
#ifndef __SCHTEAM__
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5172
    INT x;
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5173
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5174
    x = __intVal(self) - 1;
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5175
    x |= (x >> 1);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5176
    x |= (x >> 2);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5177
    x |= (x >> 4);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5178
    x |= (x >> 8);
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5179
    x |= (x >> 16);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5180
# if __POINTER_SIZE__ == 8
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5181
    x |= (x >> 32);
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5182
# endif
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5183
    RETURN (__MKINT(x + 1));
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5184
#endif
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5185
%}.
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5186
    ^ super nextPowerOf2
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5187
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5188
    "
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5189
     0 nextPowerOf2
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5190
     1 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5191
     2 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5192
     3 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5193
     4 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5194
     5 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5195
     6 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5196
     7 nextPowerOf2
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5197
     8 nextPowerOf2
19060
2fe260c4796a #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19057
diff changeset
  5198
     9 nextPowerOf2
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5199
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5200
     22 nextPowerOf2
21107
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5201
     32 nextPowerOf2
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5202
     16rFFFF nextPowerOf2 = 16r10000 
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5203
     16rFFFFFFFF nextPowerOf2 = 16r100000000 
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5204
     16r1FFFFFFFFFFFFFFF nextPowerOf2 = 16r2000000000000000 
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5205
     16r3FFFFFFFFFFFFFFF nextPowerOf2 = 16r4000000000000000 
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5206
     16r7FFFFFFFFFFFFFFF nextPowerOf2 = 16r8000000000000000 
079804a17e43 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20819
diff changeset
  5207
     16rFFFFFFFFFFFFFFFF nextPowerOf2 = 16r10000000000000000 
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5208
     10 factorial nextPowerOf2
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5209
     20 factorial nextPowerOf2
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5210
     100 factorial nextPowerOf2
14693
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5211
    "
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5212
!
d65d6d900457 added nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 14632
diff changeset
  5213
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5214
odd
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5215
    "return true, if the receiver is odd"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5216
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5217
%{  /* NOCONTEXT */
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5218
#ifdef __SCHTEAM__
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5219
    return __c__._RETURN( self.isEven() ? STObject.False : STObject.True );
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5220
    /* NOTREACHED */
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5221
#else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5222
    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5223
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5224
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5225
    ^ super odd
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5226
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5227
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5228
parityOdd
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5229
    "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
  5230
     (i.e. true for odd parity)
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5231
     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
  5232
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5233
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5234
#ifndef __SCHTEAM__
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5235
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5236
    // tricky, but very fast (google for it, to understand)
18897
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5237
    unsigned INT v = __intVal(self);
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5238
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5239
# if __POINTER_SIZE__ == 8
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5240
    v ^= v >> 32;
562b990d5773 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18864
diff changeset
  5241
# endif
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5242
    v ^= v >> 16;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5243
    v ^= v >> 8;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5244
    v ^= v >> 4;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5245
    v &= 0xf;
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5246
    RETURN ( ( (0x6996 >> v) & 1 ) ? true : false );
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5247
#endif
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5248
%}.
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5249
    ^ super parityOdd
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5250
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5251
    "
20339
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5252
        self assert:
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5253
         (((0 to:255) collect:[:i | i parityOdd ifTrue:1 ifFalse:0])
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5254
            asByteArray collect:[:c | c + $0 asciiValue]) asString
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5255
         =
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5256
            '0110100110010110100101100110100110010110011010010110100110010110100101100110100101101001100101100110100110010110100101100110100110010110011010010110100110010110011010011001011010010110011010010110100110010110100101100110100110010110011010010110100110010110'
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5257
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5258
        self assert:(16r0FFFFFFF parityOdd = 16r0FFFFFFF bitCount odd).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5259
        self assert:(16r1FFFFFFF parityOdd = 16r1FFFFFFF bitCount odd).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5260
        self assert:(16r3FFFFFFF parityOdd = 16r3FFFFFFF bitCount odd).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5261
        self assert:(16r7FFFFFFF parityOdd = 16r7FFFFFFF bitCount odd).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5262
        self assert:(16rFFFFFFFF parityOdd = 16rFFFFFFFF bitCount odd).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5263
        self assert:(16r3FFFFFFFFFFFFFFF parityOdd = 16r3FFFFFFFFFFFFFFF bitCount odd).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5264
        self assert:(16r7FFFFFFFFFFFFFFF parityOdd = 16r7FFFFFFFFFFFFFFF bitCount odd).
5d56805b999a #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20333
diff changeset
  5265
        self assert:(16rFFFFFFFFFFFFFFFF parityOdd = 16rFFFFFFFFFFFFFFFF bitCount odd).
13913
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5266
    "
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5267
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5268
    "Modified (comment): / 09-01-2012 / 19:55:37 / cg"
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5269
!
64aaf4304364 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13912
diff changeset
  5270
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5271
positive
18864
5f4e0d1f6df1 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 18849
diff changeset
  5272
    "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
  5273
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5274
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5275
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5276
#ifdef __SCHTEAM__
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5277
    return context._RETURN( self.isGe_0() ? STObject.True : STObject.False);
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5278
    /* NOTREACHED */
18236
f5b870afebf4 java stuff
Claus Gittinger <cg@exept.de>
parents: 18234
diff changeset
  5279
#else
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5280
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5281
# if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5282
    /* tag bit does not change sign */
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5283
    RETURN ( ((INT)(self) >= 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5284
# else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5285
    RETURN ( (__intVal(self) >= 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5286
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5287
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5288
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5289
    ^ super positive
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5290
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5291
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5292
sign
7471
c5d4bd612d9f comments
Claus Gittinger <cg@exept.de>
parents: 7438
diff changeset
  5293
    "return the sign of the receiver (-1, 0 or 1).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5294
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5295
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5296
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18236
diff changeset
  5297
#ifndef __SCHTEAM__
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5298
# if TAG_INT <= 1 /* tag in low bit */
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5299
    RETURN ( __mkSmallInteger( (((INT)self) > TAG_INT) - (((INT)self) < 0) ) );
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5300
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
  5301
    INT val = __intVal(self);
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5302
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5303
    RETURN ( __mkSmallInteger( (val > 0) - (val < 0) ) );
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5304
# endif
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5305
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5306
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5307
    ^ super sign
18760
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5308
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5309
    "
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5310
     -5 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5311
     -1 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5312
     0 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5313
     1 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5314
     5 sign
9b0b0c157e4c #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18699
diff changeset
  5315
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5316
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5317
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5318
strictlyPositive
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5319
    "return true, if the receiver is greater than zero
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5320
     reimplemented here for speed"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5321
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5322
%{  /* NOCONTEXT */
18904
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5323
#ifdef __SCHTEAM__
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5324
    return context._RETURN( self.isGt_0() ? STObject.True : STObject.False);
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5325
    /* NOTREACHED */
1c2c3d3d381e #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18898
diff changeset
  5326
#else
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5327
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5328
# if TAG_INT == 1
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5329
    /* tag bit does not change sign */
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5330
    RETURN ( ((INT)(self) > (INT)(__mkSmallInteger(0))) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5331
# else
2216
e4fed6c622de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2187
diff changeset
  5332
    RETURN ( (__intVal(self) > 0) ? true : false );
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5333
# endif
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5334
#endif
5412
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5335
%}.
323c7d7ae289 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5410
diff changeset
  5336
    ^ super strictlyPositive
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5337
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5338
    "
18227
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5339
     0 strictlyPositive
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5340
     1 strictlyPositive
709752f92664 java support
Claus Gittinger <cg@exept.de>
parents: 17689
diff changeset
  5341
     -1 strictlyPositive
17689
bf06c9fb45d2 class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 17247
diff changeset
  5342
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5343
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5344
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1716
diff changeset
  5345
!SmallInteger class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5346
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5347
version
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  5348
    ^ '$Header$'
12482
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  5349
!
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  5350
41f0acde1b79 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 11923
diff changeset
  5351
version_CVS
18592
43c80b6eb3f9 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 18410
diff changeset
  5352
    ^ '$Header$'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
  5353
! !
14755
821ba902d413 class: SmallInteger
Stefan Vogel <sv@exept.de>
parents: 14693
diff changeset
  5354
15259
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  5355
24161cb445cf class: SmallInteger
Claus Gittinger <cg@exept.de>
parents: 15131
diff changeset
  5356
SmallInteger initialize!