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