Integer.st
author Claus Gittinger <cg@exept.de>
Fri, 13 Dec 2019 00:10:13 +0100
changeset 25103 4242a828ffea
parent 25039 803a48c7a8c5
child 25145 888d6ef294c3
permissions -rw-r--r--
#BUGFIX by exept class: UserPreferences class changed: #saveSettings:in: FIX: language was not stored correctly
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
25031
c29683170748 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 25010
diff changeset
     1
"{ Encoding: utf8 }"
c29683170748 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 25010
diff changeset
     2
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     3
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     4
 COPYRIGHT (c) 1988 by Claus Gittinger
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
     5
              All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
"
5435
ad6612cc6848 oops odd/even fallback was wrong
Claus Gittinger <cg@exept.de>
parents: 5238
diff changeset
    14
"{ Package: 'stx:libbasic' }"
ad6612cc6848 oops odd/even fallback was wrong
Claus Gittinger <cg@exept.de>
parents: 5238
diff changeset
    15
17488
9da696f7560f class: Integer
Claus Gittinger <cg@exept.de>
parents: 17248
diff changeset
    16
"{ NameSpace: Smalltalk }"
9da696f7560f class: Integer
Claus Gittinger <cg@exept.de>
parents: 17248
diff changeset
    17
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
Number subclass:#Integer
19327
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    19
	instanceVariableNames:''
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    20
	classVariableNames:'BCDConversionErrorSignal PrimeCache'
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    21
	poolDictionaries:''
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    22
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    23
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    24
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    25
Object subclass:#ModuloNumber
19327
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    26
	instanceVariableNames:'modulus reciprocal shift'
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    27
	classVariableNames:''
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    28
	poolDictionaries:''
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
    29
	privateIn:Integer
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    30
!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    31
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    32
!Integer class methodsFor:'documentation'!
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    33
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
 COPYRIGHT (c) 1988 by Claus Gittinger
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
    37
              All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    38
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    47
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
documentation
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    49
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
    abstract superclass for all integer numbers.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
    See details in concrete subclasses LargeInteger and SmallInteger.
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
    52
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
    53
    Mixed mode arithmetic:
22071
9423b8769ca7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22070
diff changeset
    54
        int <op> int         -> int
9423b8769ca7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22070
diff changeset
    55
        int <op> fraction    -> fraction
9423b8769ca7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22070
diff changeset
    56
        int <op> float       -> float
9423b8769ca7 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22070
diff changeset
    57
        int <op> fix         -> fix; scale is fix's scale
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
    58
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
    59
    [author:]
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
    60
        Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1555
diff changeset
    61
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1555
diff changeset
    62
    [see also:]
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
    63
        Number
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
    64
        LargeInteger SmallInteger
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
    65
        Float ShortFloat Fraction FixedPoint
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    66
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    67
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    69
!Integer class methodsFor:'instance creation'!
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
    70
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    71
byte1:b1 byte2:b2 byte3:b3 byte4:b4
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    72
    "Squeak compatibility:
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    73
     Return an Integer given four value bytes.
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
    74
     The returned integer is either a Small- or a LargeInteger
15241
735c63d4e41f class: Integer
Claus Gittinger <cg@exept.de>
parents: 15084
diff changeset
    75
     (on 32bit systems - on 64bit systems, it will be always a SmallInteger)"
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    76
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    77
    |t|
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    78
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    79
    t := b4.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    80
    t := (t bitShift:8) + b3.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    81
    t := (t bitShift:8) + b2.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    82
    ^ (t bitShift:8) + b1.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    83
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    84
    "
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    85
     (Integer byte1:16r10 byte2:16r32 byte3:16r54 byte4:16r76) hexPrintString
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    86
     (Integer byte1:16r00 byte2:16r11 byte3:16r22 byte4:16r33) hexPrintString
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    87
    "
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    88
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    89
    "Created: 19.10.1997 / 18:08:52 / cg"
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    90
    "Modified: 19.10.1997 / 18:09:04 / cg"
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    91
!
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    92
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
    93
fastFromString:aString at:startIndex
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
    94
    "return the next unsigned Integer from the string
4610
742650733761 comment
Claus Gittinger <cg@exept.de>
parents: 4609
diff changeset
    95
     as a decimal number, starting at startIndex.
19276
533a1c12846c use atol instead of atoi
Claus Gittinger <cg@exept.de>
parents: 19257
diff changeset
    96
     The number must be in the native machine's int range
23944
1f8b8f9e755f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23930
diff changeset
    97
     (i.e. 64bit or 32bit depending on the cpu's native pointer size);
1f8b8f9e755f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23930
diff changeset
    98
     However, for portability, only use it for 32bit numbers (uint32s).
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
    99
     No spaces are skipped.
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   100
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   101
     This is a specially tuned entry (using a low-level C-call), which
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   102
     returns garbage if the argument string is not a small integer number.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   103
     It has been added to allow high speed string decomposition into numbers,
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   104
     especially for mass-data."
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   105
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   106
%{   /* NOCONTEXT */
12480
01a98f46e297 change __isString() to __isStringLike() in primitive code
Stefan Vogel <sv@exept.de>
parents: 12422
diff changeset
   107
    if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   108
        char *cp = (char *)(__stringVal(aString));
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   109
        int idx = __intVal(startIndex) - 1;
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   110
        unsigned INT val;
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   111
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   112
        if ((unsigned)idx < __stringSize(aString)) {
23944
1f8b8f9e755f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23930
diff changeset
   113
            extern int atoi();
1f8b8f9e755f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23930
diff changeset
   114
            extern long atol();
19276
533a1c12846c use atol instead of atoi
Claus Gittinger <cg@exept.de>
parents: 19257
diff changeset
   115
533a1c12846c use atol instead of atoi
Claus Gittinger <cg@exept.de>
parents: 19257
diff changeset
   116
            val = atol(cp + idx);
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   117
            if (val <= _MAX_INT) {
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   118
                RETURN(__mkSmallInteger(val));
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   119
            }
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   120
            RETURN (__MKUINT(val));
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   121
        }
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   122
    }
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   123
%}.
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   124
    self primitiveFailed.
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   125
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   126
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   127
     Integer fastFromString:'12345' at:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   128
     Integer fastFromString:'12345' at:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   129
     Integer fastFromString:'12345' at:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   130
     Integer fastFromString:'12345' at:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   131
     Integer fastFromString:'12345' at:5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   132
     Integer fastFromString:'1234512345' at:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   133
     Integer fastFromString:'2147483647' at:1
23944
1f8b8f9e755f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23930
diff changeset
   134
     Integer fastFromString:'-12345' at:1
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   135
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   136
     Integer fastFromString:'4294967295' at:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   137
     Integer fastFromString:'12345' at:6
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   138
     Integer fastFromString:'12345' at:0
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   139
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   140
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   141
        100000 timesRepeat:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   142
            Integer readFrom:'12345'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   143
        ]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   144
     ]
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   145
    "
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   146
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   147
    "
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   148
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   149
        100000 timesRepeat:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   150
            Integer fastFromString:'12345' at:1
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   151
        ]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   152
     ]
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   153
    "
23944
1f8b8f9e755f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23930
diff changeset
   154
1f8b8f9e755f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23930
diff changeset
   155
    "Modified (comment): / 20-03-2019 / 13:44:23 / Claus Gittinger"
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   156
!
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   157
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   158
fromBCDBytes:aByteArray
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   159
    "given a byteArray in BCD format, return an appropriate integer.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   160
     The byteArray must contain the BCD encoded decimal string,
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   161
     starting with the most significant digits.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   162
     This conversion is useful for some communication protocols,
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   163
     or control systems, which represent big numbers this way...
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   164
    "
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   165
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   166
    |val|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   167
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   168
    val := 0.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   169
    aByteArray do:[:twoDigits |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   170
        |hi lo|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   171
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   172
        hi := (twoDigits bitShift:-4) bitAnd:16r0F.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   173
        lo := twoDigits bitAnd:16r0F.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   174
        val := (val * 100) + (hi * 10) + lo
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   175
    ].
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   176
    ^ val
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   177
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   178
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   179
     Integer fromBCDBytes:#[16r12 16r34 16r56]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   180
     Integer fromBCDBytes:#[16r12 16r34 16r56 16r78]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   181
     Integer fromBCDBytes:#[16r12 16r34 16r56 16r78 16r90]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   182
     Integer fromBCDBytes:#[16r98 16r76 16r54]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   183
     Integer fromBCDBytes:#[16r98 16r76 16r54 16r32]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   184
     Integer fromBCDBytes:#[16r98 16r76 16r54 16r32 16r10]
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   185
     Integer fromBCDBytes:#[16r12 16r34 16r56 16r78 16r90 16r12 16r34 16r56 16r78 16r90]
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   186
    "
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   187
!
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   188
5171
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   189
fromSwappedBCDBytes:aByteArray
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   190
    "given a byteArray in BCD format, return an appropriate integer.
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   191
     The byteArray must contain the BCD encoded decimal string,
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   192
     starting with the LEAST significant digits.
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   193
     This conversion is useful for some communication protocols,
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   194
     or control systems (e.g. SMC), which represent big numbers this way...
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   195
    "
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   196
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   197
    |val|
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   198
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   199
    val := 0.
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   200
    aByteArray do:[:twoDigits |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   201
        |hi lo|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   202
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   203
        lo := (twoDigits bitShift:-4) bitAnd:16r0F.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   204
        hi := twoDigits bitAnd:16r0F.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   205
        lo <= 9 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   206
            val := (val * 100) + (hi * 10) + lo
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   207
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   208
            "16rF is used to encode an odd number of digits"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   209
            val := (val * 10) + hi.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   210
        ].
5171
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   211
    ].
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   212
    ^ val
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   213
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   214
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   215
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   216
     Integer fromSwappedBCDBytes:#[16r12 16r34 16rF6]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   217
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56 16r78]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   218
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56 16r78 16r90]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   219
     Integer fromSwappedBCDBytes:#[16r98 16r76 16r54]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   220
     Integer fromSwappedBCDBytes:#[16r98 16r76 16r54 16r32]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   221
     Integer fromSwappedBCDBytes:#[16r98 16r76 16r54 16r32 16r10]
5171
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   222
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56 16r78 16r90 16r12 16r34 16r56 16r78 16r90]
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   223
    "
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   224
!
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   225
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   226
new:numberOfBytes neg:negative
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   227
    "for ST-80 compatibility:
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   228
     Return an empty Integer (uninitialized value) with space for
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   229
     numberOfBytes bytes (= digitLength). The additional argument
132
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   230
     negative specifies if the result should be a negative number.
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   231
     The digits can be stored byte-wise into the result, using digitAt:put:"
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   232
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
   233
    ^ LargeInteger basicNew
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   234
            numberOfDigits:numberOfBytes
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   235
            sign:(negative ifTrue:[-1] ifFalse:[1])
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   236
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   237
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   238
readFrom:aStringOrStream
20329
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   239
    "return the next Integer from the (character-)stream aStream
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   240
     as decimal number.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   241
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   242
     NOTICE:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   243
       This behaves different from the default readFrom:, in returning
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   244
       0 (instead of raising an error) in case no number can be read.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   245
       It is unclear, if this is the correct behavior (ST-80 does this)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   246
       - depending on the upcoming ANSI standard, this may change."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   247
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   248
    ^ self readFrom:aStringOrStream onError:0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   249
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   250
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   251
     Integer readFrom:(ReadStream on:'foobar')
22460
f8b145aaccda #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22222
diff changeset
   252
     Integer readFrom:(ReadStream on:'123foobar')
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   253
     Integer readFrom:(ReadStream on:'foobar') onError:nil
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   254
    "
22460
f8b145aaccda #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22222
diff changeset
   255
f8b145aaccda #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 22222
diff changeset
   256
    "Modified (comment): / 17-01-2018 / 18:27:26 / stefan"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   257
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   258
21636
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   259
readFrom:aStringOrStream allowRadix:allowRadix onError:exceptionBlock
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   260
    "return the next Integer from the (character-)stream aStream,
21637
337ade9e863e #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21636
diff changeset
   261
     possibly handling initial XXr for arbitrary radix numbers and initial sign.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   262
     Also, all initial whitespace is skipped.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   263
     If the string does not represent a valid integer number,
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   264
     return the value of exceptionBlock."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   265
3995
777470826394 no need for another error-handler blcok in #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3993
diff changeset
   266
    |value|
777470826394 no need for another error-handler blcok in #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3993
diff changeset
   267
7093
60bad14d38fc Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 6907
diff changeset
   268
    Error handle:[:ex |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   269
        ^ exceptionBlock value
1700
25223802076c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1560
diff changeset
   270
    ] do:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   271
        |str nextChar negative|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   272
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   273
        str := aStringOrStream readStream.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   274
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   275
        nextChar := str skipSeparators.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   276
        (nextChar == $-) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   277
            negative := true.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   278
            str next.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   279
            nextChar := str peekOrNil
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   280
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   281
            negative := false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   282
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   283
        (nextChar isNil or:[nextChar isDigit not]) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   284
            "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   285
             the string does not represent an integer
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   286
            "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   287
            ^ exceptionBlock value
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   288
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   289
        value := self readFrom:str radix:10.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   290
        nextChar := str peekOrNil.
21636
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   291
        (allowRadix and:[((nextChar == $r) or:[ nextChar == $R])]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   292
            "-xxr<number> is invalid; should be xxr-<val>"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   293
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   294
            negative ifTrue:[
20332
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   295
                'Integer [warning]: invalid (negative) radix; please use xxr-<val> instead of -xxr<number>' errorPrintCR.
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   296
                "/ negative := false
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   297
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   298
            str next.
20332
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   299
            nextChar := str peekOrNil.
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   300
            nextChar == $- ifTrue:[
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   301
                negative ifTrue:[
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   302
                    'Integer [warning]: invalid double sign; please use xxr-<val> instead of -xxr<number>' errorPrintCR.
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   303
                ].
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   304
                negative := true.
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   305
                str next.
1f8971a07091 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20329
diff changeset
   306
            ].
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   307
            value := self readFrom:str radix:value
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   308
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   309
        negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   310
            value := value negated
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   311
        ].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   312
    ].
3995
777470826394 no need for another error-handler blcok in #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3993
diff changeset
   313
    ^ value
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   314
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   315
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   316
     Integer readFrom:'12345'      onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   317
     Integer readFrom:'-12345'     onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   318
     Integer readFrom:'+12345'     onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   319
     Integer readFrom:'16rFFFF'    onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   320
     Integer readFrom:'12345.1234' onError:['wrong']
3995
777470826394 no need for another error-handler blcok in #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3993
diff changeset
   321
     Integer readFrom:'foo'        onError:['wrong']
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   322
     Integer readFrom:'foo'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   323
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   324
21636
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   325
    "Created: / 09-03-2017 / 16:26:28 / cg"
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   326
!
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   327
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   328
readFrom:aStringOrStream onError:exceptionBlock
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   329
    "return the next Integer from the (character-)stream aStream,
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   330
     handling initial XXr for arbitrary radix numbers and initial sign.
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   331
     Also, all initial whitespace is skipped.
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   332
     If the string does not represent a valid integer number,
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   333
     return the value of exceptionBlock."
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   334
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   335
    ^ self readFrom:aStringOrStream allowRadix:true onError:exceptionBlock
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   336
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   337
    "
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   338
     Integer readFrom:'12345'      onError:['wrong']
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   339
     Integer readFrom:'-12345'     onError:['wrong']
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   340
     Integer readFrom:'+12345'     onError:['wrong']
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   341
     Integer readFrom:'16rFFFF'    onError:['wrong']
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   342
     Integer readFrom:'12345.1234' onError:['wrong']
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   343
     Integer readFrom:'foo'        onError:['wrong']
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   344
     Integer readFrom:'foo'
24683
987525476817 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24607
diff changeset
   345
     Integer readFrom:'0xFFFF'     onError:['wrong'] 
21636
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   346
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   347
     Integer readFrom:'16rFFFF'    allowRadix:false onError:['wrong']
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   348
    "
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   349
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   350
    "Created: / 16-11-1995 / 22:48:59 / cg"
b1bf6b59060e #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21429
diff changeset
   351
    "Modified (comment): / 09-03-2017 / 16:27:14 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   352
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   353
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   354
readFrom:aStringOrStream radix:radix
20329
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   355
    "return the next UNSIGNED Integer from the (character-)stream aStream in radix; 
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   356
     (assumes that the initial XXr has already been read).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   357
     No whitespace-skipping is done.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   358
     Returns 0 if no number available.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   359
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   360
     NOTICE:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   361
       This behaves different from the default readFrom:, in returning
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   362
       0 (instead of raising an error) in case no number can be read.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   363
       It is unclear, if this is the correct behavior (ST-80 does this)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   364
       - depending on the upcoming ANSI standard, this may change."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   365
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   366
    ^ self readFrom:aStringOrStream radix:radix onError:0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   367
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   368
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   369
readFrom:aStringOrStream radix:radix onError:exceptionBlock
20329
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   370
    "return the next UNSIGNED Integer from the (character-)stream aStream in radix; 
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   371
     (assumes that the initial XXr has already been read).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   372
     No whitespace-skipping is done.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   373
     Returns the value of exceptionBlock, if no number is available."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   374
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   375
    |str nextChar value
4169
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   376
     r     "{ Class: SmallInteger }"
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   377
     r2    "{ Class: SmallInteger }"
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   378
     r3    "{ Class: SmallInteger }"
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   379
     r4    "{ Class: SmallInteger }"
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   380
     digit1 digit2 digit3 digit4 |
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   381
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   382
    str := aStringOrStream readStream.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   383
3374
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   384
    nextChar := str peekOrNil.
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   385
    (nextChar isNil or:[(value := nextChar digitValueRadix:radix) isNil]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   386
        ^ exceptionBlock value
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   387
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   388
4169
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   389
"/ OLD code
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   390
"/    [nextChar notNil and:[nextChar isDigitRadix:radix]] whileTrue:[
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   391
"/        str next.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   392
"/        value := value * radix + nextChar digitValue.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   393
"/        nextChar := str peekOrNil.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   394
"/    ].
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   395
"/    ^ value.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   396
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   397
    "/ the code below does the same, but is much faster, if the
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   398
    "/ converted number is large
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   399
    "/ (requires only half as many LargeInt multiplications and additions)
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   400
    "/ It should not be slower for smallIntegers.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   401
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   402
    r := radix.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   403
    r2 := r * r.
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   404
    r4 := r2 * r2.
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   405
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   406
    [
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   407
        nextChar := str nextPeekOrNil.
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   408
        nextChar notNil and:[(digit1 := nextChar digitValueRadix:r) notNil]
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   409
    ] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   410
        "/ read 4 chars and pre-compute their value to avoid largeInt operations.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   411
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   412
        nextChar := str nextPeekOrNil.
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   413
        (nextChar isNil or:[(digit2 := nextChar digitValueRadix:r) isNil]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   414
            ^ (value * r) + digit1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   415
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   416
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   417
        nextChar := str nextPeekOrNil.
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   418
        (nextChar isNil or:[(digit3 := nextChar digitValueRadix:r) isNil]) ifTrue:[
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   419
            ^ (value * r2) + ((digit1*r) + digit2) .
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   420
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   421
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   422
        nextChar := str nextPeekOrNil.
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   423
        (nextChar isNil or:[ (digit4 := nextChar digitValueRadix:r) isNil]) ifTrue:[
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   424
            r3 := r2 * r.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   425
            ^ (value * r3) + ((((digit1*r) + digit2)*r) + digit3).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   426
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   427
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   428
        value := (value * r4) + ((((((digit1*r) + digit2)*r) + digit3)*r) + digit4).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   429
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   430
    ^ value
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   431
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   432
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   433
     Integer readFrom:(ReadStream on:'12345') radix:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   434
     Integer readFrom:(ReadStream on:'FFFF') radix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   435
     Integer readFrom:(ReadStream on:'1010') radix:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   436
     Integer readFrom:(ReadStream on:'foobar') radix:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   437
     Integer readFrom:(ReadStream on:'foobar') radix:10 onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   438
     Integer readFrom:'gg' radix:10 onError:0
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   439
     Integer readFrom:'' radix:10 onError:'wrong'
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   440
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   441
     |s|
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   442
     s := String new:1000 withAll:$1.
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   443
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   444
        1000 timesRepeat:[
20130
f5f12388c4fb #FEATURE by stefan
Stefan Vogel <sv@exept.de>
parents: 19874
diff changeset
   445
            s asInteger
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   446
        ]
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
   447
     ]
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   448
    "
3374
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   449
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   450
    "Modified: / 14.4.1998 / 19:16:46 / cg"
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   451
!
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   452
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   453
readFromRomanString:aStringOrStream
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   454
    "convert a string or stream containing a roman representation into an integer.
11125
89eb8912ef38 comment
Claus Gittinger <cg@exept.de>
parents: 11095
diff changeset
   455
     Raises a RomanNumberFormatError, if the inputs format is completely wrong.
21429
f926511bf350 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21386
diff changeset
   456
     Raises BadRomanNumberFormatError if it's wrong, but could be parsed.
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   457
     Notifies via NaiveRomanNumberFormatNotification, if its a bit wrong (naive format).
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   458
     Will read both real and naive roman numbers (see printRomanOn: vs. printRomanOn:naive:),
20378
d0b2afa829d4 #OTHER by mawalch
mawalch
parents: 20332
diff changeset
   459
     however, a notification is raised for naive numbers (catch it if you are interested in it)."
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   460
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   461
    |romanValues s c val digitVal prevDigitVal countSame delta
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   462
     stopOnSeparator finish|
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   463
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   464
    romanValues := Dictionary
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   465
                    withKeys:'MDCLXVI' "/ #($M $D $C $L $X $V $I)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   466
                    andValues:#(1000 500 100 50 10 5 1).
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   467
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   468
    (stopOnSeparator := aStringOrStream isStream) ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   469
        s := aStringOrStream readStream.
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   470
    ].
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   471
    s atEnd ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   472
        ^ RomanNumberFormatError raiseErrorString:'empty string'
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   473
    ].
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   474
    val := 0.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   475
    prevDigitVal := 99999.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   476
    countSame := 1.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   477
    finish := false.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   478
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   479
    [s atEnd or:[finish]] whileFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   480
        c := s next asUppercase.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   481
        c isSeparator ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   482
            stopOnSeparator ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   483
                ^ RomanNumberFormatError raiseErrorString:'garbage at the end'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   484
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   485
            finish := true.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   486
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   487
            digitVal := romanValues at:c ifAbsent:nil.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   488
            digitVal isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   489
                ^ RomanNumberFormatError raiseErrorString:'invalid character'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   490
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   491
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   492
            digitVal = prevDigitVal ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   493
                ( #( 1 10 100 1000) includes:digitVal) ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   494
                    ^ RomanNumberFormatError raiseErrorString:'character may not be repeated'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   495
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   496
                val := val + digitVal.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   497
                countSame := countSame + 1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   498
                countSame >= 4 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   499
                    digitVal ~= 1000 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   500
                        countSame > 4 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   501
                            "/ this is a bad roman number (such as MCCCCCCCCXXXXXXII);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   502
                            "/ Its not correct, but sometimes encountered on buildings.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   503
                            "/ If you do not want to be too picky,
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   504
                            "/ provide a proceeding handler in order to proceed the conversion.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   505
                            BadRomanNumberFormatError raiseRequestErrorString:'more than 4 occurrences of same character'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   506
                        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   507
                            "/ this is a naive roman number (such as VIIII);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   508
                            "/ Its not correct, but very often encountered (especially as page numbers).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   509
                            "/ The notification below normally goes unnoticed, unless some input validator
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   510
                            "/ wants to be very picky, and treat this as an error.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   511
                            "/ To do so, provide a handler for NaiveRomanNumberFormatNotification.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   512
                            NaiveRomanNumberFormatNotification raiseRequestErrorString:'more than 3 occurrences of same character'.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   513
                        ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   514
                    ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   515
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   516
            ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   517
                digitVal < prevDigitVal ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   518
                    val := val + digitVal.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   519
                ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   520
                    countSame == 1 ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   521
                        ^ RomanNumberFormatError raiseErrorString:'invalid character combination'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   522
                    ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   523
                    delta := digitVal - prevDigitVal.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   524
                    ( #( 4 9 40 90 400 900) includes:delta) ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   525
                        ^ RomanNumberFormatError raiseErrorString:'invalid character combination'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   526
                    ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   527
                    val := val - prevDigitVal.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   528
                    val := val + delta.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   529
                    digitVal := prevDigitVal - 0.1.  "/ trick: prevent prevDigit from arriving again.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   530
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   531
                countSame := 1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   532
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   533
            prevDigitVal := digitVal.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   534
        ].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   535
    ].
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   536
"/    val > 5000 ifTrue:[
20622
952f7804f48c #DOCUMENTATION by mawalch
mawalch
parents: 20378
diff changeset
   537
"/        ^ RomanNumberFormatError raiseErrorString:'number out of range (1..5000)'
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   538
"/    ].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   539
    ^ val.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   540
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   541
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   542
     Integer readFromRomanString:'I'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   543
     Integer readFromRomanString:'II'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   544
     Integer readFromRomanString:'III'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   545
     Integer readFromRomanString:'IV'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   546
     Integer readFromRomanString:'clix'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   547
     Integer readFromRomanString:'MIX'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   548
     Integer readFromRomanString:'MCMXCIX'
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   549
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   550
   Naive cases (which are accepted):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   551
     Integer readFromRomanString:'IIII'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   552
     Integer readFromRomanString:'VIIII'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   553
     Integer readFromRomanString:'CLXXXXVIIII'
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   554
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   555
    Error case (not proceedable):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   556
     Integer readFromRomanString:'LC'
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   557
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   558
    Error case (proceedable):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   559
     Integer readFromRomanString:'MCCCCCCCCXXXXXXIIIIII'
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   560
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   561
     BadRomanNumberFormatError ignoreIn:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   562
         Integer readFromRomanString:'MCCCCCCCCXXXXXXIIIIII'
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   563
     ]
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   564
    "
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   565
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   566
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   567
    "naive cases:
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   568
     #(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   569
        'MCMXCIX'           1999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   570
        'MCMXCVIIII'        1999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   571
        'MCMLXXXXIX'        1999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   572
        'MDCCCCXCIX'        1999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   573
        'MDCCCCXCVIIII'     1999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   574
        'MDCCCCLXXXXIX'     1999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   575
        'MDCCCCLXXXXVIIII'  1999
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   576
     ) pairWiseDo:[:goodString :expectedValue |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   577
        (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   578
     ]
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   579
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   580
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   581
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   582
    "error cases:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   583
      #(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   584
        'XIIX'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   585
        'VV'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   586
        'VVV'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   587
        'XXL'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   588
        'XLX'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   589
        'LC'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   590
        'LL'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   591
        'DD'
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   592
     ) do:[:badString |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   593
        (Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   594
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   595
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   596
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   597
    "good cases:
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   598
     #( 'I'     1
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   599
        'II'    2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   600
        'III'   3
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   601
        'IV'    4
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   602
        'V'     5
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   603
        'VI'    6
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   604
        'VII'   7
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   605
        'VIII'  8
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   606
        'IX'    9
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   607
        'X'     10
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   608
        'XI'    11
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   609
        'XII'   12
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   610
        'XIII'  13
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   611
        'XIV'   14
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   612
        'XV'    15
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   613
        'XVI'   16
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   614
        'XVII'  17
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   615
        'XVIII' 18
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   616
        'XIX'   19
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   617
        'XX'    20
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   618
        'XXX'   30
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   619
        'L'     50
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   620
        'XL'    40
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   621
        'LX'    60
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   622
        'LXX'   70
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   623
        'LXXX'  80
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   624
        'CXL'   140
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   625
        'CL'    150
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   626
        'CLX'   160
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   627
        'MMM'                   3000
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   628
        'MMMM'                  4000
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   629
        'MMMMCMXCIX'            4999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   630
        'MMMMMMMMMCMXCIX'       9999
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   631
     ) pairWiseDo:[:goodString :expectedValue |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   632
        (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   633
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   634
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   636
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   637
      1 to:9999 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   638
        |romanString|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   639
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   640
        romanString := String streamContents:[:stream | n printRomanOn:stream].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   641
        (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   642
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   643
    "
21429
f926511bf350 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21386
diff changeset
   644
f926511bf350 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 21386
diff changeset
   645
    "Modified (comment): / 13-02-2017 / 20:23:02 / cg"
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   646
!
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   647
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   648
readFromRomanString:aStringOrStream onError:exceptionalValue
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   649
    "convert a string or stream containing a roman representation into an integer.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   650
     Raises an exception, if the inputs format is wrong.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   651
     Does allow reading of naive (more than 3 in a row) and
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   652
     bad (not using L and D) roman numbers.
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   653
     (Such numbers can be seen on some medevial buildings. "
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   654
21386
6cdddfc6f2e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20687
diff changeset
   655
    ^ RomanNumberFormatError
6cdddfc6f2e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20687
diff changeset
   656
        handle:[:ex | exceptionalValue value ]
6cdddfc6f2e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20687
diff changeset
   657
        do:[ self readFromRomanString:aStringOrStream ].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   658
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   659
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   660
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   661
     Integer readFromRomanString:'I'    onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   662
     Integer readFromRomanString:'II'   onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   663
     Integer readFromRomanString:'III'  onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   664
     Integer readFromRomanString:'IV'   onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   665
     Integer readFromRomanString:'clix' onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   666
     Integer readFromRomanString:'MCMXCIX' onError:nil
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   667
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   668
   Naive cases (which are accepted):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   669
     Integer readFromRomanString:'IIII' onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   670
     Integer readFromRomanString:'VIIII' onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   671
     Integer readFromRomanString:'CLXXXXVIIII' onError:nil
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   672
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   673
   Error cases:
21386
6cdddfc6f2e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20687
diff changeset
   674
     Integer readFromRomanString:'LC'   onError:nil
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   675
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   676
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   677
    "error cases:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   678
      #(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   679
        'XIIX'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   680
        'VV'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   681
        'VVV'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   682
        'XXL'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   683
        'XLX'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   684
        'LC'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   685
        'LL'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   686
        'DD'
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   687
     ) do:[:badString |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   688
        (Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   689
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   690
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   691
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   692
    "naive (but handled) cases:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   693
      #(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   694
        'IIII'   4
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   695
        'VIIII'  9
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   696
        'XIIII'  14
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   697
        'XVIIII' 19
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   698
     ) pairWiseDo:[:goodString :expectedValue |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   699
        (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   700
     ]
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   701
    "
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   702
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   703
    "good cases:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   704
     #( 'I'     1
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   705
        'II'    2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   706
        'III'   3
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   707
        'IV'    4
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   708
        'V'     5
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   709
        'VI'    6
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   710
        'VII'   7
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   711
        'VIII'  8
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   712
        'IX'    9
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   713
        'X'     10
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   714
        'XI'    11
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   715
        'XII'   12
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   716
        'XIII'  13
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   717
        'XIV'   14
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   718
        'XV'    15
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   719
        'XVI'   16
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   720
        'XVII'  17
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   721
        'XVIII' 18
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   722
        'XIX'   19
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   723
        'XX'    20
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   724
        'XXX'   30
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   725
        'L'     50
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   726
        'XL'    40
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   727
        'LX'    60
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   728
        'LXX'   70
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   729
        'LXXX'  80
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   730
        'CXL'   140
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   731
        'CL'    150
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   732
        'CLX'   160
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   733
        'MMM'                   3000
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   734
        'MMMM'                  4000
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   735
        'MMMMCMXCIX'            4999
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   736
        'MMMMMMMMMCMXCIX'       9999
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   737
     ) pairWiseDo:[:goodString :expectedValue |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   738
        (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   739
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   740
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   741
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   742
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   743
      1 to:9999 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   744
        |romanString|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   745
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   746
        romanString := String streamContents:[:stream | n printRomanOn:stream].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   747
        (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   748
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   749
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   750
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   751
    "reading naive numbers:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   752
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   753
      1 to:9999 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   754
        |romanString|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   755
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   756
        romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   757
        (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   758
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   759
    "
21386
6cdddfc6f2e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20687
diff changeset
   760
6cdddfc6f2e0 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20687
diff changeset
   761
    "Modified (comment): / 08-02-2017 / 19:07:00 / stefan"
8897
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   762
!
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   763
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   764
readFromString:aString radix:base onError:exceptionBlock
20329
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   765
    "return the next UNSIGNED Integer from the (character-)aString in radix; 
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   766
     (assumes that the initial XXr has already been read).
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   767
     No whitespace-skipping is done.
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   768
     Expects that NO garbage is at the end of the string.
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   769
     Returns the value from exceptionBlock, if no valid integer is in the string."
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   770
8897
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   771
    |str val|
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   772
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   773
    str := ReadStream on:aString.
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   774
    val := self readFrom:str radix:base onError:[^ exceptionBlock value].
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   775
    str atEnd ifFalse:[ ^ exceptionBlock value].
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   776
    ^ val
20329
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   777
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   778
    "
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   779
     Integer readFromString:'1234' radix:10 onError:[nil] 
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   780
     Integer readFromString:'-1234' radix:10 onError:[nil]  - I only read unsigned numbers
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   781
     Integer readFromString:' 1234' radix:10 onError:[nil]  - I do not skip whitespace
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   782
     Integer readFromString:'1234 ' radix:10 onError:[nil]  - I do not accept anything after the number
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   783
8d0544411027 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 20269
diff changeset
   784
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   785
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   786
9141
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   787
!Integer class methodsFor:'Compatibility-Squeak'!
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   788
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   789
readFrom:aStringOrStream base:aBase
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   790
    "for squeak compatibility"
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   791
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   792
    ^ self readFrom:aStringOrStream radix:aBase
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   793
! !
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   794
4996
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   795
!Integer class methodsFor:'Signal constants'!
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   796
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   797
bcdConversionErrorSignal
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   798
    "return the signal which is raised when bcd conversion fails
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   799
     (i.e. when trying to decode an invalid BCD number)"
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   800
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   801
    ^ BCDConversionErrorSignal
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   802
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   803
    "Modified: / 15.11.1999 / 20:35:20 / cg"
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   804
! !
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   805
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   806
!Integer class methodsFor:'class initialization'!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   807
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   808
initialize
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   809
    BCDConversionErrorSignal isNil ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   810
        BCDConversionErrorSignal := ConversionError newSignal.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   811
        BCDConversionErrorSignal nameClass:self message:#bcdConversionErrorSignal.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   812
        BCDConversionErrorSignal notifierString:'bcd conversion error'.
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   813
    ].
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   814
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   815
    "Modified: / 15.11.1999 / 20:36:04 / cg"
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   816
! !
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   817
21822
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
   818
!Integer class methodsFor:'coercing & converting'!
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
   819
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
   820
coerce:aNumber
25010
b6ca5e1a1592 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24978
diff changeset
   821
    "convert the argument aNumber into an instance of the receiver (class) and return it."
21822
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
   822
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
   823
    ^ aNumber asInteger
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
   824
! !
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
   825
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   826
!Integer class methodsFor:'constants'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   827
7727
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   828
epsilon
21903
af41d081505d #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21822
diff changeset
   829
    "return the maximum relative spacing of instances of mySelf
af41d081505d #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21822
diff changeset
   830
     (i.e. the value-delta of the least significant bit)"
7727
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   831
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   832
    "don't know, what to really return here.
8635
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   833
     Returning 1 gives stupid values when doing some taylor series approximations
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   834
     (although it is correct)"
7727
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   835
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   836
    ^ Float epsilon.
8635
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   837
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   838
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   839
     2 sqrt_withAccuracy:(Integer epsilon)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   840
     2 sqrt_withAccuracy:1
8635
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   841
    "
21903
af41d081505d #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21822
diff changeset
   842
af41d081505d #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 21822
diff changeset
   843
    "Modified (comment): / 22-06-2017 / 13:44:17 / cg"
7727
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   844
!
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   845
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   846
unity
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   847
    "return the neutral element for multiplication (1)"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   848
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   849
    ^ 1
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   850
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   851
    "Modified: 18.7.1996 / 12:26:43 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   852
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   853
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   854
zero
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   855
    "return the neutral element for addition (0)"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   856
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   857
    ^ 0
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   858
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   859
    "Modified: 18.7.1996 / 12:26:38 / cg"
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   860
! !
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   861
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   862
!Integer class methodsFor:'prime numbers'!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   863
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   864
flushPrimeCache
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
   865
    "cleanup after using a primeCache.
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
   866
     See comment in initializePrimeCacheUpTo:limit"
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   867
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   868
    PrimeCache := nil.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   869
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   870
    "
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   871
     Integer initializePrimeCacheUpTo:1000000
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   872
     Integer flushPrimeCache.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   873
    "
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   874
!
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   875
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   876
initializePrimeCacheUpTo:limit
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   877
    "if many operations are to be done using primes, we can keep them around...
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   878
     You will need n/8/2 bytes to keep fast info about primes up to n
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   879
     (i.e. 100Mb is good for primes up to 1.6*10^9)"
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   880
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   881
    |bits|
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   882
11563
a91c8d348760 could have returned an uncompressed largeint after bitShift
Claus Gittinger <cg@exept.de>
parents: 11521
diff changeset
   883
    PrimeCache := nil.
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   884
    bits := BooleanArray new:limit//2.
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   885
    self primesUpTo:limit do:[:p |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   886
        bits at:p//2 put:true
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   887
    ].
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   888
    PrimeCache := bits.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   889
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   890
    "
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   891
     Integer initializePrimeCacheUpTo:1000000.
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   892
     Integer initializePrimeCacheUpTo:10000000.
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   893
     Integer initializePrimeCacheUpTo:100000000.
11563
a91c8d348760 could have returned an uncompressed largeint after bitShift
Claus Gittinger <cg@exept.de>
parents: 11521
diff changeset
   894
     Integer initializePrimeCacheUpTo:1000000000.
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   895
     Integer flushPrimeCache.
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   896
    "
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   897
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   898
    "
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   899
     Integer flushPrimeCache.
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   900
     Transcript showCR:(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   901
        Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   902
     ).
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   903
     Integer initializePrimeCacheUpTo:100000.
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   904
     Transcript showCR:(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   905
        Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   906
     ).
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   907
     Integer flushPrimeCache.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   908
    "
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   909
!
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   910
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   911
largePrimesUpTo: max do: aBlock
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
   912
    "Evaluate aBlock with all primes up and including maxValue.
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   913
     The Algorithm is adapted from http://www.rsok.com/~jrm/printprimes.html
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   914
     It encodes prime numbers much more compactly than #primesUpTo:
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   915
     38.5 integer per byte (2310 numbers per 60 byte) allow for some fun large primes.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   916
     (all primes up to SmallInteger maxVal can be computed within ~27MB of memory;
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   917
     the regular #primesUpTo: would require 4 *GIGA*bytes).
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   918
     Note: The algorithm could be re-written to produce the first primes (which require
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   919
     the longest time to sieve) faster but only at the cost of clarity."
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   920
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   921
    | limit flags maskBitIndex bitIndex maskBit byteIndex index primesUpTo2310 indexLimit |
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   922
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
   923
    limit := max asInteger.
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   924
    indexLimit := max sqrt truncated + 1.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   925
    "Create the array of flags."
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   926
    flags := ByteArray new: (limit + 2309) // 2310 * 60 + 60.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   927
    flags atAllPut: 16rFF. "set all to true"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   928
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   929
    "Compute the primes up to 2310"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   930
    primesUpTo2310 := self primesUpTo: 2310.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   931
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   932
    "Create a mapping from 2310 integers to 480 bits (60 byte)"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   933
    maskBitIndex := Array new: 2310.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   934
    bitIndex := -1. "for pre-increment"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   935
    maskBitIndex at: 1 put: (bitIndex := bitIndex + 1).
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   936
    maskBitIndex at: 2 put: (bitIndex := bitIndex + 1).
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   937
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   938
    1 to: 5 do:[:i| aBlock value: (primesUpTo2310 at: i)].
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   939
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   940
    index := 6.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   941
    2 to: 2309 do:[:n|
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   942
        [(primesUpTo2310 at: index) < n]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   943
            whileTrue:[index := index + 1].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   944
        n = (primesUpTo2310 at: index) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   945
            maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   946
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   947
            "if modulo any of the prime factors of 2310, then could not be prime"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   948
            (n \\ 2 = 0 or:[n \\ 3 = 0 or:[n \\ 5 = 0 or:[n \\ 7 = 0 or:[n \\ 11 = 0]]]])
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   949
                    ifTrue:[maskBitIndex at: n+1 put: 0]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   950
                    ifFalse:[maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1)].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   951
        ].
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   952
    ].
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   953
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   954
    "Now the real work begins...
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   955
    Start with 13 since multiples of 2,3,5,7,11 are handled by the storage method;
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   956
    increment by 2 for odd numbers only."
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   957
    13 to: limit by: 2 do:[:n|
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   958
        (maskBit := maskBitIndex at: (n \\ 2310 + 1)) = 0 ifFalse:["not a multiple of 2,3,5,7,11"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   959
            byteIndex := n // 2310 * 60 + (maskBit-1 bitShift: -3) + 1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   960
            bitIndex := 1 bitShift: (maskBit bitAnd: 7).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   961
            ((flags at: byteIndex) bitAnd: bitIndex) = 0 ifFalse:["not marked -- n is prime"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   962
                aBlock value: n.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   963
                "Start with n*n since any integer < n has already been sieved
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   964
                (e.g., any multiple of n with a number k < n has been cleared
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   965
                when k was sieved); add 2 * i to avoid even numbers and
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   966
                mark all multiples of this prime. Note: n < indexLimit below
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   967
                limits running into LargeInts -- nothing more."
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   968
                n < indexLimit ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   969
                    index := n * n.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   970
                    (index bitAnd: 1) = 0 ifTrue:[index := index + n].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   971
                    [index <= limit] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   972
                        (maskBit := maskBitIndex at: (index \\ 2310 + 1)) = 0 ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   973
                            byteIndex := (index // 2310 * 60) + (maskBit-1 bitShift: -3) + 1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   974
                            maskBit := 255 - (1 bitShift: (maskBit bitAnd: 7)).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   975
                            flags at: byteIndex put: ((flags at: byteIndex) bitAnd: maskBit).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   976
                        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   977
                        index := index + (2 * n)].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   978
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   979
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
   980
        ].
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   981
    ].
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   982
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   983
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   984
     Integer largePrimesUpTo:1000000 do:[:i | i > 900000 ifTrue:[self halt] ]
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   985
     (Integer primesUpTo:1000000) inspect
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   986
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   987
!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   988
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   989
primeCacheSize
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
   990
    "see comment in initializePrimeCacheUpTo:limit"
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
   991
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   992
    ^ PrimeCache size * 2
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   993
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   994
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   995
     Integer initializePrimeCacheUpTo:1000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   996
     Integer initializePrimeCacheUpTo:1000000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   997
     Integer initializePrimeCacheUpTo:1000000000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   998
     Integer flushPrimeCache.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   999
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1000
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1001
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1002
     Integer flushPrimeCache.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1003
     Transcript showCR:(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1004
        Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1005
     ).
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1006
     Integer initializePrimeCacheUpTo:100000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1007
     Transcript showCR:(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1008
        Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1009
     ).
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1010
     Integer flushPrimeCache.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1011
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1012
!
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1013
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1014
primesUpTo5000
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1015
    "return a table of primes up to 5000.
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1016
     Primes are heavily used to compute good container sizes in Set and Dictionary,
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1017
     and in some cryprographic algorithms."
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1018
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1019
    ^ #(
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1020
            2 3   5   7  11  13  17  19  23  29  31  37  41  43  47  53  59  61  67  71
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1021
             73  79  83  89  97 101 103 107 109 113 127 131 137 139 149 151 157 163 167
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1022
            173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1023
            277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1024
            397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1025
            509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1026
            641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1027
            761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1028
            887 907 911 919 929 937 941 947 953 967 971 977 983 991 997
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1029
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1030
            1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1031
            1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1032
            1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1033
            1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1034
            1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1035
            1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1036
            1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1037
            1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1038
            1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1039
            
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1040
            2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1041
            2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1042
            2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1043
            2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1044
            2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1045
            2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1046
            2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1047
            2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1048
            2939 2953 2957 2963 2969 2971 2999 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1049
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1050
            3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1051
            3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1052
            3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1053
            3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1054
            3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1055
            3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1056
            3733 3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1057
            3863 3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1058
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1059
            4001 4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1060
            4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1061
            4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1062
            4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1063
            4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1064
            4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1065
            4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1066
            4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1067
        ).
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1068
!
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1069
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1070
primesUpTo: max
15578
88cefb6e5d94 class: Integer
Stefan Vogel <sv@exept.de>
parents: 15567
diff changeset
  1071
    "Return a list of prime integers up to and including the given integer."
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1072
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1073
    |cls|
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1074
20646
16ddbfd2e22a #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 20622
diff changeset
  1075
    "/ sigh: IntegerArray is in libbasic2...
16ddbfd2e22a #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 20622
diff changeset
  1076
    (IntegerArray notNil 
16ddbfd2e22a #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 20622
diff changeset
  1077
    and:[ max < IntegerArray maxVal]) ifTrue:[
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1078
        cls := IntegerArray.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1079
    ] ifFalse:[
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1080
        cls := Array.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1081
    ].
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1082
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  1083
    ^ cls streamContents:[:s| self primesUpTo: max do:[:prime| s nextPut: prime]]
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1084
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1085
    "
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1086
     Integer primesUpTo: 100
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1087
     Integer primesUpTo: 13
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1088
     (Integer primesUpTo: 100) select:[:p | p between:10 and:99]
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1089
    "
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1090
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1091
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1092
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1093
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1094
     N := 1000.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1095
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1096
     a := (1 to:1000)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1097
         collect:[:i | p := p nextPrime. p ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1098
         thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1099
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1100
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1101
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1102
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1103
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1104
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1105
     N := 1000 nextPrime.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1106
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1107
     a := (1 to:1000)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1108
         collect:[:i | p := p nextPrime. p ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1109
         thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1110
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1111
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1112
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1113
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1114
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1115
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1116
     N := 1000 nextPrime-1.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1117
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1118
     a := (1 to:1000)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1119
         collect:[:i | p := p nextPrime. p ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1120
         thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1121
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1122
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1123
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1124
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1125
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1126
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1127
     N := 100000.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1128
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1129
     a := (1 to:N)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1130
         collect:[:i | p := p nextPrime. p ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1131
         thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1132
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1133
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1134
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1135
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1136
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1137
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1138
     N := 100000 nextPrime.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1139
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1140
     a := (1 to:N)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1141
         collect:[:i | p := p nextPrime. p ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1142
         thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1143
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1144
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1145
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1146
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1147
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1148
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1149
     N := 100000 nextPrime-1.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1150
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1151
     a := (1 to:N)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1152
         collect:[:i | p := p nextPrime. p ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1153
         thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1154
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1155
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1156
    "
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1157
!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1158
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1159
primesUpTo: max do: aBlock
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  1160
    "Compute aBlock with all prime integers up to and including the given integer.
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  1161
     See comment in initializePrimeCacheUpTo:limit"
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  1162
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1163
    | limit 
19131
Claus Gittinger <cg@exept.de>
parents: 19130
diff changeset
  1164
      iLimit "{ Class: SmallInteger }"
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1165
      flags 
19131
Claus Gittinger <cg@exept.de>
parents: 19130
diff changeset
  1166
      prime "{ Class: SmallInteger }"
Claus Gittinger <cg@exept.de>
parents: 19130
diff changeset
  1167
      k "{ Class: SmallInteger }"
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1168
      wellKnownPrimes|
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1169
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1170
    wellKnownPrimes := self primesUpTo5000.  
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1171
    max <= (wellKnownPrimes last+1) ifTrue:[
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1172
        wellKnownPrimes do:[:p |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1173
            p > max ifTrue:[^ self].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1174
            aBlock value:p.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1175
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1176
        ^ self.
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
  1177
    ].
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1178
    
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1179
    max <= self primeCacheSize ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1180
        aBlock value:2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1181
        3 to:max by:2 do:[:p |
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1182
            (PrimeCache at:p//2) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1183
                aBlock value:p
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1184
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1185
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1186
        ^ self.
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1187
    ].
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1188
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1189
    limit := max asInteger - 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1190
    "Fall back into #largePrimesUpTo:do: if we'd require more than 100k of memory;
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1191
    the alternative will only requre 1/154th of the amount we need here and is almost as fast."
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1192
    limit > 25000 ifTrue:[^ self largePrimesUpTo: max do: aBlock].
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1193
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1194
    iLimit := limit.
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1195
    
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1196
    "/ sieve, on the fly
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1197
    flags := ByteArray new: iLimit.
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1198
    aBlock value: 2.
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1199
    
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1200
    2 to: iLimit by:2 do: [:i |
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1201
        (flags at: i) == 0 ifTrue: [
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1202
            prime := i + 1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1203
            k := i + prime.
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1204
            [k <= iLimit] whileTrue: [
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1205
                flags at: k put: 1.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1206
                k := k + prime
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1207
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1208
            aBlock value: prime
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1209
        ]
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1210
    ].
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1211
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1212
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1213
     Integer primesUpTo: 100
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  1214
     Integer primesUpTo:20000 do:[:p | ]
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1215
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1216
! !
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1217
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1218
!Integer class methodsFor:'queries'!
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1219
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1220
hasSharedInstances
25031
c29683170748 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 25010
diff changeset
  1221
    "return true if this class can share instances when stored binary, 
c29683170748 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 25010
diff changeset
  1222
     that is, instances with the same value can be stored by reference.
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1223
     Although not always shared (LargeIntegers), these should be treated
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1224
     so, to be independent of the number of bits in a SmallInt"
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1225
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1226
    ^ true
8892
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1227
!
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1228
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1229
isAbstract
11223
7536833995bb comment
Claus Gittinger <cg@exept.de>
parents: 11125
diff changeset
  1230
    "Return if this class is an abstract class.
7536833995bb comment
Claus Gittinger <cg@exept.de>
parents: 11125
diff changeset
  1231
     True is returned for Integer here; false for subclasses.
19455
848d2ecde887 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19433
diff changeset
  1232
     Abstract subclasses must redefine this again."
11223
7536833995bb comment
Claus Gittinger <cg@exept.de>
parents: 11125
diff changeset
  1233
8892
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1234
    ^ self == Integer
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1235
! !
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1236
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7173
diff changeset
  1237
!Integer methodsFor:'Compatibility-Dolphin'!
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1238
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1239
highWord
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1240
    "return the high 16 bits of a 32 bit value"
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1241
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1242
    ^ self bitShift:-16
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1243
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1244
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1245
     (16r12345678 highWord) hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1246
     (16r12345678 lowWord) hexPrintString
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1247
    "
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1248
!
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1250
lowWord
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1251
    "return the low 16 bits of a 32 bit value"
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1252
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1253
    ^ self bitAnd:16rFFFF
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1254
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1255
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1256
     (16r12345678 lowWord) hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1257
     (16r12345678 highWord) hexPrintString
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1258
    "
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1259
!
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1260
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1261
mask:integerMask set:aBoolean
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1262
    "Answer the result of setting/resetting the specified mask in the receiver."
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1263
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1264
    ^ aBoolean
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1265
            ifTrue:  [self bitOr:integerMask]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1266
            ifFalse: [self bitClear:integerMask]
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1267
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1268
    "turn on the 1-bit:
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1269
         |v|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1270
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1271
         v := 2r0100.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1272
         v mask:1 set:true
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1273
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1274
     turn off the 1-bit:
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1275
         |v|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1276
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1277
         v := 2r0101.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1278
         v mask:1 set:false
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1279
    "
6875
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1280
!
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1281
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1282
maskClear:aMaskInteger
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1283
    "return an integer with all bits cleared which are set in aMaskInteger.
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1284
     An alias for bitClear: for compatibility."
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1285
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1286
    ^ self bitClear:aMaskInteger
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1287
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1288
    "
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1289
     3 maskClear:1
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1290
    "
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1291
!
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1292
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1293
maskSet:aMaskInteger
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1294
    "return an integer with all bits set which are set in aMaskInteger.
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1295
     An alias for bitSet: for compatibility."
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1296
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1297
    ^ self bitOr:aMaskInteger
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1298
!
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1299
6875
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1300
printStringRadix:aRadix padTo:sz
11936
94784c846e12 comments
Claus Gittinger <cg@exept.de>
parents: 11896
diff changeset
  1301
    "return a printed representation of the receiver in a given radix,
15765
6edf4f55277d class: Integer
Claus Gittinger <cg@exept.de>
parents: 15578
diff changeset
  1302
     padded with zeros (at the left) up to size.
11936
94784c846e12 comments
Claus Gittinger <cg@exept.de>
parents: 11896
diff changeset
  1303
     If the printString is longer than size,
94784c846e12 comments
Claus Gittinger <cg@exept.de>
parents: 11896
diff changeset
  1304
     it is returned unchanged (i.e. not truncated).
94784c846e12 comments
Claus Gittinger <cg@exept.de>
parents: 11896
diff changeset
  1305
     See also printStringRadix:size:fill:"
94784c846e12 comments
Claus Gittinger <cg@exept.de>
parents: 11896
diff changeset
  1306
6875
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1307
    ^ self printStringRadix:aRadix size:sz fill:$0
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1308
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1309
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  1310
     1024 printStringRadix:16 padTo:4
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  1311
     16rABCD printStringRadix:16 padTo:3
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  1312
     1024 printStringRadix:2 padTo:16
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  1313
     1024 printStringRadix:16 padTo:8
6875
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1314
    "
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1315
!
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1316
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1317
| aNumber
11936
94784c846e12 comments
Claus Gittinger <cg@exept.de>
parents: 11896
diff changeset
  1318
    "return the bitwise-or of the receiver and the argument, anInteger.
14448
9de88d62d686 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 14404
diff changeset
  1319
     Same as bitOr: - added for compatibility with Dolphin Smalltalk.
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  1320
     Notice:
19093
c07a1b2d0e11 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 19089
diff changeset
  1321
        PLEASE DO NOT USE | for integers in new code; it makes the code harder
c07a1b2d0e11 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 19089
diff changeset
  1322
        to understand, as it may be not obvious, whether a boolean-or a bitWise-or is intended.
c07a1b2d0e11 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 19089
diff changeset
  1323
        For integers, use bitOr: to make the intention explicit.
19094
784b51cf4213 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19093
diff changeset
  1324
        Also, consider using or: for booleans, which is does not evaluate the right part if the left is true."
11936
94784c846e12 comments
Claus Gittinger <cg@exept.de>
parents: 11896
diff changeset
  1325
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1326
    ^ self bitOr:aNumber
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1327
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1328
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1329
     14 | 1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1330
     9 & 8
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1331
    "
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1332
! !
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1333
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7173
diff changeset
  1334
!Integer methodsFor:'Compatibility-Squeak'!
4867
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1335
24409
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1336
anyBitOfMagnitudeFrom:startBitIndex to:stopBitIndexArg 
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1337
    "Tests for any magnitude bits in the interval from start to stopArg."
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1338
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1339
    | magnitude firstDigitIx lastDigitIx rightShift leftShift stopBitIndex |
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1340
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1341
    "/ <primitive: 'primAnyBitFromTo' module:'LargeIntegers'>
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1342
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1343
    startBitIndex < 1 | (stopBitIndexArg < 1) ifTrue: [^ self error: 'out of range'].
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1344
    magnitude := self abs.
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1345
    stopBitIndex := stopBitIndexArg min: magnitude highBit.
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1346
    startBitIndex > stopBitIndex ifTrue: [^ false].
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1347
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1348
    firstDigitIx := (startBitIndex - 1) // 8 + 1.
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1349
    lastDigitIx := (stopBitIndex - 1) // 8 + 1.
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1350
    rightShift := ((startBitIndex - 1) \\ 8) negated.
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1351
    leftShift := 7 - ((stopBitIndex - 1) \\ 8).
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1352
    firstDigitIx = lastDigitIx ifTrue: [
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1353
        | digit mask | 
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1354
        mask := (255 bitShift: rightShift negated)
24607
1351d9ac78f9 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24456
diff changeset
  1355
                bitAnd: (255 bitShift: leftShift negated).
24409
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1356
        digit := magnitude digitAt: firstDigitIx.
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1357
        ^ (digit bitAnd: mask) ~= 0
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1358
    ].
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1359
    ((magnitude digitAt: firstDigitIx) bitShift: rightShift) ~= 0 ifTrue: [^ true].
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1360
    firstDigitIx + 1 to: lastDigitIx - 1 do: [:ix | 
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1361
        (magnitude digitAt: ix) ~= 0 ifTrue: [^ true]
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1362
    ].
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1363
    (((magnitude digitAt: lastDigitIx) bitShift: leftShift) bitAnd: 255) ~= 0 ifTrue: [^ true].
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1364
    ^ false
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1365
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1366
    "Created: / 27-05-2019 / 08:37:08 / Claus Gittinger"
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1367
!
358eb024b429 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24345
diff changeset
  1368
12122
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1369
asByteArray
15937
ff395b64b43a class: Integer
Claus Gittinger <cg@exept.de>
parents: 15911
diff changeset
  1370
    "return my hexBytes in MSB.
ff395b64b43a class: Integer
Claus Gittinger <cg@exept.de>
parents: 15911
diff changeset
  1371
     Do not use:
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1372
        This is a very stupid squeak-compatibility method,
21993
73aa16ebc889 #DOCUMENTATION by mawalch
mawalch
parents: 21938
diff changeset
  1373
        as normally, you'd expect the bytes to be ordered in the machine's native order"
12147
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1374
15567
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  1375
    ^ self digitBytesMSB
21993
73aa16ebc889 #DOCUMENTATION by mawalch
mawalch
parents: 21938
diff changeset
  1376
73aa16ebc889 #DOCUMENTATION by mawalch
mawalch
parents: 21938
diff changeset
  1377
    "Modified (comment): / 11-07-2017 / 16:13:03 / mawalch"
12122
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1378
!
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1379
12147
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1380
asByteArrayOfSize:size
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1381
    "return my hexBytes in MSB, optionally padded at the left with zeros"
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1382
12122
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1383
    "(((
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1384
        | repeats number |
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1385
        repeats := 1000000.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1386
        number := 123456789123456789123456789123456789123456789123456789.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1387
         [repeats timesRepeat: (number asByteArrayOfSize: 1024) ] timeToRun.
12122
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1388
     )))"
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1389
15567
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  1390
    | bytes bytesSize|
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  1391
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  1392
    bytes := self digitBytesMSB.
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  1393
    bytesSize := bytes size.
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  1394
    size < bytesSize ifTrue: [
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1395
        ^ ConversionError raiseRequestWith:self errorString:'number too big for ', size asString
14796
242490a39283 class: Integer
Stefan Vogel <sv@exept.de>
parents: 14767
diff changeset
  1396
    ].
15567
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  1397
    ^ (ByteArray new:size)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1398
            replaceFrom:size-bytesSize+1 to:size with:bytes startingAt:1.
12147
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1399
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1400
    "
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1401
     123 asByteArrayOfSize:1 #[123]
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1402
     123 asByteArrayOfSize:2 #[0 123]
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1403
     123 asByteArrayOfSize:4 #[0 0 0 123]
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1404
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1405
     255 asByteArrayOfSize:1 #[255]
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1406
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  1407
     256 asByteArrayOfSize:1
12147
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1408
     256 asByteArrayOfSize:2
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1409
     256 asByteArrayOfSize:4
22567
8c44c87bd949 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22561
diff changeset
  1410
     256 asByteArrayOfSize:8
12147
307dfa8e44c4 changed:
Claus Gittinger <cg@exept.de>
parents: 12122
diff changeset
  1411
    "
12122
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1412
!
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  1413
8573
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1414
atRandom:aRandomGenerator
15456
9535b5c74e85 class: Integer
Stefan Vogel <sv@exept.de>
parents: 15273
diff changeset
  1415
    "return a random number between 1 and myself"
8573
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1416
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1417
    self < 1 ifTrue:[^ self].
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1418
    ^ aRandomGenerator nextIntegerBetween:1 and:self
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1419
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1420
    "
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1421
     100 atRandom:(Random new)
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1422
     1000 atRandom:(Random new)
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1423
    "
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1424
!
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1425
22600
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1426
bitShiftMagnitude:shift
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1427
    ^ self bitShift:shift.
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1428
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1429
    "
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1430
     -1 bitShiftMagnitude:1
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1431
     -2 bitShift:-1
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1432
     -2 bitShift:-1
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1433
    "
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1434
!
ca4fea0b5b62 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22567
diff changeset
  1435
14385
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1436
printLeftPaddedWith:padChar to:size base:base
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1437
    "prints left-padded"
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1438
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1439
    ^ (self printStringRadix:base) leftPaddedTo:size with:padChar
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1440
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1441
    "
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  1442
     1234 printPaddedWith:$0 to:4 base:16
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  1443
     1234 printLeftPaddedWith:$0 to:4 base:16
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  1444
     128 printLeftPaddedWith:$0 to:2 base:16
14385
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1445
    "
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1446
!
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1447
11858
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1448
printPaddedWith:padChar to:size base:base
14385
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1449
    "attention: prints right-padded; see printLeftPadded."
1bb6b27c59f9 added: #printLeftPaddedWith:to:base:
Claus Gittinger <cg@exept.de>
parents: 14294
diff changeset
  1450
11858
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1451
    ^ (self printStringRadix:base) paddedTo:size with:padChar
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1452
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1453
    "
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1454
     1234 printPaddedWith:$0 to:4 base:16
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1455
    "
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1456
!
8baf5d75506e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11793
diff changeset
  1457
4376
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1458
printStringBase:base
4867
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1459
    "return my printString in a base;
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1460
     same as printStringRadix:"
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1461
4376
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1462
    ^ self printStringRadix:base
12284
a6e7b47c08c4 comment/format in: #printStringBase:
Claus Gittinger <cg@exept.de>
parents: 12280
diff changeset
  1463
a6e7b47c08c4 comment/format in: #printStringBase:
Claus Gittinger <cg@exept.de>
parents: 12280
diff changeset
  1464
    "
a6e7b47c08c4 comment/format in: #printStringBase:
Claus Gittinger <cg@exept.de>
parents: 12280
diff changeset
  1465
     1234 printStringBase:16
a6e7b47c08c4 comment/format in: #printStringBase:
Claus Gittinger <cg@exept.de>
parents: 12280
diff changeset
  1466
    "
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1467
!
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1468
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1469
printStringHex
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1470
    "return my printString in base 16;
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1471
     same as printStringRadix:"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1472
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1473
    ^ self printStringRadix:16
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1474
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1475
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1476
     4096 printStringHex
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1477
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1478
!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1479
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1480
printStringRoman
9069
e5ba0dc84a53 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9068
diff changeset
  1481
    "return my roman printString;
e5ba0dc84a53 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9068
diff changeset
  1482
     almost the same as romanPrintString:"
e5ba0dc84a53 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9068
diff changeset
  1483
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1484
    "funny - although the romans did not have negative numbers - squeak has"
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1485
    self negative ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1486
        ^ '-' , self negated romanPrintString
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1487
    ].
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1488
    ^ self romanPrintString
12280
b2bbbfd2444e added: #raisedTo:modulo:
Stefan Vogel <sv@exept.de>
parents: 12255
diff changeset
  1489
!
b2bbbfd2444e added: #raisedTo:modulo:
Stefan Vogel <sv@exept.de>
parents: 12255
diff changeset
  1490
b2bbbfd2444e added: #raisedTo:modulo:
Stefan Vogel <sv@exept.de>
parents: 12255
diff changeset
  1491
raisedTo:exp modulo:mod
b2bbbfd2444e added: #raisedTo:modulo:
Stefan Vogel <sv@exept.de>
parents: 12255
diff changeset
  1492
    ^ self raisedTo:exp mod:mod
4376
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1493
! !
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1494
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7173
diff changeset
  1495
!Integer methodsFor:'Compatibility-V''Age'!
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1496
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1497
<< aNumber
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  1498
    "V'Age compatibility: left shift"
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1499
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1500
    ^ self bitShift:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1501
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1502
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1503
     1 << 5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1504
     64 << -5
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1505
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1506
!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1507
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1508
>> aNumber
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  1509
    "V'Age compatibility: right shift"
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1510
22213
8b482a0c44a1 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22166
diff changeset
  1511
    ^ self rightShift:aNumber
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1512
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1513
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1514
     1 >> -5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1515
     64 >> 5
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1516
    "
22213
8b482a0c44a1 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22166
diff changeset
  1517
8b482a0c44a1 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22166
diff changeset
  1518
    "Modified: / 25-08-2017 / 12:32:47 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1519
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1520
25039
803a48c7a8c5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 25031
diff changeset
  1521
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1522
!Integer methodsFor:'bcd conversion'!
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1523
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1524
decodeFromBCD
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1525
    "return a number representing the value of the BCD encoded receiver."
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1526
4424
f0f658ed8995 bcd support
Claus Gittinger <cg@exept.de>
parents: 4423
diff changeset
  1527
    |v rslt multiplier nibble|
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1528
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1529
    v := self.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1530
    rslt := 0.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1531
    multiplier := 1.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1532
    [v > 0] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1533
        nibble := v bitAnd:16r0F.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1534
        nibble > 9 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1535
            ^ BCDConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1536
                    raiseRequestWith:self
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1537
                    errorString:'bad BCD coded value'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1538
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1539
        rslt := rslt + (nibble * multiplier).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1540
        multiplier := multiplier * 10.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1541
        v := v bitShift:-4.
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1542
    ].
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1543
    ^ rslt
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1544
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1545
    "
4949
4c0462bd4d6a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4921
diff changeset
  1546
     16r1234567890123 decodeFromBCD
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1547
     16r1073741823 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1548
     16r1073741824 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1549
     16r1073741825 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1550
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1551
     16r55 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1552
     16r127 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1553
     16r800000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1554
     16r8000000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1555
     16r80000000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1556
     16r800000000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1557
     16r127567890 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1558
     16r1234567890 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1559
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1560
     16r5A decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1561
     16rFF decodeFromBCD
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1562
    "
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1563
4996
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
  1564
    "Modified: / 15.11.1999 / 20:37:20 / cg"
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1565
!
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1566
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1567
encodeAsBCD
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1568
    "return a BCD encoded number representing the same value as the
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1569
     receiver."
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1570
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1571
    |v rslt shift|
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1572
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1573
    v := self.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1574
    rslt := shift := 0.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1575
    [v > 0] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1576
        rslt := rslt + ((v \\ 10) bitShift:shift).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1577
        shift := shift + 4.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1578
        v := v // 10.
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1579
    ].
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1580
    ^ rslt
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1581
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1582
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1583
     55 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1584
     127 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1585
     127 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1586
     8912345 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1587
     89123456 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1588
     891234567 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1589
     900000000 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1590
     1073741823 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1591
     1073741824 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1592
     1073741825 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1593
     1891234567 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1594
     8912345678 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1595
     1234567890 encodeAsBCD hexPrintString
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1596
    "
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1597
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1598
! !
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1599
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1600
!Integer methodsFor:'bit operators'!
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1601
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1602
allMask:aMaskInteger
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1603
    "return true if all 1-bits in aMaskInteger are also 1 in the receiver"
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1604
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1605
    ^ (self bitAnd:aMaskInteger) == aMaskInteger
4643
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1606
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1607
    "2r00001111 allMask:2r00000001"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1608
    "2r00001111 allMask:2r00011110"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1609
    "2r00001111 allMask:2r00000000"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1610
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1611
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1612
anyMask:aMaskInteger
4643
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1613
    "return true if any 1-bits in anInteger is also 1 in the receiver.
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1614
     (somewhat incorrect, if the mask is zero)"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1615
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1616
    ^ (self bitAnd:aMaskInteger) ~~ 0
4643
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1617
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1618
    "2r00001111 anyMask:2r00000001"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1619
    "2r00001111 anyMask:2r11110000"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1620
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1621
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1622
bitAnd:aMaskInteger
357
claus
parents: 356
diff changeset
  1623
    "return the bitwise-and of the receiver and the argument, anInteger.
claus
parents: 356
diff changeset
  1624
     This is a general and slow implementation, walking over the bytes of
claus
parents: 356
diff changeset
  1625
     the receiver and the argument."
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1626
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1627
    |n "{ Class: SmallInteger }"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1628
     result byte|
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1629
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1630
    aMaskInteger isInteger ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1631
        ^ aMaskInteger bitAndFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1632
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1633
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1634
    n := (aMaskInteger digitLength) min:(self digitLength).
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1635
    result := self class basicNew numberOfDigits:n.
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1636
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1637
    1 to:n do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1638
        byte := (aMaskInteger digitAt:index) bitAnd:(self digitAt:index).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1639
        result digitAt:index put:byte.
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1640
    ].
3162
c7c8af356ff2 dont hardcode the numberof bytes (use maxBytes for alpha);
Claus Gittinger <cg@exept.de>
parents: 3138
diff changeset
  1641
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1642
        ^ result compressed
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1643
    ].
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1644
    ^ result
357
claus
parents: 356
diff changeset
  1645
claus
parents: 356
diff changeset
  1646
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1647
     (16r112233445566778899 bitAnd:16rFF                ) printStringRadix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1648
     (16r112233445566778899 bitAnd:16rFFFFFFFFFFFFFFFF00) printStringRadix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1649
     (16r112233445566778899 bitAnd:16rFF0000000000000000) printStringRadix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1650
     (16r112233445566778899 bitAnd:16r00000000000000FFFF) printStringRadix:16
357
claus
parents: 356
diff changeset
  1651
    "
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  1652
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  1653
    "Modified: 5.11.1996 / 14:06:26 / cg"
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1654
!
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1655
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1656
bitClear:aMaskInteger
19071
2941ec17cf5d #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19068
diff changeset
  1657
    "return the bitwise-and of the receiver and the complement of the argument, anInteger,
16379
04f35b0875dc class: Integer
Claus Gittinger <cg@exept.de>
parents: 16347
diff changeset
  1658
     returning the receiver with bits of the argument cleared.
19071
2941ec17cf5d #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19068
diff changeset
  1659
     (i.e. the same as self bitAnd:aMaskInteger bitInvert).
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1660
     This is a general and slow implementation, walking over the bytes of
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1661
     the receiver and the argument."
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1662
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1663
    |n "{ Class: SmallInteger }"
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1664
     result byte|
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  1665
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1666
    n := (aMaskInteger digitLength) max:(self digitLength).
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1667
    result := self class basicNew numberOfDigits:n.
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1668
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1669
    1 to:n do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1670
        byte :=  (self digitAt:index) bitClear:(aMaskInteger digitAt:index).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1671
        result digitAt:index put:byte.
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1672
    ].
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1673
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1674
        ^ result compressed
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1675
    ].
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1676
    ^ result
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  1677
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  1678
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1679
bitCount
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1680
    "return the number of 1-bits in the receiver"
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1681
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1682
    |n "{ Class: SmallInteger }"
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1683
     cnt byte|
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1684
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1685
    n := self digitLength.
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1686
    cnt := 0.
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1687
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1688
    1 to:n do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1689
        byte := self digitAt:index.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1690
        cnt := cnt + (byte bitCount)
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1691
    ].
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1692
    ^ cnt
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1693
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1694
     "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1695
      2r100000000000000000000000000000000000000000000000000000000001 bitCount
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1696
      2r111111111111111111111111111111111111111111111111111111111111111111 bitCount
13914
725916ddad3f comment/format
Claus Gittinger <cg@exept.de>
parents: 13907
diff changeset
  1697
      100 factorial bitCount -> 207
725916ddad3f comment/format
Claus Gittinger <cg@exept.de>
parents: 13907
diff changeset
  1698
      1000 factorial bitCount -> 3788
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1699
     "
13914
725916ddad3f comment/format
Claus Gittinger <cg@exept.de>
parents: 13907
diff changeset
  1700
725916ddad3f comment/format
Claus Gittinger <cg@exept.de>
parents: 13907
diff changeset
  1701
    "Modified (comment): / 09-01-2012 / 19:51:00 / cg"
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1702
!
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1703
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1704
bitDeinterleave:n
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1705
    "extract count integers from an n-way Morton number as a vector;
22222
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1706
     This is the inverse operation from bitInterleave: - see comment there.
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1707
     i.e. if count is 3,
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1708
     and the receiver's bits are
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1709
        cN bN aN ... c2 b2 a2 c1 b1 a1 c0 b0 a0
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1710
     then the result will be a vector containing the numbers a,b,c with bits:
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1711
        aN ... a2 a1 a0
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1712
        bN ... b2 b1 b0 
22222
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1713
        cN ... c2 c1 c0."
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1714
     
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1715
    |v shift tuple|
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1716
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1717
    tuple := Array new:n withAll:0.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1718
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1719
    shift := 0.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1720
    v := self.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1721
    [ v > 0 ] whileTrue:[
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1722
        1 to:n do:[:i |
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1723
            tuple at:i put:((tuple at:i) bitOr:((v bitAnd:1) bitShift:shift)).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1724
            v := v rightShift:1.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1725
        ].
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1726
        shift := shift + 1.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1727
    ].
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1728
    ^ tuple
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1729
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1730
    "
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1731
     (2r1100 bitInterleaveWith:2r1001) -> 2r11100001
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1732
     (2r11000110 bitInterleaveWith:2r10011100 and:2r10100101) -> 2r111100001010010111100001.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1733
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1734
     2r11100001 bitDeinterleave:2
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1735
     
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1736
     (2r11000110 bitInterleaveWith:2r10011100 and:2r10100101) 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1737
     (198 bitInterleaveWith:156 and:165) bitDeinterleave:3
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1738
    "
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1739
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1740
    "Created: / 28-08-2017 / 15:02:31 / cg"
22222
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1741
    "Modified (comment): / 28-08-2017 / 18:45:21 / cg"
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1742
!
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1743
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1744
bitInterleaveWith:anInteger
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1745
    "generate a Morton number (-> https://en.wikipedia.org/wiki/Morton_number_(number_theory)) 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1746
     by interleaving bits of the receiver (at odd positions if counting from 1) 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1747
     with bits of the argument (at even bit positions).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1748
     
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1749
     Thus, if the bits of the receiver are
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1750
        aN ... a2 a1 a0
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1751
     and those of the argument are:
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1752
        bN ... b2 b1 b0
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1753
     the result is
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1754
        bN aN ... b2 a2 b1 a1 b0 a0.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1755
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1756
     Morton numbers are great to linearize 2D coordinates
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1757
     eg. to sort 2D points by distances"    
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1758
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1759
    "/ a naive and slow fallback here, using a small map to process cunks of 4 bits
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1760
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1761
    |a b shift ma mb val|
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1762
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1763
    a := self.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1764
    b := anInteger.
24456
dbb8e0957b31 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 24409
diff changeset
  1765
    self assert:(a >= 0).
dbb8e0957b31 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 24409
diff changeset
  1766
    self assert:(b >= 0).
dbb8e0957b31 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 24409
diff changeset
  1767
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1768
    val := 0.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1769
    shift := 0.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1770
    [ (a == 0) and:[b == 0]] whileFalse:[
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1771
        "/ strip off 4 bits from each...
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1772
        "/ 0000       0001       0010       0011       0100       0101       0110       0111       1000       1001       1010       1011       1100       1101       1110       1111 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1773
        mb := #[ 2r00000000 2r00000010 2r00001000 2r00001010 2r00100000 2r00100010 2r00101000 2r00101010 2r10000000 2r10000010 2r10001000 2r10001010 2r10100000 2r10100010 2r10101000 2r10101010 ] 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1774
                at:((b bitAnd:2r1111)+1).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1775
        ma := #[ 2r00000000 2r00000001 2r00000100 2r00000101 2r00010000 2r00010001 2r00010100 2r00010101 2r01000000 2r01000001 2r01000100 2r01000101 2r01010000 2r01010001 2r01010100 2r01010101 ]
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1776
                at:((a bitAnd:2r1111)+1).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1777
        val := val bitOr:((ma bitOr:mb) bitShift:shift).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1778
        shift := shift + 8.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1779
        a := a rightShift:4.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1780
        b := b rightShift:4.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1781
    ].
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1782
    ^ val.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1783
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1784
    "
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1785
     (2r11000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1786
     bitInterleaveWith:2r10010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000) 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1787
        -> 2r1101001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1788
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1789
     (2r11000101000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1790
     bitInterleaveWith:2r10010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000) 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1791
        -> 2r1101001000010001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1792
    "
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1793
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1794
    "Created: / 28-08-2017 / 14:33:08 / cg"
22222
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1795
    "Modified: / 28-08-2017 / 19:19:31 / cg"
24456
dbb8e0957b31 #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 24409
diff changeset
  1796
    "Modified: / 22-07-2019 / 19:43:04 / Claus Gittinger"
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1797
!
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1798
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1799
bitInterleaveWith:integer1 and:integer2
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1800
    "generate a Morton3 number (-> https://en.wikipedia.org/wiki/Morton_number_(number_theory)) 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1801
     by interleaving bits of the receiver with bits of the arguments.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1802
     Thus, if the bits of the receiver are
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1803
        aN ... a2 a1 a0
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1804
     and those of the integer1 are:
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1805
        bN ... b2 b1 b0
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1806
     and those of the integer2 are:
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1807
        cN ... c2 c1 c0
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1808
     the result is
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1809
        cN bN aN ... c2 b2 a2 c1 b1 a1 c0 b0 a0.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1810
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1811
     Morton3 numbers are great to linearize 3D coordinates
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1812
     eg. to sort 3D points by distances"    
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1813
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1814
    |a b c shift ma mb mc val|
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1815
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1816
    a := self.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1817
    b := integer1.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1818
    c := integer2.
22469
6058c02151eb #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22460
diff changeset
  1819
    self assert:(a >= 0).
6058c02151eb #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22460
diff changeset
  1820
    self assert:(b >= 0).
6058c02151eb #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22460
diff changeset
  1821
    self assert:(c >= 0).
6058c02151eb #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22460
diff changeset
  1822
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1823
    val := 0.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1824
    shift := 0.
22469
6058c02151eb #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22460
diff changeset
  1825
    [ a ~~ 0 or:[b ~~ 0 or:[c ~~ 0]] ] whileTrue:[
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1826
        "/ strip off 4 bits from each...
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1827
        "/ 0000       0001       0010       0011       0100       0101       0110       0111       1000       1001       1010       1011       1100       1101       1110       1111 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1828
        mc := #( 2r000000000000 2r000000000100 2r000000100000 2r000000100100 2r000100000000 2r000100000100 2r000100100000 2r000100100100 2r100000000000 2r100000000100 2r100000100000 2r100000100100 2r100100000000 2r100100000100 2r100100100000 2r100100100100 ) 
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1829
                at:((c bitAnd:2r1111)+1).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1830
        mb := #( 2r000000000000 2r000000000010 2r000000010000 2r000000010010 2r000010000000 2r000010000010 2r000010010000 2r000010010010 2r010000000000 2r010000000010 2r010000010000 2r010000010010 2r010010000000 2r010010000010 2r010010010000 2r010010010010 )
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1831
                at:((b bitAnd:2r1111)+1).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1832
        ma := #( 2r000000000000 2r000000000001 2r000000001000 2r000000001001 2r000001000000 2r000001000001 2r000001001000 2r000001001001 2r001000000000 2r001000000001 2r001000001000 2r001000001001 2r001001000000 2r001001000001 2r001001001000 2r001001001001 )
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1833
                at:((a bitAnd:2r1111)+1).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1834
        val := val bitOr:(((ma bitOr:mb) bitOr:mc) bitShift:shift).
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1835
        shift := shift + 12.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1836
        a := a rightShift:4.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1837
        b := b rightShift:4.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1838
        c := c rightShift:4.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1839
    ].
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1840
    ^ val.
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1841
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1842
    "
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1843
     (2r1100 bitInterleaveWith:2r1001 and:2r1010) printStringRadix:2 -> '111 001 100 010'
22222
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1844
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1845
     (2r11000110 bitInterleaveWith:2r10011100 and:2r10100101) printStringRadix:2 -> '111 001 100 010 010 111 001 100'
22222
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1846
     (1 bitInterleaveWith:1 and:16)
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1847
     
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1848
     ((1<<31) bitInterleaveWith:(1<<31) and:(1<<31)) bitDeinterleave:3
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1849
     ((1<<31) bitInterleaveWith:(1<<63) and:(1<<95)) bitDeinterleave:3
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1850
    "
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1851
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1852
    "Created: / 28-08-2017 / 14:33:04 / cg"
22222
d58f6ee4f7fc #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22219
diff changeset
  1853
    "Modified: / 28-08-2017 / 19:19:25 / cg"
22469
6058c02151eb #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 22460
diff changeset
  1854
    "Modified: / 19-01-2018 / 11:29:04 / stefan"
22219
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1855
!
3dadc5038ad8 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22213
diff changeset
  1856
3455
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1857
bitInvert
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1858
    "return a new integer, where all bits are complemented.
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1859
     This does not really make sense for negative largeIntegers,
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  1860
     since the digits are stored as absolute value.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  1861
     Q: is this specified in a language standard ?"
3455
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1862
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1863
"/    ^ -1 - self
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1864
15841
7c222b07168f class: Integer
Stefan Vogel <sv@exept.de>
parents: 15775
diff changeset
  1865
    |n      "{ Class: SmallInteger }"
7c222b07168f class: Integer
Stefan Vogel <sv@exept.de>
parents: 15775
diff changeset
  1866
     byte   "{ Class: SmallInteger }"
7c222b07168f class: Integer
Stefan Vogel <sv@exept.de>
parents: 15775
diff changeset
  1867
     result|
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1868
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1869
    n := self digitLength.
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1870
    result := self class basicNew numberOfDigits:n.
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1871
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1872
    1 to:n do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1873
        byte := self digitAt:index.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1874
        byte := byte bitInvert bitAnd:16rFF.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1875
        result digitAt:index put:byte.
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1876
    ].
15841
7c222b07168f class: Integer
Stefan Vogel <sv@exept.de>
parents: 15775
diff changeset
  1877
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1878
        "if last byte is zero we can normalize"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1879
        ^ result compressed
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1880
    ].
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1881
    ^ result
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1882
19068
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1883
    "
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1884
     16rff bitInvert bitAnd:16rff
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1885
     16rffffffff bitInvert
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1886
     16rff00ff00 bitInvert hexPrintString
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1887
    "
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1888
!
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1889
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1890
bitInvertByte
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1891
    "return a new integer, where the low 8 bits are masked and complemented.
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1892
     This returns an unsigned version of what bitInvert would return.
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1893
     (i.e. same as self bitInvert bitAnd:16rFF)"
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1894
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1895
    ^ (self digitAt:1) bitInvert bitAnd:16rFF
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1896
    
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1897
    "
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1898
     16rff bitInvert
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1899
     16rff bitInvertByte
67c57cd1b6fc #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19067
diff changeset
  1900
    "
3455
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1901
!
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1902
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1903
bitOr:aMaskInteger
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1904
    "return the bitwise-or of the receiver and the argument, anInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1905
     This is a general and slow implementation, walking over the bytes of
23118
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  1906
     the receiver and the argument.
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  1907
     It is redefined in concrete subclasses (especially SmallInteger) for performance."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1908
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1909
    |n "{ Class: SmallInteger }"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1910
     result byte|
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1911
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1912
    aMaskInteger isInteger ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1913
        ^ aMaskInteger bitOrFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1914
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1915
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  1916
    n := (aMaskInteger digitLength) max:(self digitLength).
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1917
    result := self class basicNew numberOfDigits:n.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1918
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1919
    1 to:n do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1920
        byte := (aMaskInteger digitAt:index) bitOr:(self digitAt:index).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  1921
        result digitAt:index put:byte.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1922
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1923
"/ no need to normalize - if the operands were correct
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1924
"/    byte == 0 ifTrue:[
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1925
"/        ^ result compressed
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1926
"/    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1927
    ^ result
23118
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  1928
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1929
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1930
        16rFFFFFFFFFFFFFFFFFFFF0 bitOr:1.0
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1931
        16rFFFFFFFFFFFFFFFFFFFF0 bitOr:1.0s1
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1932
        16rFFFFFFFFFFFFFFFFFFFF0 bitOr:1.1
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1933
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1934
23118
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  1935
    "Modified (comment): / 20-06-2018 / 14:47:43 / Claus Gittinger"
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1936
    "Modified (comment): / 01-11-2018 / 12:10:27 / Stefan Vogel"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1937
!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1938
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1939
bitReversed
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1940
    "swap (i.e. reverse) bits in an integer
23994
e4e3b75162ad #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23992
diff changeset
  1941
     i.e. a.b.c.d....x.y.z -> z.y.x...b.a.d.c.
e4e3b75162ad #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23992
diff changeset
  1942
     Warning: 
e4e3b75162ad #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23992
diff changeset
  1943
        do not use this without care: it depends on the machine's 
e4e3b75162ad #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23992
diff changeset
  1944
        word size; i.e. a 64bit machine will return a different result as a 32bit machine.
e4e3b75162ad #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23992
diff changeset
  1945
        Better use one of the bitReversedXX methods.
e4e3b75162ad #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23992
diff changeset
  1946
        This my vanish or be replaced by something better"
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1947
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1948
    |n "{ Class: SmallInteger }"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1949
     result byte|
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1950
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1951
    n := self digitLength.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1952
    result := self class basicNew numberOfDigits:n.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1953
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1954
    1 to:n do:[:index |
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1955
        byte := (self digitAt:index) bitReversed8.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1956
        result digitAt:n+1-index put:byte.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1957
    ].
23992
3dc2d660853d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23980
diff changeset
  1958
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1959
        ^ result compressed
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1960
    ].
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1961
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1962
    ^ result
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1963
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1964
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1965
     2r1001 asLargeInteger bitReversed printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1966
     2r10011101 asLargeInteger bitReversed printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1967
     2r111110011101 asLargeInteger bitReversed printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1968
     2r11111001110100000000000000000000000000000000000000000001  bitReversed printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1969
     -1 asLargeInteger bitReversed printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1970
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1971
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1972
    "Created: / 01-11-2018 / 11:22:42 / Stefan Vogel"
23994
e4e3b75162ad #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23992
diff changeset
  1973
    "Modified (comment): / 27-03-2019 / 18:28:42 / Claus Gittinger"
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1974
!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1975
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1976
bitReversed16
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1977
    "swap (i.e. reverse) the low 16 bits in an integer
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  1978
     the high bits are ignored and cleared in the result
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1979
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1980
23999
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1981
    |rslt|
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1982
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1983
    rslt := (self digitAt:2) bitReversed8.
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1984
    rslt := rslt bitOr:((self digitAt:1) bitReversed8 bitShift:8).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1985
    ^ rslt.
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1986
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1987
    "
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1988
     16r8000 bitReversed16  
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1989
     16r87654321 bitReversed16 printStringRadix:2
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  1990
     16rFEDCBA987654321 bitReversed16 printStringRadix:2
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1991
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1992
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1993
    "Created: / 01-11-2018 / 11:34:51 / Stefan Vogel"
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  1994
    "Modified (comment): / 27-03-2019 / 15:14:45 / stefan"
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1995
!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1996
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1997
bitReversed32
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  1998
    "swap (i.e. reverse) the low 32 bits in an integer
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  1999
     the high bits are ignored and cleared in the result
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2000
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2001
23999
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2002
    |rslt|
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2003
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2004
    rslt := (self digitAt:4) bitReversed8.
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2005
    rslt := rslt bitOr:((self digitAt:3) bitReversed8 bitShift:8).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2006
    rslt := rslt bitOr:((self digitAt:2) bitReversed8 bitShift:16).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2007
    rslt := rslt bitOr:((self digitAt:1) bitReversed8 bitShift:24).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2008
    ^ rslt.
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2009
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2010
    "
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2011
     16r80000000 bitReversed32
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2012
     2r11111001110100000000000000000000000000000000000000000001  bitReversed32 printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2013
     -1 asLargeInteger bitReversed32 printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2014
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2015
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2016
    "Created: / 01-11-2018 / 11:35:54 / Stefan Vogel"
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  2017
    "Modified (comment): / 27-03-2019 / 15:14:39 / stefan"
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2018
!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2019
23992
3dc2d660853d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23980
diff changeset
  2020
bitReversed64
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  2021
    "swap (i.e. reverse) the low 64 bits in an integer
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  2022
     the high bits are ignored and cleared in the result
23992
3dc2d660853d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23980
diff changeset
  2023
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
3dc2d660853d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23980
diff changeset
  2024
23999
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2025
    |rslt|
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2026
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2027
    rslt := (self digitAt:8) bitReversed8.
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2028
    rslt := rslt bitOr:((self digitAt:7) bitReversed8 bitShift:8).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2029
    rslt := rslt bitOr:((self digitAt:6) bitReversed8 bitShift:16).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2030
    rslt := rslt bitOr:((self digitAt:5) bitReversed8 bitShift:24).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2031
    rslt := rslt bitOr:((self digitAt:4) bitReversed8 bitShift:32).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2032
    rslt := rslt bitOr:((self digitAt:3) bitReversed8 bitShift:40).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2033
    rslt := rslt bitOr:((self digitAt:2) bitReversed8 bitShift:48).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2034
    rslt := rslt bitOr:((self digitAt:1) bitReversed8 bitShift:56).
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2035
    ^ rslt.
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2036
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2037
    "
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2038
     16r80000000 bitReversed32
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2039
     16r80000000 bitReversed64
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2040
     16r8000000000000000 bitReversed64
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2041
     2r11111001110100000000000000000000000000000000000000000001  bitReversed32 printStringRadix:2
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2042
     -1 asLargeInteger bitReversed32 printStringRadix:2
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2043
    "
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2044
ced7327500f6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23994
diff changeset
  2045
    "Created: / 01-11-2018 / 11:35:54 / Stefan Vogel"
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  2046
    "Modified (comment): / 27-03-2019 / 15:14:33 / stefan"
23992
3dc2d660853d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23980
diff changeset
  2047
!
3dc2d660853d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23980
diff changeset
  2048
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2049
bitReversed8
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2050
    "swap (i.e. reverse) the low 8 bits in an integer
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  2051
     the high bits are ignored and cleared in the result
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2052
     i.e. xxx.a.b.c.d....x.y.z -> 000.z.y.x...b.a.d.c."
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2053
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2054
    ^ (self digitAt:1) bitReversed8.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2055
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2056
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2057
     2r1001 asLargeInteger bitReversed8 printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2058
     2r10011101 asLargeInteger bitReversed8 printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2059
     2r111110011101 asLargeInteger bitReversed8 printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2060
     2r11111001110100000000000000000000000000000000000000000001  bitReversed8 printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2061
     -1 asLargeInteger bitReversed8 printStringRadix:2
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2062
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2063
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  2064
    "Created: / 01-11-2018 / 11:32:58 / Stefan Vogel"
24005
813a3a6e3af4 #DOCUMENTATION by stefan
Stefan Vogel <sv@exept.de>
parents: 23999
diff changeset
  2065
    "Modified (comment): / 27-03-2019 / 15:14:54 / stefan"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2066
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2067
85
claus
parents: 77
diff changeset
  2068
bitShift:shiftCount
claus
parents: 77
diff changeset
  2069
    "return the value of the receiver shifted by shiftCount bits;
claus
parents: 77
diff changeset
  2070
     leftShift if shiftCount > 0; rightShift otherwise.
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2071
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2072
     Notice: the result of bitShift: on negative receivers is not
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2073
             defined in the language standard (since the implementation
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2074
             is free to choose any internal representation for integers)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2075
             However, ST/X preserves the sign."
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2076
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2077
    |result
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2078
     prev       "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2079
     next       "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2080
     byte       "{ Class: SmallInteger }"
359
claus
parents: 357
diff changeset
  2081
     byte2      "{ Class: SmallInteger }"
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2082
     bitShift   "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2083
     revShift   "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2084
     digitShift "{ Class: SmallInteger }"
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
  2085
     nn         "{ Class: SmallInteger }"
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
  2086
     nDigits    "{ Class: SmallInteger }" |
85
claus
parents: 77
diff changeset
  2087
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  2088
    shiftCount isInteger ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2089
        ^ shiftCount bitShiftFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  2090
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  2091
85
claus
parents: 77
diff changeset
  2092
    shiftCount > 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2093
        "left shift"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2094
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2095
        nDigits := self digitLength.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2096
        digitShift := shiftCount // 8.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2097
        bitShift := shiftCount \\ 8.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2098
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2099
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2100
         modulo 8 shifts can be done faster ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2101
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2102
        bitShift == 0 ifTrue:[
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2103
            nn := nDigits + digitShift.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2104
            result := self class basicNew numberOfDigits:nn sign:self sign.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2105
            result digitBytes replaceFrom:(digitShift + 1) to:nn with:self digitBytes.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2106
            "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2107
             no normalize needed, since receiver was already normalized
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2108
            "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2109
            ^ result
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2110
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2111
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2112
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2113
         less-than-8 shifts can be done faster ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2114
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2115
        digitShift == 0 ifTrue:[
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2116
            nn := nDigits+1.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2117
            result := self class basicNew numberOfDigits:nn sign:self sign.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2118
            prev := 0.
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2119
            1 to:nDigits do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2120
                byte := self digitAt:index.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2121
                byte := (byte bitShift:bitShift) bitOr:prev.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2122
                result digitAt:index put:(byte bitAnd:16rFF).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2123
                prev := byte bitShift:-8.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2124
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2125
            result digitAt:nn put:prev.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2126
            "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2127
             might have stored a 0-byte ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2128
            "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2129
            prev == 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2130
                ^ result compressed
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2131
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2132
            ^ result.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2133
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2134
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2135
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2136
         slow case ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2137
        "
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2138
        nn := nDigits + digitShift + 1.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2139
        result := self class basicNew numberOfDigits:nn sign:self sign.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2140
        byte := self digitAt:1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2141
        byte := (byte bitShift:bitShift) bitAnd:16rFF.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2142
        result digitAt:(digitShift + 1) put:byte.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2143
        revShift := -8 + bitShift.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2144
        2 to:nDigits do:[:index |
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2145
            byte := self digitAt:index.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2146
            byte2 := self digitAt:index-1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2147
            byte := byte bitShift:bitShift.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2148
            byte2 := byte2 bitShift:revShift.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2149
            byte := (byte bitOr:byte2) bitAnd:16rFF.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2150
            result digitAt:(index + digitShift) put:byte.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2151
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2152
        byte2 := self digitAt:nDigits.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2153
        byte2 := (byte2 bitShift:revShift) bitAnd:16rFF.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2154
        result digitAt:(nDigits + digitShift + 1) put:byte2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2155
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2156
         might have stored a 0-byte ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2157
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2158
        byte2 == 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2159
            ^ result compressed
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2160
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2161
        ^ result
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2162
    ].
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2163
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2164
    shiftCount < 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2165
        "right shift"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2166
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2167
        nDigits := self digitLength.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2168
        digitShift := shiftCount negated // 8.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2169
        bitShift := shiftCount negated \\ 8.
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2170
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2171
        digitShift >= nDigits ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2172
            ^ 0
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2173
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2174
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2175
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2176
         modulo 8 shifts can be done faster ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2177
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2178
        bitShift == 0 ifTrue:[
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2179
            nn := nDigits-digitShift.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2180
            result := self class basicNew numberOfDigits:nn sign:self sign.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2181
            result digitBytes replaceFrom:1 to:nn with:self digitBytes startingAt:(digitShift + 1) .
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2182
            nn <= SmallInteger maxBytes ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2183
                ^ result compressed
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2184
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2185
            ^ result
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2186
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2187
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2188
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2189
         less-than-8 shifts can be done faster ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2190
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2191
        digitShift == 0 ifTrue:[
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2192
            result := self class basicNew numberOfDigits:nDigits sign:self sign.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2193
            prev := 0.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2194
            bitShift := bitShift negated.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2195
            revShift := 8 + bitShift.
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2196
            nDigits to:1 by:-1 do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2197
                byte := self digitAt:index.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2198
                next := (byte bitShift:revShift) bitAnd:16rFF.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2199
                byte := (byte bitShift:bitShift) bitOr:prev.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2200
                result digitAt:index put:(byte bitAnd:16rFF).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2201
                prev := next.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2202
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2203
            ^ result compressed
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2204
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2205
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2206
        "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2207
         slow case ...
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2208
        "
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2209
        nn := nDigits-digitShift.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2210
        result := self class basicNew numberOfDigits:nn sign:self sign.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2211
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2212
        prev := 0.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2213
        bitShift := bitShift negated.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2214
        revShift := 8 + bitShift.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2215
        nn := digitShift + 1.
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  2216
        nDigits to:nn by:-1 do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2217
            byte := self digitAt:index.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2218
            next := (byte bitShift:revShift) bitAnd:16rFF.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2219
            byte := (byte bitShift:bitShift) bitOr:prev.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2220
            result digitAt:(index - digitShift) put:byte.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2221
            prev := next.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2222
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2223
        "the last stored byte ..."
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2224
        ^ result compressed
85
claus
parents: 77
diff changeset
  2225
    ].
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2226
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  2227
    ^ self "no shift"
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  2228
3638
edf314b220d2 fixed #bitShift: (right)
Claus Gittinger <cg@exept.de>
parents: 3455
diff changeset
  2229
    "Modified: / 8.7.1998 / 12:45:24 / cg"
4151
6d6971c27567 Some speedups.
Stefan Vogel <sv@exept.de>
parents: 4142
diff changeset
  2230
    "Modified: / 5.5.1999 / 16:05:05 / stefan"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2231
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2232
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2233
bitTest:aMaskInteger
5782
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  2234
    "return true, if any bit from aMask is set in the receiver.
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  2235
     I.e. true, if the bitwise-AND of the receiver and the argument, anInteger
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2236
     is non-0, false otherwise.
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2237
     This is a general and slow implementation, walking over the bytes of
23118
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2238
     the receiver and the argument. 
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2239
     It is redefined in concrete subclasses (especially SmallInteger) for performance."
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2240
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2241
    |n "{ Class: SmallInteger }"
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2242
     byte|
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2243
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2244
    n := (aMaskInteger digitLength) min:(self digitLength).
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2245
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2246
    1 to:n do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2247
        byte := (aMaskInteger digitAt:index) bitAnd:(self digitAt:index).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2248
        byte ~~ 0 ifTrue:[^ true].
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2249
    ].
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2250
    ^ false
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2251
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2252
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2253
     16r112233445566778899 bitTest:16rFF
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2254
     16r112233445566778800 bitTest:16rFF
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2255
     16r112233445566778899 bitTest:16rFFFFFFFFFFFFFFFF00
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2256
     16r112233445566778899 bitTest:16rFF0000000000000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2257
     16r112233445566778899 bitTest:16r00000000000000FFFF
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2258
     16r1234567800000000 bitTest:16r8000000000000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2259
     16r8765432100000000 bitTest:16r8000000000000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2260
     16r12345678 bitTest:16r80000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2261
     16r87654321 bitTest:16r80000000
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2262
    "
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2263
23118
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2264
    "Modified: / 06-06-1999 / 15:10:33 / cg"
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2265
    "Modified (comment): / 20-06-2018 / 14:47:28 / Claus Gittinger"
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2266
!
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  2267
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2268
bitXor:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2269
    "return the bitwise-or of the receiver and the argument, anInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2270
     This is a general and slow implementation, walking over the bytes of
23118
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2271
     the receiver and the argument.
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2272
     It is redefined in concrete subclasses (especially SmallInteger) for performance."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2273
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2274
    |n "{ Class: SmallInteger }"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2275
     result byte|
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2276
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  2277
    anInteger isInteger ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2278
        ^ anInteger bitXorFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  2279
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  2280
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2281
    n := (anInteger digitLength) max:(self digitLength).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2282
    result := self class basicNew numberOfDigits:n.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2283
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2284
    1 to:n do:[:index |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2285
        byte := (anInteger digitAt:index) bitXor:(self digitAt:index).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2286
        result digitAt:index put:byte.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2287
    ].
3993
a5a09b2d36cd oops - bitXor: did not always compress the result.
Claus Gittinger <cg@exept.de>
parents: 3908
diff changeset
  2288
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2289
        ^ result compressed
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2290
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2291
    ^ result
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2292
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2293
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2294
     (16r112233445566778899 bitXor:16rFF                ) printStringRadix:16 '112233445566778866'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2295
     (16r112233445566778899 bitXor:16rFFFFFFFFFFFFFFFF00) printStringRadix:16 'EEDDCCBBAA99887799'
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2296
     (16r112233445566778899 bitXor:16rFF0000000000000000) printStringRadix:16 'EE2233445566778899'
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2297
     (16r112233445566778899 bitXor:16r112233445566778800) printStringRadix:16
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2298
    "
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  2299
23118
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2300
    "Modified: / 05-11-1996 / 14:06:40 / cg"
0c79d2fbcf16 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23055
diff changeset
  2301
    "Modified (comment): / 20-06-2018 / 14:47:55 / Claus Gittinger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2302
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2303
12670
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2304
changeMask:mask to:aBooleanOrNumber
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2305
    "return a new number where the specified mask-bit is on or off,
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2306
     depending on aBooleanOrNumber.
14404
49a54ea47bf8 comment/format in:5 methods
Claus Gittinger <cg@exept.de>
parents: 14403
diff changeset
  2307
     The method's name may be misleading: the receiver is not changed,
12670
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2308
     but a new number is returned. Should be named #withMask:changedTo:"
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2309
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2310
    (aBooleanOrNumber == 0 or:[aBooleanOrNumber == false]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2311
        ^ self bitClear:mask
12670
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2312
    ].
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2313
    ^ self bitOr:mask
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2314
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2315
    "
24881
48b9b3547666 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24868
diff changeset
  2316
     (16r3fffffff changeMask:16r80 to:0) hexPrintString     -> '3FFFFF7F'
48b9b3547666 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24868
diff changeset
  2317
     (16r3fff0000 changeMask:16r80 to:1) hexPrintString     -> '3FFF0080'
48b9b3547666 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24868
diff changeset
  2318
     (16r3fffffFF changeMask:16rFF to:0) hexPrintString     -> '3FFFFF00'
48b9b3547666 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24868
diff changeset
  2319
     (16r3fff0000 changeMask:16rFF to:1) hexPrintString     -> '3FFF00FF'
48b9b3547666 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24868
diff changeset
  2320
     (16r3fffffFF changeMask:16rFF to:false) hexPrintString -> '3FFFFF00'  
48b9b3547666 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24868
diff changeset
  2321
     (16r3fff0000 changeMask:16rFF to:true) hexPrintString  -> '3FFF00FF' 
12670
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2322
    "
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2323
!
0e449ea30526 added: #changeMask:to:
Claus Gittinger <cg@exept.de>
parents: 12652
diff changeset
  2324
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2325
even
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2326
    "return true if the receiver is even"
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2327
9401
65f884297c68 speed up #even and #odd
Stefan Vogel <sv@exept.de>
parents: 9316
diff changeset
  2328
    ^ (self bitAt:1) == 0
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2329
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2330
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2331
     16r112233445566778899 even
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2332
     16r112233445566778800 even
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2333
     1 even
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2334
     2 even
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2335
    "
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2336
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2337
    "Created: / 6.6.1999 / 15:00:40 / cg"
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2338
!
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2339
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2340
highBit
19600
aca6c5fb9d70 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19553
diff changeset
  2341
    "return the bitIndex of the highest bit set. 
aca6c5fb9d70 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 19553
diff changeset
  2342
     The returned bitIndex starts at 1 for the least significant bit.
24167
0dc1e390b3e0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24166
diff changeset
  2343
     Returns 0 if no bit is set.
0dc1e390b3e0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24166
diff changeset
  2344
     Notice for negative numbers, the returned value is undefined (actually: nonsense),
24287
f3e57438673c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24282
diff changeset
  2345
     because for 2's complement representation, conceptionally all high bits are 1.
f3e57438673c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24282
diff changeset
  2346
     But because we use a sign-magnitude representation, you'll get the high bit of
f3e57438673c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24282
diff changeset
  2347
     the absolute magnitude."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2348
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2349
    |byteNr highByte|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2350
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2351
    byteNr := self digitLength.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2352
    byteNr == 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2353
        ^ 0
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2354
    ].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2355
    highByte := self digitAt:byteNr.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2356
    ^ (byteNr - 1) * 8 + highByte highBit
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2357
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2358
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2359
     0 highBit
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2360
     -1 highBit
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2361
     (1 bitShift:1) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2362
     (1 bitShift:30) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2363
     (1 bitShift:31) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2364
     (1 bitShift:32) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2365
     (1 bitShift:33) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2366
     (1 bitShift:64) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2367
     (1 bitShift:1000) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2368
     (1 bitShift:1000) negated highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2369
     ((1 bitShift:64)-1) highBit
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2370
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2371
24167
0dc1e390b3e0 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24166
diff changeset
  2372
    "Modified: / 03-05-1999 / 09:20:57 / stefan"
24287
f3e57438673c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24282
diff changeset
  2373
    "Modified (comment): / 08-06-2019 / 02:06:47 / Claus Gittinger"
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2374
!
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2375
24192
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2376
highBitOfMagnitude 
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2377
    "return the high bit index of my magnitude bits"
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2378
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2379
    | magnitude |
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2380
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2381
    magnitude := self abs.
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2382
    ^ magnitude highBit
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2383
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2384
    "
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2385
     17 highBit    -> 5
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2386
     -17 highBit   -> 63 (actually undefined)
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2387
     -17 highBitOfMagnitude -> 5
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2388
    "
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2389
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2390
    "Created: / 27-05-2019 / 08:46:49 / Claus Gittinger"
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2391
!
18512bf68422 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24167
diff changeset
  2392
16071
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2393
leftShift:shiftCount
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2394
    "return the value of the receiver shifted left by shiftCount bits;
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2395
     leftShift if shiftCount > 0; rightShift otherwise.
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2396
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2397
     Notice: the result of bitShift: on negative receivers is not
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2398
             defined in the language standard (since the implementation
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2399
             is free to choose any internal representation for integers)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2400
             However, ST/X preserves the sign."
16071
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2401
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2402
    ^ self bitShift:shiftCount
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2403
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2404
    "
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2405
     16r100000000 leftShift:1
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2406
     16r100000000 negated leftShift:1
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2407
    "
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2408
!
52286691aad5 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16040
diff changeset
  2409
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2410
lowBit
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2411
    "return the bitIndex of the lowest bit set. The returned bitIndex
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2412
     starts at 1 for the least significant bit.
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6358
diff changeset
  2413
     Returns 0 if no bit is set."
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2414
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2415
    |maxBytes "{ Class: SmallInteger }"
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2416
     byte|
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2417
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2418
    maxBytes := self digitLength.
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2419
    1 to:maxBytes do:[:byteIndex |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2420
        byte := self digitAt:byteIndex.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2421
        byte ~~ 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2422
            ^ (byteIndex-1)*8 + (byte lowBit)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2423
        ].
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2424
    ].
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6358
diff changeset
  2425
    ^ 0 "/ should not happen
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2426
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2427
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2428
     0 lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2429
     1 lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2430
     (1 bitShift:1) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2431
     (1 bitShift:1) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2432
     (1 bitShift:30) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2433
     (1 bitShift:30) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2434
     (1 bitShift:31) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2435
     (1 bitShift:31) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2436
     (1 bitShift:32) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2437
     (1 bitShift:32) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2438
     (1 bitShift:33) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2439
     (1 bitShift:33) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2440
     (1 bitShift:64) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2441
     (1 bitShift:64) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2442
     (1 bitShift:1000) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2443
     (1 bitShift:1000) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2444
     ((1 bitShift:64)-1) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2445
     ((1 bitShift:64)-1) highBit
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2446
    "
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2447
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2448
    "Modified: 1.3.1997 / 16:54:23 / cg"
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2449
!
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2450
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2451
noMask:aMaskInteger
4643
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2452
    "return true if no 1-bit in anInteger is 1 in the receiver"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2453
17248
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2454
    ^ (self bitAnd:aMaskInteger) == 0
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2455
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2456
    "
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2457
     2r00001111 noMask:2r00000001
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2458
     2r00001111 noMask:2r11110000
bfcd59da8904 class: Integer
Claus Gittinger <cg@exept.de>
parents: 17037
diff changeset
  2459
    "
4643
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2460
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2461
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2462
odd
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2463
    "return true if the receiver is odd"
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2464
9401
65f884297c68 speed up #even and #odd
Stefan Vogel <sv@exept.de>
parents: 9316
diff changeset
  2465
    ^ (self bitAt:1) == 1
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2466
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2467
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2468
     16r112233445566778899 odd
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2469
     16r112233445566778800 odd
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2470
     1 odd
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2471
     2 odd
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2472
    "
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2473
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2474
    "Created: / 6.6.1999 / 15:00:55 / cg"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2475
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2476
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2477
rightShift:shiftCount
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2478
    "return the value of the receiver shifted right by shiftCount bits;
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2479
     rightShift if shiftCount > 0; leftShift otherwise.
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2480
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2481
     Notice: the result of bitShift: on negative receivers is not
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2482
             defined in the language standard (since the implementation
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2483
             is free to choose any internal representation for integers)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2484
             However, ST/X preserves the sign."
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2485
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2486
    ^ self bitShift:(shiftCount negated)
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2487
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2488
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2489
     16r100000000 rightShift:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2490
     16r100000000 negated rightShift:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2491
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2492
     16r100000000 rightShift:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2493
     16r100000000 negated rightShift:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2494
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2495
     16r100000000 rightShift:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2496
     16r100000000 negated rightShift:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2497
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2498
     ((16r100000000 rightShift:1) rightShift:1) rightShift:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2499
     ((16r100000000 negated rightShift:1) rightShift:1) rightShift:1
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2500
    "
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2501
! !
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2502
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2503
!Integer methodsFor:'bit operators - indexed'!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2504
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2505
bitAt:index
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2506
    "return the value of the index's bit (index starts at 1) as 0 or 1.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2507
     Notice: the result of bitAt: on negative receivers is not
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2508
             defined in the language standard (since the implementation
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2509
             is free to choose any internal representation for integers)"
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2510
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2511
    |i "{Class: SmallInteger}"|
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2512
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2513
    i := index - 1.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2514
    i < 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2515
        ^ SubscriptOutOfBoundsError
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2516
                raiseRequestWith:index
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2517
                errorString:'index out of bounds'
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2518
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2519
    ^ (self digitAt:(i // 8 + 1)) bitAt:(i \\ 8 + 1)
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2520
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2521
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2522
     1 bitAt:1                     => 1
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2523
     1 bitAt:2                     => 0
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2524
     1 bitAt:0                     index error
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2525
     2r1000100010001000100010001000100010001000100010001000 bitAt:48 => 1
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2526
     2r1000100010001000100010001000100010001000100010001000 bitAt:47 => 0
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2527
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2528
     (1 bitShift:1000) bitAt:1000  => 0
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2529
     (1 bitShift:1000) bitAt:1001  => 1
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2530
     (1 bitShift:1000) bitAt:1002  => 0
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2531
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2532
     (1 bitShift:30) bitAt:30
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2533
     (1 bitShift:30) bitAt:31
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2534
     (1 bitShift:30) bitAt:32
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2535
     (1 bitShift:31) bitAt:31
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2536
     (1 bitShift:31) bitAt:32
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2537
     (1 bitShift:31) bitAt:33
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2538
     (1 bitShift:32) bitAt:32
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2539
     (1 bitShift:32) bitAt:33
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2540
     (1 bitShift:32) bitAt:34
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2541
     (1 bitShift:64) bitAt:64
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2542
     (1 bitShift:64) bitAt:65
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2543
     (1 bitShift:64) bitAt:66
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2544
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2545
!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2546
24344
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2547
bitAt:anIntegerIndex put:aBit
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2548
    "the name is a bit misleading: this returns a NEW integer with the corresponding
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2549
     bit either set or cleared.
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2550
     Indexing starts with 1"
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2551
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2552
    aBit == 0 ifTrue:[
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2553
        ^ self clearBit:anIntegerIndex
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2554
    ].
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2555
    ^ self setBit:anIntegerIndex
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2556
24345
ed6857d820f1 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24344
diff changeset
  2557
    "
ed6857d820f1 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24344
diff changeset
  2558
     2r1100 bitAt:1 put:1
ed6857d820f1 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24344
diff changeset
  2559
     2r1101 bitAt:1 put:0
ed6857d820f1 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24344
diff changeset
  2560
    "
ed6857d820f1 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24344
diff changeset
  2561
24344
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2562
    "Created: / 23-06-2019 / 21:55:15 / Claus Gittinger"
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2563
!
8a9942f57037 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24331
diff changeset
  2564
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2565
bitIndicesOfOneBitsDo:aBlock
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2566
    "evaluate aBlock for all indices of a 1-bit, starting with the index of the lowest bit.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2567
     The index for the least significant bit is 1."
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2568
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2569
    1 to:self digitLength do:[:i8 |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2570
        |byte|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2571
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2572
        byte := self digitAt:i8.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2573
        byte ~~ 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2574
            1 to:8 do:[:i |
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2575
                (byte bitAt:i) == 1 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2576
                    aBlock value:(((i8-1)*8) + i).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2577
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2578
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2579
        ]
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2580
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2581
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2582
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2583
     1 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2584
     2 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2585
     4 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2586
     12 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2587
     127 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2588
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2589
!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2590
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2591
bitIndicesOfOneBitsReverseDo:aBlock
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2592
    "evaluate aBlock for all indices of a 1-bit, starting with the index of the highest
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2593
     and ending with the lowest bit.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2594
     The index for the least significant bit is 1."
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2595
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2596
    self digitLength downTo:1 do:[:i8 |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2597
        |byte|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2598
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2599
        byte := self digitAt:i8.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2600
        byte ~~ 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2601
            8 downTo:1 do:[:i |
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2602
                (byte bitAt:i) == 1 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2603
                    aBlock value:(((i8-1)*8) + i).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2604
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2605
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2606
        ]
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2607
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2608
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2609
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2610
     1 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2611
     2 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2612
     4 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2613
     12 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2614
     127 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2615
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2616
!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2617
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2618
changeBit:index to:aBooleanOrNumber
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2619
    "return a new number where the specified bit is on or off,
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2620
     depending on aBooleanOrNumber.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2621
     Bits are counted from 1 starting with the least significant.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2622
     The method's name may be misleading: the receiver is not changed,
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2623
     but a new number is returned. Should be named #withBit:changedTo:"
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2624
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2625
    (aBooleanOrNumber == 0 or:[aBooleanOrNumber == false]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2626
        ^ self clearBit:index
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2627
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2628
    ^ self setBit:index
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2629
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2630
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2631
     (16r3fffffff changeBit:31 to:1) hexPrintString
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2632
     (16r3fffffff asLargeInteger setBit:31) hexPrintString
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2633
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2634
!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2635
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2636
clearBit:index
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2637
    "return a new integer where the specified bit is off.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2638
     Bits are counted from 1 starting with the least significant.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2639
     The method's name may be misleading: the receiver is not changed,
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2640
     but a new number is returned. Should be named #withBitCleared:"
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2641
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2642
    |n         "{ Class: SmallInteger }"
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2643
     byteIndex "{ Class: SmallInteger }"
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2644
     bitIndex  "{ Class: SmallInteger }"
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2645
     result byte|
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2646
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2647
    index <= 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2648
        ^ SubscriptOutOfBoundsSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2649
                raiseRequestWith:index
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2650
                errorString:'bit index out of bounds'
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2651
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2652
    byteIndex := ((index - 1) // 8) + 1.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2653
    n := self digitLength.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2654
    byteIndex > n ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2655
        ^ self
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2656
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2657
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2658
    result := self simpleDeepCopy.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2659
    bitIndex := ((index - 1) \\ 8) + 1.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2660
    byte := (result digitAt:byteIndex) clearBit:bitIndex.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2661
    result digitAt:byteIndex put:byte.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2662
    (byte == 0 or:[n == byteIndex and:[n <= SmallInteger maxBytes]]) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2663
        ^ result compressed
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2664
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2665
    ^ result
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2666
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2667
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2668
     3111111111 clearBit:1
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2669
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2670
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2671
    "Modified: / 28.7.1998 / 18:35:50 / cg"
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2672
!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2673
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2674
invertBit:index
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2675
    "return a new number where the specified bit is inverted.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2676
     Bits are counted from 1 starting with the least significant.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2677
     The method's name may be misleading: the receiver is not changed,
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2678
     but a new number is returned. Should be named #withBitInverted:"
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2679
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2680
    index <= 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2681
        ^ SubscriptOutOfBoundsSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2682
                raiseRequestWith:index
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2683
                errorString:'index out of bounds'
19053
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2684
    ].
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2685
    ^ self bitXor:(1 bitShift:index-1)
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2686
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2687
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2688
     0 invertBit:3         => 4 (2r100)
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2689
     0 invertBit:48        => 140737488355328 (2r1000.....000)
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2690
     ((0 invertBit:99) invertBit:100) printStringRadix:2
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2691
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2692
!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2693
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2694
isBitClear:index
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2695
    "return true if the index' bit is clear; false otherwise.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2696
     Bits are counted from 1 starting with the least significant."
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2697
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2698
    ^ (self bitAt:index) == 0
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2699
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2700
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2701
     5 isBitClear:1       => false
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2702
     5 isBitClear:2       => true
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2703
     5 isBitClear:3       => false
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2704
     5 isBitClear:4       => true
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2705
     5 isBitClear:10000   => true
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2706
     2r0101 isBitClear:2  => true
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2707
     2r0101 isBitClear:1  => false
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2708
     2r0101 isBitClear:0  index error
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2709
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2710
!
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2711
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2712
isBitSet:index
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2713
    "return true if the index' bit is set; false otherwise.
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2714
     Bits are counted from 1 starting with the least significant."
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2715
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2716
    ^ (self bitAt:index) ~~ 0
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2717
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2718
    "
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2719
     5 isBitSet:3       => true
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2720
     2r0101 isBitSet:2  => false
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2721
     2r0101 isBitSet:1  => true
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2722
     2r0101 isBitSet:0  index error
6d26eb081cf8 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19040
diff changeset
  2723
    "
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2724
!
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2725
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2726
setBit:index
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2727
    "return a new integer, where the specified bit is on.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2728
     Bits are counted from 1 starting with the least significant.
14404
49a54ea47bf8 comment/format in:5 methods
Claus Gittinger <cg@exept.de>
parents: 14403
diff changeset
  2729
     The method's name may be misleading: the receiver is not changed,
11499
fa02ab9a83f0 comment
Claus Gittinger <cg@exept.de>
parents: 11496
diff changeset
  2730
     but a new number is returned. Should be named #withBitSet:"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2731
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2732
    index <= 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2733
        ^ SubscriptOutOfBoundsSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2734
                raiseRequestWith:index
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2735
                errorString:'index out of bounds'
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2736
    ].
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2737
    ^ self bitOr:(1 bitShift:index-1)
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2738
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2739
    "
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2740
     0 setBit:3         => 4 (2r100)
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2741
     0 setBit:48        => 140737488355328 (2r1000.....000)
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2742
     ((0 setBit:99) setBit:100) printStringRadix:2
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2743
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2744
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2745
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2746
!Integer methodsFor:'byte access'!
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2747
12784
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2748
byteAt:anIndex
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2749
    "compatibility with ByteArrays etc."
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2750
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2751
    ^ self digitAt:anIndex
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2752
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2753
    "
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2754
        12345678 byteAt:2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2755
        12345678 digitBytes at:2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2756
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2757
        -12345678 byteAt:2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2758
        -12345678 digitBytes at:2
12784
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2759
    "
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2760
!
3bc5946ade11 added: #byteAt:
Stefan Vogel <sv@exept.de>
parents: 12670
diff changeset
  2761
19130
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2762
byteSwapped32
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2763
    "a fallback, in case unimplemented in concrete classes.
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2764
     Not actually used"
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2765
    
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2766
    ^ ((self digitAt:1) bitShift:24)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2767
    + ((self digitAt:2) bitShift:16)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2768
    + ((self digitAt:3) bitShift:8)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2769
    + (self digitAt:4)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2770
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2771
    "
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2772
     16r12345678901234567890 byteSwapped32
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2773
    "
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2774
!
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2775
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2776
byteSwapped64
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2777
    "a fallback, in case unimplemented in concrete classes.
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2778
     Not actually used"
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2779
    
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2780
    ^ ((self digitAt:1) bitShift:56)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2781
    + ((self digitAt:2) bitShift:48)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2782
    + ((self digitAt:3) bitShift:40)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2783
    + ((self digitAt:4) bitShift:32)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2784
    + ((self digitAt:5) bitShift:24)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2785
    + ((self digitAt:6) bitShift:16)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2786
    + ((self digitAt:7) bitShift:8)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2787
    + (self digitAt:8)
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2788
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2789
    "
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2790
     16r1234567890123456789 byteSwapped64 hexPrintString
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2791
    "
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2792
!
3a662cab41dd #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19128
diff changeset
  2793
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2794
digitByteLength
19327
723b235f0980 #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19319
diff changeset
  2795
    <resource: #obsolete>
19316
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2796
    "return the number bytes required for a 2's complement
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2797
     binary representation of this Integer."
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2798
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2799
    self obsoleteMethodWarning:'use signedDigitLength - attention: return value fixed'.
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2800
    ^ self signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2801
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2802
    "
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2803
     -127 digitByteLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2804
     -128 digitByteLength
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2805
     -129 digitByteLength
19315
e11b9d45bb9c #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19276
diff changeset
  2806
     -32769 digitByteLength
e11b9d45bb9c #DOCUMENTATION
Stefan Vogel <sv@exept.de>
parents: 19276
diff changeset
  2807
     32768 digitByteLength
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2808
    "
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2809
!
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2810
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2811
digitBytes
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  2812
    "return a byteArray filled with the receiver's bits
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2813
     (8 bits of the absolute value per element),
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2814
     least significant byte is first"
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2815
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2816
    ^ self subclassResponsibility
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2817
!
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2818
15567
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  2819
digitBytesMSB
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  2820
    "return a byteArray filled with the receiver's bits
15567
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  2821
     (8 bits of the absolute value per element),
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  2822
     most significant byte is first"
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  2823
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  2824
    ^ self subclassResponsibility
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  2825
!
7f314ee34dfb new: #digitBytesMSB
Stefan Vogel <sv@exept.de>
parents: 15559
diff changeset
  2826
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2827
digitBytesMSB:msbFlag
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  2828
    "return a byteArray filled with the receiver's bits
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2829
     (8 bits of the absolute value per element),
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2830
     if msbflag = true, most significant byte is first,
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2831
     otherwise least significant byte is first"
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2832
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2833
    msbFlag ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2834
        ^ self digitBytesMSB.
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2835
    ].
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2836
    ^ self digitBytes
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2837
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2838
    "
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2839
      16r12 digitBytesMSB:true
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2840
      16r1234 digitBytesMSB:true
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2841
      16r1234 digitBytesMSB:false
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2842
      16r12345678 digitBytesMSB:true
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2843
      16r12345678 digitBytesMSB:false
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2844
    "
14166
ea350ed3d6a9 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14098
diff changeset
  2845
!
ea350ed3d6a9 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14098
diff changeset
  2846
19316
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2847
signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2848
    "return the number bytes required for a 2's complement
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2849
     binary representation of this Integer.
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2850
     I.e. the number of bytes from which we have to sign extent the highest bit"    
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2851
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2852
    |absLen "{ Class: SmallInteger }" |
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2853
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2854
    self >= 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2855
        absLen := self digitLength.
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2856
        (self digitByteAt:absLen) >= 16r80 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2857
            ^ absLen + 1.
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2858
        ].
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2859
        ^ absLen.
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2860
    ].
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2861
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2862
    absLen := self negated digitLength.
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2863
    (self digitByteAt:absLen) < 16r80 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2864
            ^ absLen + 1
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2865
    ].
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2866
    ^ absLen
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2867
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2868
    "
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2869
     0 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2870
     1 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2871
     126 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2872
     127 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2873
     128 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2874
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2875
     255 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2876
     256 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2877
     257 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2878
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2879
     32767 signedDigitLength    
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2880
     32768 signedDigitLength    
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2881
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2882
     -1 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2883
     -127 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2884
     -128 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2885
     -129 signedDigitLength
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2886
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2887
     -32767 signedDigitLength    
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2888
     -32768 signedDigitLength    
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2889
     -32769 signedDigitLength    
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2890
    "
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2891
!
Claus Gittinger <cg@exept.de>
parents: 19315
diff changeset
  2892
14166
ea350ed3d6a9 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14098
diff changeset
  2893
swapBytes
16886
247352d5de0f class: Integer
Stefan Vogel <sv@exept.de>
parents: 16884
diff changeset
  2894
    "swap bytes pair-wise in a positive integer
247352d5de0f class: Integer
Stefan Vogel <sv@exept.de>
parents: 16884
diff changeset
  2895
     i.e. a.b.c.d -> b.a.d.c
247352d5de0f class: Integer
Stefan Vogel <sv@exept.de>
parents: 16884
diff changeset
  2896
     Swapping of negative integers is undefined and therefore not supported."
16884
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2897
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2898
    |digitBytes|
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2899
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2900
    self negative ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2901
        RangeError raiseWith:self errorString:'negative numbers are not supported in #swapBytes'.
16884
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2902
    ].
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2903
    digitBytes := self digitBytes.
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2904
    digitBytes size odd ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2905
        "ByteArray<<#swapBytes needs even number of bytes.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2906
         Add 0 to the most significant position (the end)"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2907
        digitBytes := digitBytes copyWith:0.
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  2908
16884
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2909
    ].
1d8ce66b2547 class: Integer
Stefan Vogel <sv@exept.de>
parents: 16874
diff changeset
  2910
    ^ (LargeInteger digitBytes:digitBytes swapBytes) compressed
14166
ea350ed3d6a9 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14098
diff changeset
  2911
ea350ed3d6a9 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14098
diff changeset
  2912
    "
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2913
        16rFFEE2211 swapBytes hexPrintString
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2914
        16rFFEEAA2211 swapBytes hexPrintString
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2915
        16r2211 swapBytes hexPrintString
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2916
        16rFF3FFFFF swapBytes
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2917
        self assert:(SmallInteger maxVal swapBytes swapBytes == SmallInteger maxVal)
14166
ea350ed3d6a9 added: #swapBytes
Stefan Vogel <sv@exept.de>
parents: 14098
diff changeset
  2918
    "
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2919
! !
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2920
5238
f7a816a660a3 categories
Claus Gittinger <cg@exept.de>
parents: 5210
diff changeset
  2921
!Integer methodsFor:'coercing & converting'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2922
1888
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2923
asFixedPoint
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2924
    "return the receiver as a fixedPoint number"
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2925
6640
2de8925ad2cd fixed asFixedPoint (did return int due to reduce).
Claus Gittinger <cg@exept.de>
parents: 6639
diff changeset
  2926
    ^ FixedPoint basicNew
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2927
        setNumerator:self denominator:1 scale:1
1888
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2928
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2929
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2930
     100 asFixedPoint
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2931
     100 asFixedPoint + 0.1 asFixedPoint
1888
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2932
    "
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2933
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2934
    "Modified: 5.11.1996 / 15:13:17 / cg"
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2935
!
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2936
2141
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2937
asFixedPoint:scale
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2938
    "return the receiver as fixedPoint number, with the given number
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2939
     of post-decimal-point digits."
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2940
6639
d88a51b081ae fixed asFixedPoint (did return int due to reduce).
Claus Gittinger <cg@exept.de>
parents: 6635
diff changeset
  2941
    ^ FixedPoint basicNew
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  2942
        setNumerator:self denominator:1 scale:scale
2141
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2943
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2944
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2945
     100 asFixedPoint:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2946
     100 asFixedPoint + (0.1 asFixedPoint:2)
2141
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2947
    "
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2948
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2949
    "Modified: 10.1.1997 / 20:00:08 / cg"
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2950
!
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2951
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2952
asFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2953
    "return a Float with same value as myself.
11240
4ce9c8fa3d37 comment
Claus Gittinger <cg@exept.de>
parents: 11223
diff changeset
  2954
     Since floats have a limited precision, you usually loose bits when doing this."
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2955
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2956
    ^ Float fromInteger:self
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2957
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2958
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2959
     1234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2960
     1234567890 asFloat asInteger
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2961
     12345678901234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2962
     12345678901234567890 asFloat asInteger
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2963
    "
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2964
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2965
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2966
asFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2967
    "return a Fraction with same value as receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2968
2794
862ee34a4821 when coercing an integer, do not reduce the result.
Claus Gittinger <cg@exept.de>
parents: 2793
diff changeset
  2969
    ^ Fraction basicNew setNumerator:self denominator:1
862ee34a4821 when coercing an integer, do not reduce the result.
Claus Gittinger <cg@exept.de>
parents: 2793
diff changeset
  2970
862ee34a4821 when coercing an integer, do not reduce the result.
Claus Gittinger <cg@exept.de>
parents: 2793
diff changeset
  2971
    "Modified: 28.7.1997 / 19:26:06 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2972
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2973
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2974
asInteger
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2975
    "return the receiver truncated towards zero -
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2976
     for integers this is self"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2977
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2978
    ^ self
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2979
!
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2980
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2981
asLargeFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2982
    "return a LargeFloat with same value as myself.
23053
624d156e698c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 22600
diff changeset
  2983
     If the largeFloat class is not present, a regular float is returned"
624d156e698c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 22600
diff changeset
  2984
23055
321a26366ce6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23053
diff changeset
  2985
    ^ (LargeFloat ? LongFloat ? Float) fromInteger:self
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2986
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2987
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2988
     1234567890 asLargeFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2989
     1234567890 asLargeFloat asInteger
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2990
     12345678901234567890 asLargeFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2991
     12345678901234567890 asLargeFloat asInteger
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2992
    "
23053
624d156e698c #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 22600
diff changeset
  2993
23055
321a26366ce6 #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 23053
diff changeset
  2994
    "Modified: / 07-06-2018 / 16:28:16 / Claus Gittinger"
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2995
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2996
24153
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  2997
asLargeFloatPrecision:n
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  2998
    "return a LargeFloat with same value as myself.
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  2999
     If the largeFloat class is not present, a regular float is returned"
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3000
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3001
    LargeFloat isNil ifTrue:[^ (LongFloat ? Float) fromInteger:self].
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3002
    ^ LargeFloat fromInteger:self precision:n 
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3003
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3004
    "
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3005
     1234567890 asLargeFloatPrecision:10
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3006
     12345678901234567890 asLargeFloatPrecision:10
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3007
    "
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3008
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3009
    "Created: / 26-05-2019 / 03:56:50 / Claus Gittinger"
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3010
!
88feac51cfbb #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24099
diff changeset
  3011
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3012
asLongFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3013
    "return a LongFloat with same value as myself.
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3014
     Since longFloats have a limited precision, you usually loose bits when
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3015
     doing this."
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3016
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3017
    ^ LongFloat fromInteger:self
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3018
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3019
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3020
     1234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3021
     1234567890 asFloat asInteger
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3022
     12345678901234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3023
     12345678901234567890 asFloat asInteger
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3024
    "
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3025
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3026
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3027
asModuloNumber
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3028
    "return a precomputed modulo number"
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3029
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3030
    ^ ModuloNumber modulus:self.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3031
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3032
    "Created: / 3.5.1999 / 14:48:03 / stefan"
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3033
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3034
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3035
asShortFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3036
    "return a ShortFloat with same value as receiver"
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3037
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3038
    ^ ShortFloat fromInteger:self
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3039
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3040
21822
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
  3041
coerce:aNumber
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
  3042
    "convert the argument aNumber into an instance of the receiver's class and return it."
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
  3043
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
  3044
    ^ aNumber asInteger
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
  3045
!
7f00cd69b534 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21774
diff changeset
  3046
14043
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3047
signExtended24BitValue
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3048
    "return an integer from sign-extending the 24'th bit.
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3049
     i.e. interprets the lowest 24 bits as a signed integer,
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3050
     ignoring higher bits.
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3051
     This may be useful for communication interfaces"
14043
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3052
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3053
    ^ (self bitAnd:16rFFFFFF) signExtended24BitValue
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3054
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3055
    "
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3056
     16r800000 signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3057
     16r7FFFFF signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3058
     16rFFFFFF signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3059
    "
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3060
14043
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3061
    "Modified: / 07-05-1996 / 09:31:57 / cg"
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3062
    "Created: / 05-03-2012 / 14:37:55 / cg"
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3063
    "Modified (comment): / 26-02-2016 / 19:39:52 / cg"
14043
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3064
!
045fd447ab4d added: #signExtended24BitValue
Claus Gittinger <cg@exept.de>
parents: 13993
diff changeset
  3065
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3066
signExtendedByteValue
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3067
    "return an integer from sign-extending the 8'th bit.
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3068
     i.e. interprets the lowest 8 bits as a signed integer,
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3069
     ignoring higher bits.
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3070
     This may be useful for communication interfaces"
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3071
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3072
    ^ (self bitAnd:16rFF) signExtendedByteValue
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3073
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3074
    "
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3075
     16r80 signExtendedByteValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3076
     16r7F signExtendedByteValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3077
     16rFF signExtendedByteValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3078
    "
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3079
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3080
    "Created: / 07-05-1996 / 09:31:52 / cg"
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3081
    "Modified (comment): / 26-02-2016 / 19:39:46 / cg"
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3082
!
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3083
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3084
signExtendedFromBit:bitNr
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3085
    "return an integer from sign-extending the n'th bit.
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3086
     i.e. interprets the lowest n bits as a signed integer,
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3087
     ignoring higher bits.
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3088
     The bit numbering is 1-based (i.e. the lowest bit has bitNr 1)    
22073
d4ac55497643 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22072
diff changeset
  3089
     This may be useful for communication interfaces.
d4ac55497643 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22072
diff changeset
  3090
     (kind of the reverse operation to asUnsigned:)."
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3091
22070
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3092
    ^ self signExtendedFromMaskBit:(1 bitShift:bitNr-1)
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3093
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3094
    "
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3095
     2r111000111 signExtendedFromBit:3 -> 2r11111....111 -> -1 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3096
     2r111000110 signExtendedFromBit:3 -> 2r11111....110 -> -2 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3097
     2r111000101 signExtendedFromBit:3 -> 2r11111....101 -> -3   
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3098
     2r111000100 signExtendedFromBit:3 -> 2r11111....100 -> -4 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3099
     2r111000000 signExtendedFromBit:3 -> 2r00000....000 -> 0   
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3100
     2r111000011 signExtendedFromBit:3 -> 2r00000....011 -> 3  
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3101
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3102
     16r800008 signExtendedFromBit:4 -> -8 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3103
     16r7FFF07 signExtendedFromBit:4 -> 7 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3104
     16r7FFF0F signExtendedFromBit:4 -> -1
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3105
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3106
     16rFFFFFF signExtendedFromBit:8 -> -1
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3107
     16rFFFF7F signExtendedFromBit:8 -> 127
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3108
     16rFFFF80 signExtendedFromBit:8 -> -128
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3109
    "
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3110
22073
d4ac55497643 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22072
diff changeset
  3111
    "Modified (comment): / 21-07-2017 / 15:13:55 / cg"
22070
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3112
!
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3113
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3114
signExtendedFromMaskBit:highBitMask
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3115
    "return an integer from sign-extending the bit defined by highMaskBit,
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3116
     which MUST be a single bit (otherwise, you'll get garbage).
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3117
     i.e. interprets the lowest n bits as a signed integer,
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3118
     ignoring higher bits.
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3119
     This may be useful for communication interfaces and to expand bitfields into
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3120
     signed values"
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3121
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3122
    |masked|
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3123
22070
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3124
    masked := self bitAnd:(highBitMask-1).
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3125
    (self bitTest:highBitMask) ifTrue:[
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3126
        ^ masked - highBitMask
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3127
    ].
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3128
    ^ masked
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3129
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3130
    "
22070
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3131
     2r111000111 signExtendedFromMaskBit:2r100 -> 2r11111....111 -> -1 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3132
     2r111000110 signExtendedFromMaskBit:2r100 -> 2r11111....110 -> -2 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3133
     2r111000101 signExtendedFromMaskBit:2r100 -> 2r11111....101 -> -3   
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3134
     2r111000100 signExtendedFromMaskBit:2r100 -> 2r11111....100 -> -4 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3135
     2r111000000 signExtendedFromMaskBit:2r100 -> 2r00000....000 -> 0   
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3136
     2r111000011 signExtendedFromMaskBit:2r100 -> 2r00000....011 -> 3  
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3137
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3138
     16r800008 signExtendedFromMaskBit:2r1000 -> -8 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3139
     16r7FFF07 signExtendedFromMaskBit:2r1000 -> 7 
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3140
     16r7FFF0F signExtendedFromMaskBit:2r1000 -> -1
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3141
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3142
     16rFFFFFF signExtendedFromMaskBit:2r10000000 -> -1
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3143
     16rFFFF7F signExtendedFromMaskBit:2r10000000 -> 127
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3144
     16rFFFF80 signExtendedFromMaskBit:2r10000000 -> -128
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3145
    "
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3146
9ff5b5333e3e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22069
diff changeset
  3147
    "Created: / 21-07-2017 / 14:52:12 / cg"
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3148
!
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3149
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3150
signExtendedLongLongValue
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3151
    "return an integer from sign-extending the 64'th bit.
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3152
     i.e. interprets the lowest 64 bits as a signed integer,
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3153
     ignoring higher bits.
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3154
     This may be useful for communication interfaces"
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3155
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3156
    (self bitTest:16r8000000000000000) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3157
        ^ (self bitAnd:16rFFFFFFFFFFFFFFFF)-16r10000000000000000
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3158
    ].
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3159
    ^ (self bitAnd:16r7FFFFFFFFFFFFFFF)
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3160
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3161
    "
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3162
     16r1238000000000000000 signExtendedLongLongValue
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3163
     16r1237FFFFFFFFFFFFFFF signExtendedLongLongValue
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3164
     16r123FFFFFFFFFFFFFFFF signExtendedLongLongValue
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3165
    "
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3166
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3167
    "Modified (comment): / 26-02-2016 / 19:38:55 / cg"
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3168
!
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3169
15084
910b4913067b class: Integer
Claus Gittinger <cg@exept.de>
parents: 14967
diff changeset
  3170
signExtendedLongValue
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3171
    "return an integer from sign-extending the 32'th bit.
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3172
     i.e. interprets the lowest 32 bits as a signed integer,
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3173
     ignoring higher bits.
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3174
     This may be useful for communication interfaces"
15084
910b4913067b class: Integer
Claus Gittinger <cg@exept.de>
parents: 14967
diff changeset
  3175
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3176
    (self bitTest:16r80000000) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3177
        ^ (self bitAnd:16rFFFFFFFF) - 16r100000000
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3178
    ].
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3179
    ^ (self bitAnd:16r7FFFFFFF)
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3180
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3181
    "
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3182
     16r80000000 signExtendedLongValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3183
     16r7FFFFFFF signExtendedLongValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3184
     16rFFFFFFFF signExtendedLongValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3185
    "
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3186
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3187
    "Modified (comment): / 26-02-2016 / 19:39:09 / cg"
15084
910b4913067b class: Integer
Claus Gittinger <cg@exept.de>
parents: 14967
diff changeset
  3188
!
910b4913067b class: Integer
Claus Gittinger <cg@exept.de>
parents: 14967
diff changeset
  3189
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3190
signExtendedShortValue
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3191
    "return an integer from sign-extending the 16'th bit.
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3192
     i.e. interprets the lowest 16 bits as a signed integer,
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3193
     ignoring higher bits.
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3194
     This may be useful for communication interfaces"
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3195
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3196
    ^ (self bitAnd:16rFFFF) signExtendedShortValue
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  3197
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3198
    "
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3199
     16r8000 signExtendedShortValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3200
     16r7FFF signExtendedShortValue
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3201
     16rFFFF signExtendedShortValue
19062
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3202
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3203
     16r1238000 signExtendedShortValue
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3204
     16r1237FFF signExtendedShortValue
ad646a7ec0b9 #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19061
diff changeset
  3205
     16r123FFFF signExtendedShortValue
19061
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3206
    "
Claus Gittinger <cg@exept.de>
parents: 19058
diff changeset
  3207
19257
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3208
    "Modified: / 07-05-1996 / 09:31:57 / cg"
f1937ab25bbf #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19252
diff changeset
  3209
    "Modified (comment): / 26-02-2016 / 19:39:37 / cg"
24244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3210
!
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3211
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3212
zigZagDecodedValue
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3213
    "zigzag encoding maps values with small absolute values
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3214
     into relatively small unsigned integer numbers in the same range.
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3215
     i.e. [minInt .. maxInt] is mapped into [0 .. maxUINT],
24247
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3216
     where small magnitudes generate small encodings.
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3217
     Zigzag is used eg. by google's protocol buffer encoding"
24244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3218
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3219
    |t|
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3220
    
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3221
    t := self bitShift:-1.
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3222
    (self odd) ifTrue:[^ t negated - 1].
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3223
    ^ t 
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3224
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3225
    "
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3226
     0 zigZagEncoded64BitValue zigZagDecodedValue -> 0
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3227
     -1 zigZagEncoded64BitValue zigZagDecodedValue -> -1
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3228
     1 zigZagEncoded64BitValue zigZagDecodedValue -> 1
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3229
     -2 zigZagEncoded64BitValue zigZagDecodedValue -> -2
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3230
     2 zigZagEncoded64BitValue zigZagDecodedValue -> 2
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3231
     -2147483647 zigZagEncoded64BitValue zigZagDecodedValue -> -2147483647
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3232
     2147483647 zigZagEncoded64BitValue zigZagDecodedValue -> 2147483647
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3233
     -2147483648 zigZagEncoded64BitValue zigZagDecodedValue -> -2147483648
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3234
     2147483648 zigZagEncoded64BitValue zigZagDecodedValue -> 2147483648
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3235
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3236
     -4611686018427387903 zigZagEncoded64BitValue zigZagDecodedValue -> -4611686018427387903
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3237
     4611686018427387903 zigZagEncoded64BitValue zigZagDecodedValue -> 4611686018427387903
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3238
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3239
     -4611686018427387904 zigZagEncoded64BitValue zigZagDecodedValue -> -4611686018427387904
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3240
     4611686018427387904 zigZagEncoded64BitValue zigZagDecodedValue -> 4611686018427387904 
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3241
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3242
     -4611686018427387905 zigZagEncoded64BitValue zigZagDecodedValue -> -4611686018427387905
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3243
     4611686018427387905 zigZagEncoded64BitValue zigZagDecodedValue -> 4611686018427387905
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3245
     -9223372036854775807 zigZagEncoded64BitValue zigZagDecodedValue -> -9223372036854775807
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3246
     9223372036854775807 zigZagEncoded64BitValue zigZagDecodedValue -> 9223372036854775807
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3247
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3248
     -9223372036854775808 zigZagEncoded64BitValue zigZagDecodedValue -> -9223372036854775808
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3249
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3250
     -- out of range
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3251
     9223372036854775808 zigZagEncoded64BitValue zigZagDecodedValue
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3252
    "
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3253
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3254
    "Created: / 04-06-2019 / 00:48:47 / Claus Gittinger"
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3255
!
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3256
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3257
zigZagEncoded32BitValue
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3258
    "zigzag encoding maps values with small absolute values
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3259
     into relatively small unsigned integer numbers in the same range.
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3260
     i.e. [minInt .. maxInt] is mapped into [0 .. maxUINT],
24247
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3261
     where small magnitudes generate small encodings.
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3262
     Zigzag is used eg. by google's protocol buffer encoding"
24244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3263
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3264
    |t|
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3265
    
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3266
    t := self bitShift:1.
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3267
    self negative ifTrue:[t := t negated - 1].
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3268
    ^ t bitAnd:16rFFFFFFFF
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3269
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3270
    "
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3271
     0 zigZagEncoded32BitValue -> 0
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3272
     -1 zigZagEncoded32BitValue -> 1
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3273
     1 zigZagEncoded32BitValue -> 2
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3274
     -2 zigZagEncoded32BitValue -> 3
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3275
     2 zigZagEncoded32BitValue -> 4
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3276
     -2147483647 zigZagEncoded32BitValue -> 4294967293
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3277
     16r7FFFFFFF zigZagEncoded32BitValue -> 4294967294
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3278
     16r-80000000 zigZagEncoded32BitValue -> 4294967295
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3279
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3280
     -- out of range:
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3281
     2147483648 zigZagEncoded32BitValue -> 4294967296
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3282
    "
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3283
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3284
    "Created: / 03-06-2019 / 17:37:53 / Claus Gittinger"
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3285
    "Modified: / 03-06-2019 / 19:13:55 / Claus Gittinger"
24247
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3286
    "Modified (comment): / 04-06-2019 / 01:11:25 / Claus Gittinger"
24244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3287
!
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3288
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3289
zigZagEncoded64BitValue
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3290
    "zigzag encoding maps values with small absolute values
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3291
     into relatively small unsigned integer numbers in the same range.
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3292
     i.e. [minInt .. maxInt] is mapped into [0 .. maxUINT],
24247
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3293
     where small magnitudes generate small encodings.
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3294
     Zigzag is used eg. by google's protocol buffer encoding"
24244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3295
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3296
    |t|
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3297
    
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3298
    t := self bitShift:1.
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3299
    self negative ifTrue:[t := t negated - 1].
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3300
    ^ t bitAnd:16rFFFFFFFFFFFFFFFF
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3301
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3302
    "
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3303
     0 zigZagEncoded64BitValue -> 0
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3304
     -1 zigZagEncoded64BitValue -> 1
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3305
     1 zigZagEncoded64BitValue -> 2
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3306
     -2 zigZagEncoded64BitValue -> 3
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3307
     2 zigZagEncoded64BitValue -> 4
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3308
     -2147483647 zigZagEncoded64BitValue -> 4294967293
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3309
     2147483647 zigZagEncoded64BitValue -> 4294967294
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3310
     -2147483648 zigZagEncoded64BitValue -> 4294967295
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3311
     2147483648 zigZagEncoded64BitValue -> 4294967296
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3312
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3313
     -16r3FFFFFFFFFFFFFFF zigZagEncoded64BitValue 9223372036854775805
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3314
     16r3FFFFFFFFFFFFFFF zigZagEncoded64BitValue 9223372036854775806
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3315
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3316
     -16r4000000000000000 zigZagEncoded64BitValue 9223372036854775807
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3317
     16r4000000000000000 zigZagEncoded64BitValue 9223372036854775808 
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3318
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3319
     -16r4000000000000001 zigZagEncoded64BitValue 9223372036854775809
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3320
     16r4000000000000001 zigZagEncoded64BitValue 9223372036854775810
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3321
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3322
     -16r7FFFFFFFFFFFFFFF zigZagEncoded64BitValue 18446744073709551613
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3323
     16r7FFFFFFFFFFFFFFF zigZagEncoded64BitValue 18446744073709551614
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3324
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3325
     -16r8000000000000000 zigZagEncoded64BitValue 18446744073709551615
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3326
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3327
     -- out of range
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3328
     16r8000000000000000 zigZagEncoded64BitValue 
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3329
    "
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3330
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3331
    "Created: / 03-06-2019 / 17:42:02 / Claus Gittinger"
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  3332
    "Modified: / 03-06-2019 / 19:12:37 / Claus Gittinger"
24247
dc1e4c314065 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24244
diff changeset
  3333
    "Modified (comment): / 04-06-2019 / 01:11:32 / Claus Gittinger"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3334
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3335
1976
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3336
!Integer methodsFor:'comparing'!
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3337
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3338
hash
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3339
    "redefined to return smallInteger hashValues"
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3340
19553
a1e1e8901461 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 19455
diff changeset
  3341
    ^ self bitAnd:SmallInteger maxVal.
1976
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3342
3298
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  3343
    "
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3344
        -20000000000000 hash
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3345
         20000000000000 hash
3298
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  3346
    "
1976
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3347
3298
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  3348
    "Created: / 14.11.1996 / 12:12:27 / cg"
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  3349
    "Modified: / 24.2.1998 / 10:07:29 / stefan"
1976
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3350
! !
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  3351
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  3352
12978
6899c32d29a9 added: #addDependent:
Claus Gittinger <cg@exept.de>
parents: 12976
diff changeset
  3353
!Integer methodsFor:'dependents access'!
6899c32d29a9 added: #addDependent:
Claus Gittinger <cg@exept.de>
parents: 12976
diff changeset
  3354
6899c32d29a9 added: #addDependent:
Claus Gittinger <cg@exept.de>
parents: 12976
diff changeset
  3355
addDependent:anObject
23556
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3356
    "It doesn't make sense to add dependents to a shared instance.
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3357
     Silently ignore ..."
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3358
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3359
"/    Transcript show:'*** trying to make dependent on an integer: '.
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3360
"/    thisContext sender printOn:Transcript. Transcript cr.
12978
6899c32d29a9 added: #addDependent:
Claus Gittinger <cg@exept.de>
parents: 12976
diff changeset
  3361
6899c32d29a9 added: #addDependent:
Claus Gittinger <cg@exept.de>
parents: 12976
diff changeset
  3362
    "Created: / 28-07-2010 / 20:29:00 / cg"
23556
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3363
    "Modified: / 03-12-2018 / 17:48:53 / Stefan Vogel"
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3364
!
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3365
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3366
onChangeSend:selector to:someOne
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3367
    "It doesn't make sense to add dependents to a shared instance.
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3368
     Silently ignore ..."
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3369
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3370
"/    Transcript show:'*** trying to make dependent on an integer: '.
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3371
"/    thisContext sender printOn:Transcript. Transcript cr.
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3372
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3373
    "Created: / 30-11-2018 / 18:02:50 / Stefan Vogel"
2e05c6f6d847 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23496
diff changeset
  3374
    "Modified (comment): / 03-12-2018 / 17:49:05 / Stefan Vogel"
12978
6899c32d29a9 added: #addDependent:
Claus Gittinger <cg@exept.de>
parents: 12976
diff changeset
  3375
! !
6899c32d29a9 added: #addDependent:
Claus Gittinger <cg@exept.de>
parents: 12976
diff changeset
  3376
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3377
!Integer methodsFor:'double dispatching'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3378
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3379
differenceFromFraction:aFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3380
    "sent when a fraction does not know how to subtract the receiver, an integer"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3381
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3382
    |d|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3383
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3384
    d := aFraction denominator.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3385
    ^ aFraction class
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3386
        numerator:(aFraction numerator - (self * d))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3387
        denominator:d
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3388
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3389
    "Modified: 28.7.1997 / 19:08:30 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3390
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3391
11517
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3392
differenceFromTimestamp:aTimestamp
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3393
    "I am to be interpreted as seconds, return the timestamp this number of seconds
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3394
     before aTimestamp"
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3395
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3396
    ^ aTimestamp subtractSeconds:self.
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3397
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3398
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3399
     Timestamp now subtractSeconds:100
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3400
     100 differenceFromTimestamp:Timestamp now
11517
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3401
    "
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3402
!
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  3403
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3404
equalFromFraction:aFraction
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3405
    "that should never be invoked, as fractions are always normalized to integers
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3406
     if resulting from an arithmetic operation.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3407
     However, this implementation is for subclasses (i.e. fixed point) and also
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3408
     allows comparing unnormalized fractions as might appear within the fraction class"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3409
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3410
    |denominator numerator|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3411
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3412
    denominator := aFraction denominator.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3413
    numerator := aFraction numerator.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3414
    (denominator == 1) ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3415
        ^ numerator = (self * denominator)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3416
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3417
    ^ numerator = self
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3418
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3419
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3420
productFromFraction:aFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3421
    "sent when a fraction does not know how to multiply the receiver, an integer"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3422
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3423
    ^ aFraction class
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3424
        numerator:(self * aFraction numerator)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3425
        denominator:aFraction denominator
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3426
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3427
    "Modified: 28.7.1997 / 19:08:27 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3428
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3429
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3430
quotientFromFraction:aFraction
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3431
    "Return the quotient of the argument, aFraction and the receiver.
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  3432
     Sent when aFraction does not know how to divide by the receiver."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3433
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3434
    ^ aFraction class
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3435
        numerator:aFraction numerator
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3436
        denominator:(self * aFraction denominator)
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3437
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3438
    "Modified: 28.7.1997 / 19:08:23 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3439
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3440
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3441
sumFromFraction:aFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3442
    "sent when a fraction does not know how to add the receiver, an integer"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3443
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3444
    |d|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3445
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3446
    d := aFraction denominator.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3447
    ^ aFraction class
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3448
        numerator:(aFraction numerator + (self * d))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3449
        denominator:d
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3450
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  3451
    "Modified: 28.7.1997 / 19:08:11 / cg"
10681
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3452
!
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3453
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3454
sumFromTimestamp:aTimestamp
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3455
    "I am to be interpreted as seconds, return the timestamp this number of seconds
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3456
     after aTimestamp"
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3457
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3458
    ^ aTimestamp addSeconds:self.
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3459
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3460
    "
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3461
     Timestamp now addSeconds:100
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3462
     100 sumFromTimestamp:Timestamp now
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  3463
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3464
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3465
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3466
!Integer methodsFor:'helpers'!
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3467
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3468
gcd_helper:anInteger
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3469
    "a helper for the greatest common divisor of the receiver and anInteger.
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3470
     Knuth's algorithm for large positive integers, with receiver being
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3471
     larger than the arg."
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3472
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3473
    | a b aLowBit bLowBit shift t |
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3474
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3475
    a := self.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3476
    b := anInteger.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3477
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3478
    aLowBit := a lowBit - 1.
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3479
    bLowBit := b lowBit - 1.
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3480
    shift := aLowBit min:bLowBit.
22213
8b482a0c44a1 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22166
diff changeset
  3481
    b := b rightShift:bLowBit.
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3482
    [a = 0] whileFalse:[
22213
8b482a0c44a1 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22166
diff changeset
  3483
        a := a rightShift:aLowBit.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3484
        a < b ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3485
            t := a. a := b. b := t
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3486
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3487
        a := a - b.
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3488
        aLowBit := a lowBit - 1.
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3489
    ].
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3490
    ^ b bitShift:shift
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3491
22213
8b482a0c44a1 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22166
diff changeset
  3492
    "Created: / 01-03-1997 / 16:38:17 / cg"
8b482a0c44a1 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 22166
diff changeset
  3493
    "Modified: / 25-08-2017 / 12:33:09 / cg"
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3494
! !
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  3495
10027
36281068b212 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9401
diff changeset
  3496
12565
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3497
!Integer methodsFor:'iteration'!
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3498
23594
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3499
timesCollect:aBlock
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3500
    "syntactic sugar; same as (1 to:self) collect:aBlock"
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3501
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3502
    ^ (1 to:self) collect:aBlock
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3503
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3504
    "
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3505
     10 timesCollect:[:i | i squared]
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3506
    "
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3507
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3508
    "Created: / 09-01-2019 / 17:35:14 / Claus Gittinger"
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3509
!
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3510
12565
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3511
to:stop collect:aBlock
16347
ac28cfa26ec2 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16293
diff changeset
  3512
    "syntactic sugar; same as (self to:stop) collect:aBlock"
12565
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3513
23594
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3514
    ^ (self to:stop) collect:aBlock as:Array
12565
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3515
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3516
    "
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3517
     1 to:10 collect:[:i | i squared]
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3518
     10 to:20 collect:[:i | i squared]
12565
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3519
     (10 to:20) collect:[:i | i squared]
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3520
    "
23594
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3521
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3522
    "Modified (format): / 09-01-2019 / 17:51:04 / Claus Gittinger"
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3523
!
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3524
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3525
to:stop collect:aBlock as:collectionClass
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3526
    "syntactic sugar; same as (self to:stop) collect:aBlock"
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3527
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3528
    ^ (self to:stop) collect:aBlock as:collectionClass
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3529
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3530
    "
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3531
     1 to:10 collect:[:i | i squared] as:Set
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3532
    "
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3533
ff0d98899172 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23556
diff changeset
  3534
    "Created: / 09-01-2019 / 17:51:17 / Claus Gittinger"
12565
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3535
! !
11eea3f4ef0b added: #to:collect:
Claus Gittinger <cg@exept.de>
parents: 12480
diff changeset
  3536
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3537
!Integer methodsFor:'misc math'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3538
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3539
acker:n
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3540
    "return the value of acker(self, n).
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  3541
     ;-) Do not try with receivers > 3"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3542
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3543
    (self == 0) ifTrue:[^ n + 1].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3544
    (n == 0) ifTrue:[^ (self - 1) acker: 1].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3545
    ^ (self - 1) acker:(self acker:(n - 1))
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3546
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3547
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3548
     3 acker:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3549
     3 acker:7
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3550
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3551
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3552
    "Modified: 18.7.1996 / 13:08:16 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3553
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3554
11491
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  3555
binco:kIn
13023
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  3556
    "an alternative name for the binomial coefficient for squeak compatibility"
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  3557
11491
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  3558
    ^ self binomialCoefficient:kIn
13023
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  3559
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  3560
    "Modified: / 17-08-2010 / 17:29:07 / cg"
11491
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  3561
!
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  3562
19040
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3563
binomialCoefficient:k
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3564
    "The binomial coefficient (n over k)
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3565
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3566
      / n \     with self being n, and 0 <= k <= n.
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3567
      \ k /
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3568
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3569
     is the number of ways of picking k unordered outcomes from n possibilities,
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3570
     also known as a combination or combinatorial number.
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3571
     Sometimes also called C(n,k) (for choose k from n)
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3572
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3573
     binCo is defined as:
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3574
        n!!
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3575
     ----------
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3576
     k!! (n-k)!!
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3577
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3578
     but there is a faster, recursive formula:
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3579
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3580
      / n \  = / n - 1 \  + / n - 1 \
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3581
      \ k /    \ k - 1 /    \   k   /
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3582
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3583
     with:
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3584
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3585
      / n \  = / n \  =  1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3586
      \ 0 /    \ n /
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3587
    "
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3588
19040
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3589
    |kRun acc|
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3590
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3591
    k > self ifTrue:[^ 0].
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3592
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3593
    kRun := k.
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3594
    kRun > (self / 2) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3595
        "/ symmetry
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3596
        kRun := self - kRun.
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3597
    ].
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3598
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3599
    acc := 1.
19040
80a45e8ef510 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19015
diff changeset
  3600
    1 to:kRun do:[:i |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3601
        acc := acc * (self - kRun + i) / i.
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3602
    ].
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3603
    ^ acc
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3604
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3605
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3606
     (7 binomialCoefficient:3)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3607
     (10 binomialCoefficient:5)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3608
     (100 binomialCoefficient:5)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3609
     (1000 binomialCoefficient:5)
24697
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  3610
     (100000 binomialCoefficient:100000)
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  3611
     (0 binomialCoefficient:0)
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3612
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3613
     TestCase assert: (10 binomialCoefficient:5) = (10 factorial / (5 factorial * 5 factorial))
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3614
     TestCase assert: (100 binomialCoefficient:78) = (100 factorial / (78 factorial * (100-78) factorial))
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3615
     TestCase assert: (1000 binomialCoefficient:5) = (1000 factorial / (5 factorial * (1000-5) factorial))
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3616
     TestCase assert: (10000 binomialCoefficient:78) = (10000 factorial / (78 factorial * (10000-78) factorial))
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3617
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3618
     Time millisecondsToRun:[ (10000 binomialCoefficient:78) ]                            -> 0
19252
7e0b6ccb0d81 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19251
diff changeset
  3619
     Time millisecondsToRun:[ (10000 factorial / (78 factorial * (10000-78) factorial)) ] -> 130
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  3620
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3621
    "
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3622
!
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  3623
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3624
divMod:aNumber
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3625
    "return an array filled with
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3626
        (self // aNumber) and (self \\ aNumber).
17037
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3627
     The returned remainder has the same sign as aNumber.
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3628
     The following is always true:
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3629
        (receiver // something) * something + (receiver \\ something) = receiver
17037
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3630
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3631
     Be careful with negative results: 9 // 4 -> 2, while -9 // 4 -> -3.
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3632
     Especially surprising:
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3633
        -1 \\ 10 -> 9  (because -(1/10) is truncated towards next smaller integer, which is -1,
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3634
                        and -1 multiplied by 10 gives -10, so we have to add 9 to get the original -1).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3635
        -10 \\ 3 -> 2 (because -(10/3) is truncated towards next smaller integer, which is -4,
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3636
                        and -4 * 4 gives -12, so we need to add 2 to get the original -10.
17037
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3637
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3638
     This may be redefined in some integer classes for
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3639
     more performance (where the remainder is generated as a side effect of division)"
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3640
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3641
    ^ Array
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3642
        with:(self // aNumber)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3643
        with:(self \\ aNumber)
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3644
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3645
    "
17037
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3646
     10 divMod:3       -> #(3 1)   because 3*3 + 1 = 10
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3647
     10 divMod:-3      -> #(-4 -2) because -4*-3 + (-2) = 10
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  3648
     -10 divMod:3      -> #(-4 2) because -4*-3 + 2 = -10
17037
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3649
     -10 divMod:-3     -> #(3 -1)  because -3*3 + (-1) = -10
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3650
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3651
     1000000000000000000000 divMod:3   -> #(333333333333333333333 1)
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3652
     1000000000000000000000 divMod:-3  -> #(-333333333333333333334 -2)
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3653
     -1000000000000000000000 divMod:3  -> #(-333333333333333333334 2)
5338279e3c58 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16886
diff changeset
  3654
     -1000000000000000000000 divMod:-3 -> #(333333333333333333333 -1)
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3655
     100 factorial divMod:103
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3656
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3657
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3658
    "Modified: 29.10.1996 / 21:18:58 / cg"
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3659
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3660
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3661
extendedEuclid:tb
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3662
    "return the solution of 'ax + by = gcd(a,b)'.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3663
     An array containing x, y and gcd(a,b) is returned."
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3664
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3665
    |a b gcd gcd1 u u1 v v1 tmp t swap shift "{SmallInteger}"|
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3666
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  3667
    self < tb ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3668
        a := self.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3669
        b := tb.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3670
        swap := false.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3671
    ] ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3672
        a := tb.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3673
        b := self.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3674
        swap := true.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3675
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3676
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3677
    shift := ((a lowBit) min:(b lowBit))-1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3678
    shift > 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3679
        tmp := shift negated.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3680
        a := a bitShift:tmp.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3681
        b := b bitShift:tmp.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3682
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3683
9057
13bd29f579c6 Bug 343: #clearBit: changed the receiver (shouldn't do that).
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  3684
    gcd  := a.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3685
    gcd1 := b.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3686
    u := 1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3687
    u1 := 0.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3688
    v := 0.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3689
    v1 := 1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3690
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3691
    [
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3692
        "/      The following condition is true:
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3693
        "/        (a * u1) + (b * v1) ~= gcd1 ifTrue:[self halt].
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3694
        t := gcd1 divMod:gcd.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3695
        gcd1 := gcd.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3696
        gcd := t at:2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3697
        t := t at:1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3698
        tmp := v.
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3699
        "/ v1 - (v * t) - v1 + (v * t) ~= 0 ifTrue:[self halt].
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3700
        v := v1 - (v * t).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3701
        v1 := tmp.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3702
        tmp := u.
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3703
        "/ u1 - (u * t) - u1 + (u * t) ~= 0 ifTrue:[self halt].
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3704
        u := u1 - (u * t).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3705
        u1 := tmp.
9057
13bd29f579c6 Bug 343: #clearBit: changed the receiver (shouldn't do that).
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  3706
    gcd > 0] whileTrue.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3707
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3708
    shift > 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3709
        gcd1 := gcd1 bitShift:shift.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3710
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3711
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3712
    swap ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3713
        ^ Array with:v1 with:u1 with:gcd1.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3714
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3715
    ^ Array with:u1 with:v1 with:gcd1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3716
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3717
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3718
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3719
     14 extendedEuclid:5
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3720
     14 extendedEuclid:2
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3721
     25 extendedEuclid:15
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3722
    "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3723
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3724
    "Created: / 27.4.1999 / 15:19:22 / stefan"
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  3725
    "Modified: / 18.11.1999 / 16:19:24 / stefan"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3726
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3727
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3728
factorial
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3729
    "return fac(self) (i.e. 1*2*3...*self).
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3730
     This chooses a good algorithm, based on the receiver.
19337
548386843c2e #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19327
diff changeset
  3731
     Some heuristics here, which has to do with the speed of largeInteger arithmetic."
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3732
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3733
    (self <= 20) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3734
        self < 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3735
            "/
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3736
            "/ requested factorial of a negative number
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3737
            "/
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3738
            ^ self class
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3739
                raise:#domainErrorSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3740
                receiver:self
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3741
                selector:#factorial
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3742
                arguments:#()
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3743
                errorString:'factorial of negative number'
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3744
        ].
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3745
        ^ #(1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3746
          479001600 6227020800 87178291200 1307674368000 20922789888000 
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3747
          355687428096000 6402373705728000 121645100408832000
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3748
          2432902008176640000) at:self+1
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3749
    ].
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3750
    
19163
b45df3976f74 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19161
diff changeset
  3751
"/    self < 80000 ifTrue:[
b45df3976f74 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19161
diff changeset
  3752
"/        ^ self factorialHalf
b45df3976f74 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19161
diff changeset
  3753
"/    ].    
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3754
    ^ self factorialEvenOdd
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3755
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3756
    "
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3757
     10 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3758
     100 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3759
     1000 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3760
     10000 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3761
     100000 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3762
     200000 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3763
     300000 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3764
     1000000 factorial
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3765
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3766
     Time millisecondsToRun:[10000 factorial]40
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3767
     Time millisecondsToRun:[100000 factorial]3220
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3768
     Time millisecondsToRun:[1000000 factorial]357120
19164
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3769
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3770
    #(factorialIter factorialHalf factorialEvenOdd factorial)
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3771
    do:[:sel |
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3772
      #( (10000 10) 
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3773
         (20000 10)
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3774
         (50000 10)
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3775
         (70000 10)
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3776
         (100000 5)
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3777
         (200000 3)
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3778
         (300000 3)
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3779
         (400000 3)) pairsDo:[:n :repeat |
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3780
         |times|
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3781
        times := (1 to:repeat) collect:[:i |
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3782
                Time millisecondsToRun:[ n perform:sel]
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3783
               ].
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3784
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3785
        Transcript printf:'%12s %6d: %5d\n' with:sel with:n with:times min 
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3786
      ]
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3787
    ].
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3788
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3789
    factorialIter  10000:    30
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3790
    factorialIter  20000:   130
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3791
    factorialIter  50000:   790
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3792
    factorialIter  70000:  1710
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3793
    factorialIter 100000:  4880
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3794
    factorialIter 200000: 24980
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3795
    factorialIter 300000: 60060
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3796
    factorialIter 400000: 112310
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3797
    factorialHalf  10000:    20
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3798
    factorialHalf  20000:   100
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3799
    factorialHalf  50000:   690
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3800
    factorialHalf  70000:  1430
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3801
    factorialHalf 100000:  3220
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3802
    factorialHalf 200000: 28340
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3803
    factorialHalf 300000: 68740
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3804
    factorialHalf 400000: 127490
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3805
    factorialEvenOdd  10000:    10
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3806
    factorialEvenOdd  20000:    60
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3807
    factorialEvenOdd  50000:   390
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3808
    factorialEvenOdd  70000:   810
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3809
    factorialEvenOdd 100000:  2020
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3810
    factorialEvenOdd 200000:  9960
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3811
    factorialEvenOdd 300000: 24480
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3812
    factorialEvenOdd 400000: 45340
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3813
    factorial  10000:    20
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3814
    factorial  20000:   100
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3815
    factorial  50000:   680
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3816
    factorial  70000:  1400
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3817
    factorial 100000:  2040
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3818
    factorial 200000: 10130
16e88ae992a1 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19163
diff changeset
  3819
    factorial 300000: 24670
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3820
    "
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3821
!
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3822
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3823
factorialEvenOdd
22166
a12fdc37c2cf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22118
diff changeset
  3824
    "a recursive odd-even algorithm, which processes smaller largeInts in the loop.
a12fdc37c2cf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22118
diff changeset
  3825
     Because multiplication is an O(n^2) algorithm, there is a threshold from which
a12fdc37c2cf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22118
diff changeset
  3826
     more but smaller multiplications makes a noticable difference"
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3827
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3828
    |pO i s2 t stop|
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3829
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3830
    (self <= 20) ifTrue:[
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3831
        ^ #(1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3832
          479001600 6227020800 87178291200 1307674368000 20922789888000 
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3833
          355687428096000 6402373705728000 121645100408832000
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3834
          2432902008176640000) at:self+1
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3835
    ].
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3836
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3837
    "/
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3838
    "/ 3 * 4 * 5 * 6 *7 * 8 .... * n
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3839
    "/ odd numbers:
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3840
    "/   3 5 7 9 ... n
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3841
    "/ even numbers:
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3842
    "/   2 4 6 8 ... n
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3843
    "/   1 2 3 4 ... n//2
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3844
    "/ is (n/2)!! << n-1
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3845
                 
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3846
    pO := 1.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3847
    i := 3.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3848
 
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3849
    "/ odds only in pairs as
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3850
    "/      i * (i + 2)
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3851
    "/ to get to the next pair,
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3852
    "/      (i+4)(i+6)
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3853
    "/ we add: 8i + 24
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3854
    "/ (i+4)(i+6)-(i*(i+2))
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3855
    "/ i^2 + 10i + 24 - i^2 - 2i
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3856
    "/ 8i + 24
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3857
    stop := self-2.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3858
    t := i*(i+2).
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3859
    [i <= stop] whileTrue:[
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3860
        "/ odd*next odd
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3861
        pO := pO * t.
19163
b45df3976f74 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19161
diff changeset
  3862
        t := t + ((i*8) + 24).
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3863
        i := i + 4.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3864
    ].
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3865
    
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3866
    [i <= self] whileTrue:[
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3867
        "/ odd
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3868
        pO := pO * i.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3869
        i := i + 2.
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3870
    ].
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3871
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3872
    "/ the factorial of the evens...
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3873
    s2 := (self//2).
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3874
    ^ (s2 factorialEvenOdd * pO) << s2.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3875
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3876
    "
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3877
     (6 to:2000) conform:[:i | i factorialIter = i factorialEvenOdd]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3878
     
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3879
     Time millisecondsToRun:[20000 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3880
     Time millisecondsToRun:[50000 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3881
     Time millisecondsToRun:[70000 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3882
     Time millisecondsToRun:[100000 factorialIter]
23646
efcbc4fd9032 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23594
diff changeset
  3883
     Time millisecondsToRun:[200000 factorialIter] 16190
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3884
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3885
     Time millisecondsToRun:[20000 factorialEvenOdd]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3886
     Time millisecondsToRun:[50000 factorialEvenOdd]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3887
     Time millisecondsToRun:[70000 factorialEvenOdd]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3888
     Time millisecondsToRun:[100000 factorialEvenOdd]
23646
efcbc4fd9032 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23594
diff changeset
  3889
     Time millisecondsToRun:[200000 factorialEvenOdd] 2910
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3890
    "
22166
a12fdc37c2cf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22118
diff changeset
  3891
a12fdc37c2cf #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22118
diff changeset
  3892
    "Modified (comment): / 05-07-2017 / 16:41:41 / cg"
23646
efcbc4fd9032 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23594
diff changeset
  3893
    "Modified (comment): / 26-01-2019 / 08:48:12 / Claus Gittinger"
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3894
!
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3895
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3896
factorialHalf
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  3897
    "an algorithm, which does it with half the number of multiplications.
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3898
     this is faster than factorialPM to roughly 60000."
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3899
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3900
    |p i d|
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3901
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3902
    i := self.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3903
    self odd ifTrue:[
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3904
        i := i - 1.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3905
    ].
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  3906
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3907
    p := i.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3908
    d := i - 2.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3909
    [d >= 2] whileTrue:[
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3910
        i := i + d.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3911
        p := p * i.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3912
        d := d - 2.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3913
    ].
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3914
    self odd ifTrue:[
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3915
        p := p * self
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  3916
    ].
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3917
    ^ p
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3918
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3919
    "
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3920
     10 factorial 3628800
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3921
     10 factorialHalf 3628800
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  3922
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3923
     11 factorial 39916800
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3924
     11 factorialHalf 39916800
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3925
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3926
     12 factorial 479001600
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  3927
     12 factorialHalf 479001600
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3928
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3929
     10000 factorial = 10000 factorialHalf
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3930
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3931
     (6 to:2000) conform:[:i | i factorialIter = i factorialHalf]
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  3932
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3933
     Time microsecondsToRun:[30 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3934
     Time microsecondsToRun:[30 factorialHalf]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3935
     Time microsecondsToRun:[50 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3936
     Time microsecondsToRun:[50 factorialHalf]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3937
     Time microsecondsToRun:[75 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3938
     Time microsecondsToRun:[75 factorialHalf]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3939
     Time microsecondsToRun:[100 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3940
     Time microsecondsToRun:[100 factorialHalf]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3941
     Time microsecondsToRun:[500 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3942
     Time microsecondsToRun:[500 factorialHalf]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3943
     Time microsecondsToRun:[1000 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3944
     Time microsecondsToRun:[1000 factorialHalf]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3945
     Time microsecondsToRun:[2000 factorialIter]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3946
     Time microsecondsToRun:[2000 factorialHalf]
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3947
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3948
     Time microsecondsToRun:[500 factorial]118 120 120
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3949
     Time microsecondsToRun:[1000 factorial]339 355 406
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3950
     Time microsecondsToRun:[5000 factorial]15703 13669 7715
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3951
     Time millisecondsToRun:[10000 factorial]40 30 50
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3952
     Time millisecondsToRun:[20000 factorial]140 150 150
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3953
     Time millisecondsToRun:[40000 factorial]600 570 560 570
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3954
     Time millisecondsToRun:[60000 factorial]1220 1240 1340
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3955
     Time millisecondsToRun:[80000 factorial]2600 2580 2540
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3956
     Time millisecondsToRun:[100000 factorial]4680 4810 5280
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3957
     Time millisecondsToRun:[120000 factorial]8100 8010 7920
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3958
     Time millisecondsToRun:[150000 factorial]13830 14040 13360
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  3959
     Time millisecondsToRun:[200000 factorial]23880 23740
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3960
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3961
     Time microsecondsToRun:[500 factorialHalf]150 142 192
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3962
     Time microsecondsToRun:[1000 factorialHalf]383 527 684
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3963
     Time microsecondsToRun:[5000 factorialHalf]6654 9221 4629
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3964
     Time millisecondsToRun:[10000 factorialHalf]20 30 20
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3965
     Time millisecondsToRun:[20000 factorialHalf]110 110 110
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3966
     Time millisecondsToRun:[40000 factorialHalf]490 490 490
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3967
     Time millisecondsToRun:[60000 factorialHalf]1100 1090 1070
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3968
     Time millisecondsToRun:[80000 factorialHalf]1920 1920 1880
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3969
     Time millisecondsToRun:[100000 factorialHalf]3030 3010 3000
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3970
     Time millisecondsToRun:[120000 factorialHalf]4830 4770 4760
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3971
     Time millisecondsToRun:[150000 factorialHalf]14510 13940 13900
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  3972
     Time millisecondsToRun:[200000 factorialHalf]28730 28160
19161
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3973
    "
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3974
!
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3975
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3976
factorialIter
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3977
    "return fac(self) (i.e. 1*2*3...*self) using an iterative algorithm.
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3978
     This is slightly faster than the recursive algorithm, and does not
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3979
     suffer from stack overflow problems (with big receivers)"
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3980
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3981
    |p i|
a7f0570d0c3a #FEATURE
Claus Gittinger <cg@exept.de>
parents: 19159
diff changeset
  3982
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3983
    p := 2.
2745
bdf76e380d27 errorString to DomainError
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3984
    i := 3.
bdf76e380d27 errorString to DomainError
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3985
    [i <= self] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3986
        p := p * i.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  3987
        i := i + 1.
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3988
    ].
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3989
    ^ p
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3990
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3991
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3992
     10 factorial
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3993
     1000 factorial
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3994
     10000 factorial
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3995
     10000 factorialR
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  3996
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3997
     Time millisecondsToRun:[2000 factorial]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3998
     Time millisecondsToRun:[2000 factorialR]
2745
bdf76e380d27 errorString to DomainError
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  3999
     -1 factorial
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4000
    "
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4001
10027
36281068b212 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9401
diff changeset
  4002
    "Modified: / 04-10-2006 / 14:31:12 / cg"
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4003
!
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4004
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4005
factorialR
3908
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  4006
    "return fac(self) (i.e. 1*2*3...*self) using a recursive algorithm.
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4007
3908
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  4008
     This is included to demonstration purposes - if you really need
19251
92366c6c52aa #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19231
diff changeset
  4009
     factorial numbers, use the tuned #factorial, which is
3908
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  4010
     faster and does not suffer from stack overflow problems (with big receivers)."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4011
356
claus
parents: 345
diff changeset
  4012
    (self >= 2) ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4013
        ^ self * (self - 1) factorialR
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4014
    ].
356
claus
parents: 345
diff changeset
  4015
    ^ 1
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
  4016
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
  4017
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4018
     10 factorialR
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4019
     1000 factorialR
4158
e04b61500e51 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4151
diff changeset
  4020
     Time millisecondsToRun:[10000 factorial]
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
  4021
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  4022
3908
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  4023
    "Created: / 18.7.1996 / 12:48:36 / cg"
4158
e04b61500e51 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4151
diff changeset
  4024
    "Modified: / 8.5.1999 / 18:40:13 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4025
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4026
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4027
fib
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4028
    "compute the fibionacci number for the receiver.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4029
        fib(0) := 0
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4030
        fib(1) := 1
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4031
        fib(n) := fib(n-1) + fib(n-2)"
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4032
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4033
    self <= 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4034
        self == 0 ifTrue:[^ 0].
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4035
    ].
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4036
    ^ self fib_helper
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4037
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4038
    "
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  4039
     30 fib
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4040
     60 fib
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4041
     1000 fib
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4042
    "
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4043
!
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4044
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4045
fib_helper
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4046
    "compute the fibionacci number for the receiver.
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4047
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4048
        Fib(n) = Fib(n-1) + Fib(n-2)
13023
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4049
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4050
     Knuth:
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4051
        Fib(n+m) = Fib(m) * Fib(n+1) + Fib(m-1) * Fib(n)
13023
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4052
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4053
     This is about 3 times faster than fib_iterative.
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4054
    "
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4055
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4056
    |fibUsingDict dict|
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4057
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4058
    dict := Dictionary new:100.
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4059
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4060
    fibUsingDict := [:x |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4061
        |n fib fibN fibNp1 fibNm1 fibXm1 fibXm2 fibXp1|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4062
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4063
        x <= 30 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4064
                "/ 0 1 2 3 4 5 6  7  8  9 10 11  12  13  14  15  16   17   18   19   20    21    22    23    24    25     26     27     28     29     30
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4065
            fib := #(1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4066
                     ) at:x
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4067
        ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4068
            fib := dict at:x ifAbsent:nil.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4069
            fib isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4070
                fibXm1 := dict at:(x-1) ifAbsent:nil.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4071
                fibXm1 notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4072
                    fibXm2 := dict at:(x-2) ifAbsent:nil.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4073
                    fibXm2 notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4074
                        fib := fibXm1 + fibXm2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4075
                    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4076
                        fibXp1 := dict at:(x+1) ifAbsent:nil.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4077
                        fibXp1 notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4078
                            fib := fibXp1 - fibXm1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4079
                        ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4080
                    ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4081
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4082
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4083
                fib isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4084
                    n := x // 2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4085
                    x odd ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4086
                        "/ m is set to n+1; therefore:
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4087
                        "/ Fib(x) = Fib(n+n+1)      ; x odd; setting n = (x-1)/2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4088
                        "/ using Knuth:
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4089
                        "/ Fib(n+n+1) = Fib(n+1) * Fib(n+1) + Fib(n+1-1) * Fib(n)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4090
                        "/            = (Fib(n+1) ^ 2) + (Fib(n) ^ 2)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4091
                        fibN   := fibUsingDict value:n.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4092
                        fibNp1 := fibUsingDict value:(n+1).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4093
                        fib := fibN squared + fibNp1 squared
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4094
                    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4095
                        "/ as
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4096
                        "/    Fib(n+1) = Fib(n) + Fib(n-1)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4097
                        "/ therefore:
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4098
                        "/    Fib(n) = Fib(n+1) - Fib(n-1)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4099
                        "/ and, since n is even, n+1 and n-1 are odd, and can be computed as above.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4100
                        "/ This gives us:
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4101
                        "/    Fib(x) = Fib(x+1) - Fib(x-1)      ; x even; setting n = x/2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4102
                        "/           = Fib(n+n+1) - Fib(n+n-1)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4103
                        "/           = Fib(n+n+1) - Fib((n-1)+(n-1)+1)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4104
                        "/           = ((Fib(n+1)^2) + (Fib(n)^2)) - ((Fib((n-1)+1)^2) + (Fib((n-1))^2))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4105
                        "/           = (Fib(n+1)^2) + (Fib(n)^2) - (Fib(n)^2) - (Fib((n-1))^2)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4106
                        "/           = (Fib(n+1)^2) - (Fib((n-1))^2)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4107
                        fibNm1 := fibUsingDict value:(n-1).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4108
                        fibNp1 := fibUsingDict value:(n+1).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4109
                        fib := fibNp1 squared - fibNm1 squared
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4110
                    ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4111
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4112
                dict at:x put:fib.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4113
            ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4114
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4115
        fib
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4116
    ].
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4117
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4118
    ^ fibUsingDict value:self
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4119
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4120
    "the running time is mostly dictated by the LargeInteger multiplication performance...
25031
c29683170748 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 25010
diff changeset
  4121
     (therefore, we get O(n²) execution times, even for a linear number of multiplications)
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4122
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4123
     Time millisecondsToRun:[50000 fib_iterative]  312    (DUO 1.7Ghz CPU)
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4124
     Time millisecondsToRun:[50000 fib_helper]     109
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4125
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  4126
     Time millisecondsToRun:[100000 fib_iterative] 1248
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4127
     Time millisecondsToRun:[100000 fib_helper]    374
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4128
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  4129
     Time millisecondsToRun:[200000 fib_iterative] 4758
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4130
     Time millisecondsToRun:[200000 fib_helper]    1544
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4131
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  4132
     Time millisecondsToRun:[400000 fib_iterative] 18892
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4133
     Time millisecondsToRun:[400000 fib_helper]    6084
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4134
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4135
     1 to:100 do:[:i | self assert:(i fib_iterative = i fib_helper) ]
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4136
     1 to:100 do:[:i | self assert:(i fib_iterative = i fib) ]
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4137
    "
13023
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4138
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4139
    "Modified: / 17-08-2010 / 17:29:34 / cg"
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4140
!
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4141
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4142
gcd:anInteger
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  4143
    "return the greatest common divisor of the receiver and anInteger.
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  4144
     Euclids & Knuths algorithm."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4145
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4146
    |a b t|
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4147
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4148
    a := self abs.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4149
    b := anInteger abs.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4150
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4151
    a < b ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4152
        t := a.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4153
        a := b.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4154
        b := t.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4155
    ].
52
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  4156
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4157
    b = 0 ifTrue: [^ a].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4158
    a := a \\ b.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4159
    a = 0 ifTrue:[^ b].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4160
    ^ b gcd_helper:a
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4161
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4162
    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4163
     3141589999999999 gcd:1000000000000000
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4164
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4165
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4166
        10000 timesRepeat:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4167
           123456789012345678901234567890 gcd: 9876543210987654321
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4168
        ]
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4169
     ]
3060
0faf242e1142 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  4170
    "
0faf242e1142 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  4171
0faf242e1142 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  4172
    "Modified: / 25.10.1997 / 16:08:45 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4173
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4174
21938
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4175
integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4176
    "return the floor of log10 of the receiver.
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4177
     This is the same as (self log:10) floor.
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4178
     Used to find out the number of digits needed
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4179
     to print a number/and for conversion to a LargeInteger."
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4180
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4181
    ^ self asFloat log10 floor
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4182
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4183
    "
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4184
      10 integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4185
      1000 integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4186
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4187
      10000000000000000.0 log:10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4188
      10000000000000000 integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4189
      100000000000000000 integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4190
      1000000000000000000 integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4191
      10000000000000000000 integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4192
      100000000000000000000 integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4193
      1000000000000000000000 integerLog10 -> 21
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4194
      1000000000000000000000000000000 integerLog10 -> 30
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4195
      10000000000000000000000000000000000000000 integerLog10 -> 40
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4196
      
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4197
      1 to:10000 by:10 do:[:i |
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4198
        self assert:(i factorial printString size == (i factorial integerLog10+1))
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4199
      ].
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4200
      21 factorial printString size
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4201
      21 factorial integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4202
      51 factorial printString size
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4203
      51 factorial integerLog10
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4204
    "
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4205
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4206
    "Created: / 02-07-2017 / 01:20:49 / cg"
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4207
    "Modified: / 02-07-2017 / 10:16:40 / cg"
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4208
!
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4209
14097
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4210
integerLog2
14491
97b9228d2464 changed: #integerLog2
Claus Gittinger <cg@exept.de>
parents: 14448
diff changeset
  4211
    "return the floor of log2 of the receiver.
97b9228d2464 changed: #integerLog2
Claus Gittinger <cg@exept.de>
parents: 14448
diff changeset
  4212
     This is the same as (self log:2) floor."
14097
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4213
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4214
    self <= 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4215
        ^ self class
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4216
            raise:#domainErrorSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4217
            receiver:self
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4218
            selector:#integerLog2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4219
            arguments:#()
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4220
            errorString:'logarithm of negative integer'
14097
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4221
    ].
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4222
    ^ self highBit - 1.
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4223
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4224
    "
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4225
      2  log:2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4226
      2  integerLog2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4227
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4228
      3  log:2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4229
      3  integerLog2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4230
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4231
      4  log:2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4232
      4  integerLog2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4233
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4234
      64  integerLog2
14097
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4235
      100 integerLog2
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4236
      100 log:2
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4237
      999 integerLog2
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4238
      999 log:2
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4239
      120000 integerLog2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4240
      120000 log:2
14097
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4241
      -1 integerLog2
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4242
      50 factorial integerLog2
14767
157f37c1a7f9 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14680
diff changeset
  4243
      50 factorial log:2
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4244
      1000 factorial integerLog2
14767
157f37c1a7f9 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14680
diff changeset
  4245
      1000 factorial log:2       -- float error!!
14097
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4246
    "
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4247
!
Stefan Vogel <sv@exept.de>
parents: 14043
diff changeset
  4248
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4249
integerReciprocal
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4250
    "return an integer representing 1/self * 2**n.
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4251
     Where an integer is one bit longer than self.
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4252
     This is a helper for modulu numbers"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4253
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4254
    |b "{Class: SmallInteger}" rem result digitBytes|
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4255
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4256
    b := self highBit.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4257
    rem := 1 bitShift:b.
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  4258
    result := LargeInteger basicNew numberOfDigits:(b // 8)+1.
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4259
    digitBytes := result digitBytes.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4260
    b+1 to:1 by:-1 do:[:idx|
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4261
        rem >= self ifTrue:[
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4262
            rem := rem - self.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4263
            digitBytes bitSetAt:idx.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4264
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4265
        rem := rem mul2.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4266
    ].
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4267
    ^ result compressed.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4268
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4269
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4270
     333 integerReciprocal                (2 raisedTo:18) // 333
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4271
     393 integerReciprocal
11945
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  4272
     8 integerReciprocal
8697e2333da3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11938
diff changeset
  4273
     15 integerReciprocal
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4274
     15112233445566 integerReciprocal
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4275
     10239552311579 integerReciprocal
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4276
   "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4277
13023
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4278
    "Modified: / 03-05-1999 / 14:27:18 / stefan"
c7b914e6ed2b comment/format
Claus Gittinger <cg@exept.de>
parents: 13022
diff changeset
  4279
    "Modified: / 17-08-2010 / 17:30:22 / cg"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4280
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4281
12588
fa4fb7a41047 added: #integerSqrt
Claus Gittinger <cg@exept.de>
parents: 12586
diff changeset
  4282
integerSqrt
21931
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4283
    "return the largest integer which is less or equal to the receiver's square root.
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4284
     For large integers, this provides better results than the float sqrt method 
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4285
     (which actually fails for very large numbers)
12586
1b8a0ecda4f2 changed: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12585
diff changeset
  4286
     This might be needed for some number theoretic problems with large numbers
21931
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4287
     (and also in cryptography). 
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4288
     Uses Newton's method"
12586
1b8a0ecda4f2 changed: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12585
diff changeset
  4289
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4290
    |guess|
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4291
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4292
    self negative ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4293
        ^ self class
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4294
            raise:#imaginaryResultSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4295
            receiver:self
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4296
            selector:#integerSqrt
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4297
            arguments:#()
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4298
            errorString:'bad (negative) receiver in sqrt'
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4299
    ].
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4300
    self == 0 ifTrue:[^ 0].
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  4301
12582
7afa0bb19bbe comment/format in: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12581
diff changeset
  4302
    guess := (1 bitShift:(self highBit // 2)).
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4303
    ^ self integerSqrtWithGuess:guess
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4304
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4305
    "
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4306
     333 sqrt -> 18.2482875908947
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4307
     324 sqrt -> 18.0
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4308
     323 sqrt -> 17.9722007556114
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4309
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4310
     333 integerSqrt -> 18
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4311
     325 integerSqrt -> 18
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4312
     324 integerSqrt -> 18
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4313
     323 integerSqrt -> 17
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4314
     
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4315
     10239552004900 integerSqrt
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4316
     10239552004900 sqrt
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4317
     10239552311579 integerSqrt
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4318
     10239552311579 sqrt
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4319
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4320
     5397346292805549782720214077673687804022210808238353958670041357153884304 integerSqrt squared
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4321
     5397346292805549782720214077673687804022210808238353958670041357153884304 sqrt squared
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4322
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4323
     5397346292805549782720214077673687806275517530364350655459511599582614290 integerSqrt
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4324
     5397346292805549782720214077673687806275517530364350655459511599582614290 sqrt
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4325
     1000 factorial integerSqrt
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4326
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4327
     1000 factorial - 1000 factorial integerSqrt squared
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4328
     1000 factorial - (1000 factorial integerSqrt + 1) squared
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4329
     1000 factorial between:(1000 factorial integerSqrt squared) and:((1000 factorial integerSqrt + 1) squared)
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4330
   "
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4331
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4332
    "Modified (comment): / 25-07-2017 / 17:52:14 / cg"
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4333
!
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4334
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4335
integerSqrtWithGuess:initialGuess
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4336
    "return the largest integer which is less or equal to the receiver's square root.
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4337
     For large integers, this provides better results than the float sqrt method 
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4338
     (which actually fails for very large numbers)
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4339
     This might be needed for some number theoretic problems with large numbers
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4340
     (and also in cryptography). 
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4341
     Uses Newton's method"
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4342
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4343
    |guess prevGuess guessSquared|
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4344
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4345
    guess := initialGuess.
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  4346
    prevGuess := nil.
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4347
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4348
    [
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4349
        prevGuess ~= guess
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4350
        and:[ ((guessSquared := guess squared) - self) abs >= guess ]
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4351
    ] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4352
        prevGuess := guess.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4353
        guess := (guess + (self / guess)) // 2.
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4354
    ].
12586
1b8a0ecda4f2 changed: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12585
diff changeset
  4355
    guessSquared > self ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4356
        guess := guess - 1.
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4357
    ].
12585
e8ce2be6049a changed: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12582
diff changeset
  4358
    "/ self assert:(guess squared <= self).
e8ce2be6049a changed: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12582
diff changeset
  4359
    "/ self assert:((guess + 1) squared > self).
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4360
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4361
    ^ guess.
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4362
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4363
    "
22107
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4364
     333 sqrt -> 18.2482875908947
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4365
     324 sqrt -> 18.0
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4366
     323 sqrt -> 17.9722007556114
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4367
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4368
     333 integerSqrt -> 18
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4369
     325 integerSqrt -> 18
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4370
     324 integerSqrt -> 18
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4371
     323 integerSqrt -> 17
21931
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4372
     
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4373
     10239552004900 integerSqrt
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4374
     10239552004900 sqrt
12588
fa4fb7a41047 added: #integerSqrt
Claus Gittinger <cg@exept.de>
parents: 12586
diff changeset
  4375
     10239552311579 integerSqrt
21931
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4376
     10239552311579 sqrt
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4377
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4378
     5397346292805549782720214077673687804022210808238353958670041357153884304 integerSqrt squared
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4379
     5397346292805549782720214077673687804022210808238353958670041357153884304 sqrt squared
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4380
12588
fa4fb7a41047 added: #integerSqrt
Claus Gittinger <cg@exept.de>
parents: 12586
diff changeset
  4381
     5397346292805549782720214077673687806275517530364350655459511599582614290 integerSqrt
21931
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4382
     5397346292805549782720214077673687806275517530364350655459511599582614290 sqrt
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4383
     1000 factorial integerSqrt
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4384
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4385
     1000 factorial - 1000 factorial integerSqrt squared
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4386
     1000 factorial - (1000 factorial integerSqrt + 1) squared
21931
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4387
     1000 factorial between:(1000 factorial integerSqrt squared) and:((1000 factorial integerSqrt + 1) squared)
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4388
   "
21931
ef85a23c6c15 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 21903
diff changeset
  4389
22107
7cb478fcbdfa #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22073
diff changeset
  4390
    "Modified (comment): / 25-07-2017 / 17:52:14 / cg"
12581
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4391
!
3ce7fc818873 added: #integerSquareRoot
Claus Gittinger <cg@exept.de>
parents: 12565
diff changeset
  4392
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4393
inverseMod:n
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4394
    "find the modular inverse for myself to n.
11896
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4395
     This is defined as the solution of: '1 = (self * x) mod n.
1c504810ba9c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11858
diff changeset
  4396
     This is a helper for modulu numbers"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4397
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4398
    |e ret|
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4399
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  4400
    "the following expression returns #(x y (self gcd:n)), the solution of the equation
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  4401
     (self * x) + (n * y) = self gcd:n"
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  4402
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4403
    e := self extendedEuclid:n.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4404
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4405
    (e at:3) == 1 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4406
        ret := e at:1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4407
        ret negative ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4408
            ^ ret + n
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4409
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4410
        ^ ret.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4411
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4412
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4413
    ^ 0
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4414
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4415
    "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4416
     14 inverseMod:5      -> 4
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4417
     5 inverseMod:14      -> 3
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4418
     14 inverseMod:11     -> 4                (4 * 14) \\ 11
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4419
     11 inverseMod:14     -> 9                (9 * 11) \\ 14
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4420
     79 inverseMod:3220   -> 1019
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4421
     3220 inverseMod:79   -> 54               (54 * 3220) \\ 79
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4422
     1234567891 inverseMod:1111111111119
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4423
                          -> 148726663534     (148726663534*1234567891) \\ 1111111111119
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4424
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4425
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4426
     14 extendedEuclid:11
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4427
     5 extendedEuclid:14
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4428
     14 extendedEuclid:2
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4429
     3220 extendedEuclid:79
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4430
    "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4431
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4432
    "Created: / 27.4.1999 / 15:19:22 / stefan"
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  4433
    "Modified: / 18.11.1999 / 16:21:37 / stefan"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4434
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  4435
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4436
lcm:anInteger
52
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  4437
    "return the least common multiple (using gcd:)"
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  4438
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  4439
    ^ (self * anInteger) abs // (self gcd: anInteger)
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  4440
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4441
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4442
     65 lcm:15
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4443
     3 lcm:15
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4444
    "
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4445
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4446
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4447
primeFactors
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4448
    "return a collection of prime factors of the receiver.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4449
     For prime numbers, an empty collection is returned.
13021
1cbf4cdfc288 comment/format
Claus Gittinger <cg@exept.de>
parents: 12978
diff changeset
  4450
     Can take a long time for big numbers"
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4451
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4452
    ^ self primeFactorsUpTo:nil
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4453
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4454
    "
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4455
     2 to:10000 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4456
        self assert:((n isPrime and:[ n primeFactors isEmpty])
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4457
                    or:[ n isPrime not and:[n primeFactors product = n]])
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4458
     ]
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4459
     3 to:10000 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4460
        self assert:(n factorial primeFactors product = n factorial)
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4461
     ]
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4462
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4463
     13195 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4464
     12 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4465
     2 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4466
     3 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4467
     5 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4468
     14 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4469
     13423453625634765 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4470
     13423453625634765 isPrime
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4471
     13423453625634765 gcd:(3 * 5 * 19 * 29)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4472
     13423453625634765 / 8265
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4473
     1624132320101 isPrime
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4474
     1624132320101 gcd: 8265
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4475
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4476
     1000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4477
     100000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4478
     1000000000 primeFactors
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4479
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4480
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4481
        1000 timesRepeat:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4482
            10000000000000000000000000000000000000 primeFactors
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4483
        ]
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4484
     ]   421
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4485
    "
13021
1cbf4cdfc288 comment/format
Claus Gittinger <cg@exept.de>
parents: 12978
diff changeset
  4486
1cbf4cdfc288 comment/format
Claus Gittinger <cg@exept.de>
parents: 12978
diff changeset
  4487
    "Modified: / 17-08-2010 / 17:27:33 / cg"
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4488
!
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4489
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4490
primeFactorsUpTo:limitArgOrNil
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4491
    "return a collection of prime factors of the receiver.
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4492
     For prime numbers, an empty collection is returned.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4493
     Can take a long time for big numbers
13021
1cbf4cdfc288 comment/format
Claus Gittinger <cg@exept.de>
parents: 12978
diff changeset
  4494
     (win a nobel price, if you find something quick (*)
1cbf4cdfc288 comment/format
Claus Gittinger <cg@exept.de>
parents: 12978
diff changeset
  4495
1cbf4cdfc288 comment/format
Claus Gittinger <cg@exept.de>
parents: 12978
diff changeset
  4496
     (*):which does not mean that the code below is optimal - far from it !!"
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4497
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4498
    "See comment in initializePrimeCacheUpTo:limit"
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4499
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  4500
    |rest n factors limit wellKnownPrimes lastPrime checkThisFactor nextTry|
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4501
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4502
    factors := Bag new.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4503
    rest := self.
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4504
    limit := (rest // 2).
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4505
    limitArgOrNil notNil ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4506
        limit := limit min:limitArgOrNil.
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  4507
    ].
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4508
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4509
    "/ try to get the number down fast:
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4510
    n := rest lowBit.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4511
    n ~~ 1 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4512
        self == 2 ifTrue:[^ #() ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4513
        factors add:2 withOccurrences:(n-1).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4514
        rest := rest rightShift:(n-1).
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4515
    ].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4516
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  4517
    checkThisFactor :=
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  4518
        [:prime |
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  4519
            (prime*prime) > rest ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4520
                (rest ~~ 1 and:[factors notEmpty]) ifTrue:[ factors add:rest ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4521
                ^ factors.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4522
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4523
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4524
            [rest \\ prime == 0] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4525
                factors add:prime.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4526
                rest := rest // prime.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4527
                rest == 1 ifTrue:[^ factors].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4528
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4529
            lastPrime := prime.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4530
        ].
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4531
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  4532
    wellKnownPrimes := Integer primesUpTo5000.
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  4533
    limit <= (wellKnownPrimes last+1) ifTrue:[
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  4534
        wellKnownPrimes do:checkThisFactor.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4535
        ^ factors
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4536
    ].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4537
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4538
    "/ actually, all of the code is duplicated; once for primes from a table,
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4539
    "/ and then primes as generated on the fly. The prime generation involves a prime-test,
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4540
    "/ which may slow things down quite a bit.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4541
    "/ (the primesUpTo uses a faster sieve, but can only represent primes to upTo (say)
13022
43a439f72615 comment/format
Claus Gittinger <cg@exept.de>
parents: 13021
diff changeset
  4542
    "/ a few millions).
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4543
11938
79dcaf7ae7ad changed #primeFactorsUpTo:
Claus Gittinger <cg@exept.de>
parents: 11936
diff changeset
  4544
    Integer primesUpTo:(limit min:(1000000 max:Integer primeCacheSize)) do:checkThisFactor.
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4545
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4546
    nextTry := lastPrime + 2.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4547
    [ nextTry <= limit ] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4548
        "/ now, we are beyond the list of pre-generated primes.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4549
        "/ change our strategy to: see if it divides an odd number;
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4550
        "/ if so, add the divisor's prime factors.
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  4551
        (nextTry*nextTry) > rest ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4552
            (rest ~~ 1 and:[factors notEmpty]) ifTrue:[ factors add:rest ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4553
            ^ factors.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4554
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4555
        [(rest \\ nextTry) == 0] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4556
            "/ can only happen relatively late after the last prime,
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4557
            "/ because otherwise, the primeFactors of nextTry would already have
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4558
            "/ been found as divisors.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4559
            "/ first chance is: (lastPrime + 2) squared
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4560
            nextTry < lastPrime squared ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4561
                "/ nextTry is a prime !!
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4562
                factors add:nextTry
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4563
            ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4564
                factors addAll:(nextTry primeFactors).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4565
            ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4566
            rest := rest // nextTry.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4567
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4568
        nextTry := nextTry + 2.
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4569
    ].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4570
    ^ factors
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4571
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4572
    "
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4573
     2 to:10000 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4574
        self assert:((n isPrime and:[ n primeFactors isEmpty])
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4575
                    or:[ n isPrime not and:[n primeFactors product = n]])
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4576
     ]
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4577
     3 to:10000 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4578
        self assert:(n factorial primeFactors product = n factorial)
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4579
     ]
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4580
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4581
     13195 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4582
     12 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4583
     2 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4584
     3 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4585
     5 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4586
     14 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4587
     13423453625634765 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4588
     13423453625634765 isPrime
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4589
     13423453625634765 gcd:(3 * 5 * 19 * 29)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4590
     13423453625634765 / 8265
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4591
     1624132320101 isPrime
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4592
     1624132320101 gcd: 8265
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4593
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4594
     1000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4595
     100000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4596
     1000000000 primeFactors
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4597
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4598
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4599
        1000 timesRepeat:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4600
            10000000000000000000000000000000000000 primeFactors
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4601
        ]
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4602
     ]   421
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4603
    "
13021
1cbf4cdfc288 comment/format
Claus Gittinger <cg@exept.de>
parents: 12978
diff changeset
  4604
13022
43a439f72615 comment/format
Claus Gittinger <cg@exept.de>
parents: 13021
diff changeset
  4605
    "Modified: / 17-08-2010 / 17:28:05 / cg"
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4606
!
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  4607
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4608
raisedTo:exp mod:mod
12280
b2bbbfd2444e added: #raisedTo:modulo:
Stefan Vogel <sv@exept.de>
parents: 12255
diff changeset
  4609
    "return the modulo (remainder) of
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4610
     the receiver raised to exp (an Integer) and mod (another Integer)"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4611
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4612
    |result m t
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4613
     eI   "{Class: SmallInteger}"
5816
ce15ce5294b4 Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5799
diff changeset
  4614
     bits "{Class: SmallInteger}"|
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4615
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4616
    "use the addition chaining algorithm"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4617
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4618
    exp == 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4619
        ^ 1
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4620
    ].
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4621
    exp == 1 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4622
        mod isNumber ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4623
            ^ self \\ mod.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4624
        ]
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4625
    ].
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4626
    exp negative ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4627
        ^ self class
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4628
            raise:#domainErrorSignal
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4629
            receiver:self
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4630
            selector:#raisedTo:mod:
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4631
            arguments:(Array with:exp with:mod)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4632
            errorString:'modulo arithmethic with negative exponent'
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4633
    ].
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4634
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4635
    m := mod asModuloNumber.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4636
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4637
    result := 1.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4638
    t := m modulusOf:self.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4639
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4640
    (exp class == SmallInteger) ifTrue:[
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4641
        eI := exp.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4642
        [eI ~~ 0] whileTrue:[
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4643
            (eI bitAnd:1) == 1 ifTrue:[
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4644
                result := m modulusOf:(result * t).
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4645
            ].
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4646
            eI := eI bitShift:-1.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4647
            eI ~~ 0 ifTrue:[
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4648
                t := m modulusOf:(t * t).
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4649
            ].
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4650
        ].
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4651
        ^ result.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4652
    ].
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4653
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4654
    bits := exp highBit.
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4655
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4656
    1 to:bits-1 do:[:i|
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4657
        (exp bitAt:i) == 1 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4658
            result := m modulusOf:(result * t).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4659
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4660
        t := m modulusOf:(t * t).
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4661
    ].
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4662
    result := m modulusOf:(result * t).
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4663
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4664
    ^ result
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4665
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4666
    "
22561
bdaee5e2bf96 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22469
diff changeset
  4667
     Time millisecondsToRun: [100000 timesRepeat: [12345678907 raisedTo: 3 modulo: 12345678917]]
bdaee5e2bf96 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 22469
diff changeset
  4668
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4669
     2 raisedTo:2 mod:3
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4670
      20000000000000 raisedTo:200 mod:190  ->  30
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4671
     (20000000000000 raisedTo:200) \\ 190
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4672
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4673
      Time millisecondsToRun:[10000 timesRepeat:[
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4674
                                200000000000000000000000 raisedTo:65537 mod:1900000000000000000000000
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4675
                              ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4676
                             ]
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4677
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  4678
     Time millisecondsToRun:[1000 timesRepeat:[
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4679
                                (200000000000000000000000 raisedTo:65537) \\ 1900000000000000000000000
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4680
                             ]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4681
                            ]
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4682
    "
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4683
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4684
    "Created: / 27.4.1999 / 15:19:22 / stefan"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4685
    "Modified: / 5.5.1999 / 11:18:20 / stefan"
6195
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6055
diff changeset
  4686
    "Modified: / 16.11.2001 / 14:15:21 / cg"
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4687
!
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4688
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4689
raisedToCrtModP:p q:q ep:ep eq:eq u:u
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4690
    "Application of the Chinese Remainder Theorem (CRT).
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4691
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4692
     This is a faster modexp for moduli with a known factorisation into two
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4693
     relatively prime factors p and q, and an input relatively prime to the
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4694
     modulus, the Chinese Remainder Theorem to do the computation mod p and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4695
     mod q, and then combine the results.  This relies on a number of
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4696
     precomputed values, but does not actually require the modulus n or the
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4697
     exponent e.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4698
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4699
     expout = expin ^ e mod (p*q).
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4700
     We form this by evaluating
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4701
     p2 = (expin ^ e) mod p and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4702
     q2 = (expin ^ e) mod q
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4703
     and then combining the two by the CRT.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4704
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4705
     Two optimisations of this are possible.  First, we can reduce expin
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4706
     modulo p and q before starting.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4707
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4708
     Second, since we know the factorisation of p and q (trivially derived
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4709
     from the factorisation of n = p*q), and expin is relatively prime to
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4710
     both p and q, we can use Euler's theorem, expin^phi(m) = 1 (mod m),
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4711
     to throw away multiples of phi(p) or phi(q) in e.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4712
     Letting ep = e mod phi(p) and
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4713
              eq = e mod phi(q)
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4714
     then combining these two speedups, we only need to evaluate
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4715
     p2 = ((expin mod p) ^ ep) mod p and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4716
     q2 = ((expin mod q) ^ eq) mod q.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4717
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4718
     Now we need to apply the CRT.  Starting with
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4719
     expout = p2 (mod p) and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4720
     expout = q2 (mod q)
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4721
     we can say that expout = p2 + p * k, and if we assume that 0 <= p2 < p,
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4722
     then 0 <= expout < p*q for some 0 <= k < q.  Since we want expout = q2
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4723
     (mod q), then p*k = q2-p2 (mod q).  Since p and q are relatively prime,
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4724
     p has a multiplicative inverse u mod q.  In other words, u = 1/p (mod q).
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4725
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4726
     Multiplying by u on both sides gives k = u*(q2-p2) (mod q).
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4727
     Since we want 0 <= k < q, we can thus find k as
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4728
     k = (u * (q2-p2)) mod q.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4729
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4730
     Once we have k, evaluating p2 + p * k is easy, and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4731
     that gives us the result
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4732
    "
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4733
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4734
    |result t mp mq|
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4735
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4736
    mp := p asModuloNumber.
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4737
    result := self raisedTo:ep mod:mp.
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4738
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4739
    mq := q asModuloNumber.
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  4740
    t := self raisedTo:eq mod:mq.
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4741
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4742
    "now p2 is in result, q2 in t"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4743
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4744
    t := t - result.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4745
    t negative ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4746
        t := t + q.
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4747
    ].
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4748
    t := t * u.
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4749
    t := mq modulusOf:t.
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4750
    t := t * p.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  4751
    result := result + t.
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4752
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4753
    ^ result.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4754
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4755
    "Created: / 30.4.1999 / 15:53:15 / stefan"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  4756
    "Modified: / 5.5.1999 / 11:01:15 / stefan"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4757
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4758
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4759
!Integer methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4760
16038
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4761
asBCD
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4762
    "return an integer which represents the BCD encoded value of the receiver;
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4763
     that is: each digit of its decimal representation is placed into a nibble
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4764
     of the result. (aka 162 -> 0x162).
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4765
     This conversion is useful for some communication protocols,
16040
4708e4544528 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16038
diff changeset
  4766
     or control systems, which represent numbers this way...
4708e4544528 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16038
diff changeset
  4767
     This fallback code is not particularily tuned or optimized for speed."
16038
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4768
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4769
    |rest twoDigits hi lo shift out|
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4770
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4771
    out := 0. shift := 0.
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4772
    rest := self.
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4773
    [rest > 0] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4774
        twoDigits := rest \\ 100.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4775
        rest := rest // 100.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4776
        hi := twoDigits // 10.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4777
        lo := twoDigits \\ 10.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4778
        out := out bitOr:(((hi bitShift:4)+lo) bitShift:shift).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4779
        shift := shift + 8.
16038
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4780
    ].
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4781
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4782
    ^ out
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4783
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4784
    "
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4785
     (100 factorial) asBCD
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4786
     999999999 asBCD
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4787
     100000000 asBCD
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4788
     123456789 asBCD
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4789
     99999999 asBCD
16038
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4790
     12345678 asBCD
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4791
     12345678 asBCD
16038
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4792
     12345678 asBCD hexPrintString
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4793
     12345678901234567890 asBCD
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4794
    "
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4795
!
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4796
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4797
asBCDBytes
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4798
    "return a byteArray containing the receiver in BCD encoding.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4799
     The byteArray will contain the BCD encoded decimal string,
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4800
     starting with the most significant digits first.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4801
     This conversion is useful for some communication protocols,
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4802
     or control systems, which represent big numbers this way...
16038
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4803
     This is not particularily tuned or optimized for speed."
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4804
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4805
    |s rest twoDigits hi lo|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4806
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4807
    self == 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4808
        ^ #[ 16r00 ]
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4809
    ].
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4810
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4811
    "/ a very rough estimate on the final size ...
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4812
    s := (ByteArray new:(self digitLength * 2)) writeStream.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4813
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4814
    rest := self.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4815
    [rest > 0] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4816
        twoDigits := rest \\ 100.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4817
        rest := rest // 100.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4818
        hi := twoDigits \\ 10.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4819
        lo := twoDigits // 10.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4820
        s nextPut:(lo bitShift:4)+hi
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4821
    ].
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4822
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4823
    ^ s contents reverse
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4824
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4825
    "
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4826
     12345678 asBCDBytes
16038
0de5f1f2a740 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16015
diff changeset
  4827
     12345678 asBCDBytes hexPrintString
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4828
     12345678901234567890 asBCDBytes
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4829
    "
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4830
!
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4831
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4832
errorPrintHex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4833
    "print the receiver as a hex number on the standard error stream"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4834
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4835
     (self printStringRadix:16) errorPrint
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4836
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4837
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4838
hexPrintString
23382
e11a8bed0f9e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23119
diff changeset
  4839
    "return a hex string representation of the receiver.
e11a8bed0f9e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23119
diff changeset
  4840
     Notice: this is not padded in any way"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4841
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4842
    ^ self printStringRadix:16
3874
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  4843
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  4844
    "
23382
e11a8bed0f9e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23119
diff changeset
  4845
     9 hexPrintString
3874
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  4846
     127 hexPrintString
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  4847
     -1 hexPrintString
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  4848
    "
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  4849
23382
e11a8bed0f9e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23119
diff changeset
  4850
    "Modified: / 11-10-1998 / 01:15:43 / cg"
e11a8bed0f9e #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 23119
diff changeset
  4851
    "Modified (comment): / 23-09-2018 / 03:48:57 / Claus Gittinger"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4852
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4853
2408
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4854
hexPrintString:size
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4855
    "return a hex string representation of the receiver,
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4856
     padded to size characters"
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4857
5799
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  4858
"/    ^ (self printStringRadix:16) leftPaddedTo:size with:$0
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  4859
    ^ self printStringRadix:16 size:size fill:$0
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  4860
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  4861
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4862
     12345 hexPrintString:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4863
     123 hexPrintString:4
5799
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  4864
    "
2408
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4865
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4866
    "Created: 18.2.1997 / 13:32:33 / cg"
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4867
!
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  4868
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4869
printHex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4870
    "print the receiver as a hex number on the standard output stream"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4871
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4872
     (self printStringRadix:16) print
21938
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4873
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4874
    "
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4875
     16rAFFE printStringRadix:16
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4876
    "
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4877
95ff2af6355f #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 21931
diff changeset
  4878
    "Modified (comment): / 02-07-2017 / 10:20:59 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4879
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4880
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4881
printOn:aStream base:base showRadix:showRadix
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  4882
    "append a string representation of the receiver in the specified numberBase to aStream
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  4883
     (if showRadix is true, with initial XXr)
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4884
     The base argument should be between 2 and 36.
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4885
     If it is negative, digits > 9 are printed as lowecase a-z."
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4886
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4887
    |absBase num s divMod mod r r2 r4 nD numN string|
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4888
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4889
    (base isInteger and:[absBase := base abs. absBase between:2 and:36]) ifFalse:[
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4890
        ConversionError raiseRequestWith:self errorString:' - invalid base: ', absBase printString.
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4891
        absBase := 10.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 52
diff changeset
  4892
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 52
diff changeset
  4893
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  4894
    showRadix ifTrue:[
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4895
        absBase printOn:aStream.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4896
        aStream nextPut:$r.
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  4897
    ].
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  4898
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4899
    (self = 0) ifTrue:[aStream nextPut:$0. ^ self].
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4900
    self negative ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4901
        aStream nextPut:$- .
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4902
        num := self negated.
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4903
    ] ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4904
        num := self.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4905
    ].
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4906
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4907
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4908
     claus: changed it from a recursive algorithm;
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4909
     (it used to trigger stack-overflow exceptions when printing 3000 factorial ...)
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  4910
    "
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4911
    "/    leftPart := num // base.
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4912
    "/    (leftPart ~= 0) ifTrue:[
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4913
    "/        leftPart printOn:aStream base:base.
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4914
    "/        aStream nextPut:(Character digitValue:(num \\ base).
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4915
    "/        ^ self
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4916
    "/    ].
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  4917
    "/    aStream nextPut:(Character digitValue:num).
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  4918
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  4919
    "/ instead of computing the quotient and remainder
3136
91dbf1ea13a6 print in junks of 6 digits (instead of 8 digits)
Claus Gittinger <cg@exept.de>
parents: 3135
diff changeset
  4920
    "/ against radix, do it in junks of 5 or 6 digits.
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  4921
    "/ This reduces the number of LargeInt-divisions
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  4922
    "/ by that factor (turning them into smallInt divisions
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  4923
    "/ within that junk) and speeds up the conversions noticably.
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  4924
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4925
    r2 := absBase*absBase.   "/ radix^2
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4926
    r4 := r2*r2.        "/ radix^4
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4927
    absBase <= 10 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4928
        r := r4*r2.     "/ radix^6 (chunks of 6 digits)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4929
        nD := 6.
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  4930
    ] ifFalse:[
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4931
        r := r4*absBase.    "/ radix^5 (chunks of 5 digits)
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4932
        nD := 5.
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  4933
    ].
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4934
    SmallInteger maxBits >= 63 ifTrue:[
24331
ae549620c66c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24287
diff changeset
  4935
        r := r*r2.    "/ radix^8 or radix^7 (chunks of 8 or 7 digits)
19159
c92bc53e745e #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19131
diff changeset
  4936
        nD := nD + 2.
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4937
    ].
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4938
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4939
    "get a Stream with space for the digits we are going to print.
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4940
     We need ((num log:base) ceiling) digits, which is equivalent
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4941
     to ((num log:2)/(base log:2) ceiling)
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4942
    "
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  4943
    s := WriteStream on:(String new:10).
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4944
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  4945
    [num >= r] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4946
        "/
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4947
        "/ chop off nD digits.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4948
        "/
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4949
        divMod := num divMod:r.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4950
        num := divMod at:1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4951
        numN := divMod at:2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4952
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4953
        "/ process them
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4954
        nD timesRepeat:[
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4955
            divMod := numN divMod:absBase.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4956
            numN := divMod at:1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4957
            mod := divMod at:2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4958
            s nextPut:(Character digitValue:mod).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4959
        ].
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  4960
    ].
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  4961
19089
82c431661f59 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19078
diff changeset
  4962
    [num ~~ 0] whileTrue:[
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4963
        divMod := num divMod:absBase.
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4964
        num := divMod at:1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4965
        mod := divMod at:2.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4966
        s nextPut:(Character digitValue:mod).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4967
    ].
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4968
    string := s contents reverse.
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4969
    base < 0 ifTrue:[
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4970
        string := string asLowercase.
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4971
    ].
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4972
    aStream nextPutAll:string.
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4973
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4974
    "
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4975
        3000 factorial printOn:Transcript base:10
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4976
        10 printOn:Transcript base:3
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4977
        31 printOn:Transcript base:3
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4978
        10 printOn:Transcript base:2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4979
        31 printOn:Transcript base:2
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4980
        -28  printOn:Transcript base:16
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  4981
        -28  printOn:Transcript base:-16
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  4982
        -20  printOn:Transcript base:10
19159
c92bc53e745e #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19131
diff changeset
  4983
        Time millisecondsToRun:[10000 factorial printString]
c92bc53e745e #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 19131
diff changeset
  4984
        '%012d' printf:{  (2 raisedTo:20) }
12976
a12aab15ce5a changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12875
diff changeset
  4985
    "
a12aab15ce5a changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12875
diff changeset
  4986
a12aab15ce5a changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12875
diff changeset
  4987
    "Modified: / 20-01-1998 / 18:05:02 / stefan"
a12aab15ce5a changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12875
diff changeset
  4988
    "Created: / 07-09-2001 / 13:51:33 / cg"
a12aab15ce5a changed: #printOn:base:showRadix:
Claus Gittinger <cg@exept.de>
parents: 12875
diff changeset
  4989
    "Modified: / 02-08-2010 / 12:24:14 / cg"
24331
ae549620c66c #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 24287
diff changeset
  4990
    "Modified (comment): / 11-06-2019 / 00:07:05 / Claus Gittinger"
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4991
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  4992
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  4993
printOn:aStream base:baseInteger size:sz
15775
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  4994
    "print a string representation of the receiver in the specified
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  4995
     base. The string is padded on the left with fillCharacter to make
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  4996
     its size as specified in sz."
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  4997
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  4998
    self printOn:aStream base:baseInteger size:sz fill:$0
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  4999
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  5000
    "
20268
e700943eea09 #DOCUMENTATION by mawalch
mawalch
parents: 20140
diff changeset
  5001
     1024 printOn:Transcript base:16 size:4.
15775
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  5002
     1024 printOn:Transcript base:2 size:16.
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  5003
     1024 printOn:Transcript base:16 size:8.
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  5004
    "
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  5005
!
94bd832a355e class: Integer
Claus Gittinger <cg@exept.de>
parents: 15765
diff changeset
  5006
7173
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5007
printOn:aStream base:baseInteger size:sz fill:fillCharacter
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5008
    "print a string representation of the receiver in the specified
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5009
     base. The string is padded on the left with fillCharacter to make
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5010
     its size as specified in sz."
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5011
20140
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  5012
    |string actualSize|
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  5013
bba1c52b0978 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 20130
diff changeset
  5014
    string := self printStringRadix:baseInteger.
7173
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5015
    actualSize := string size.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5016
    actualSize < sz ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5017
        aStream next:sz-actualSize put:fillCharacter.
7173
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5018
    ].
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5019
    aStream nextPutAll:string.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5020
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5021
    "
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5022
     1024 printOn:Transcript base:16 size:4 fill:$0.
7173
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5023
     1024 printOn:Transcript base:2 size:16 fill:$.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5024
     1024 printOn:Transcript base:16 size:8 fill:Character space.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5025
    "
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5026
!
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  5027
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5028
printOn:aStream radix:base
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5029
    "append a printed description of the receiver to aStream.
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5030
     The receiver is printed in radix base (instead of the default, 10).
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  5031
     This method is obsoleted by #printOn:base:, which is ST-80 & ANSI compatible."
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5032
8897
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
  5033
    <resource: #obsolete>
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
  5034
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5035
    self printOn:aStream base:base
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5036
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5037
    "Modified: / 20.1.1998 / 14:10:45 / stefan"
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  5038
    "Modified: / 7.9.2001 / 13:58:29 / cg"
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5039
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  5040
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5041
printRomanOn:aStream
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5042
    "print the receiver as roman number to the receiver, aStream.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5043
     This converts correct (i.e. prefix notation for 4,9,40,90, etc.)."
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5044
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5045
    ^ self printRomanOn:aStream naive:false
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5046
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5047
    "
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5048
     1 to:10 do:[:i | i printRomanOn:Transcript. Transcript cr.].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5049
     1999 printRomanOn:Transcript. Transcript cr.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5050
     Date today year printRomanOn:Transcript. Transcript cr.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5051
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5052
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5053
    "test all between 1 and 9999:
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5054
      1 to:9999 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5055
        |romanString|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5056
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5057
        romanString := String streamContents:[:stream | n printRomanOn:stream].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5058
        (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5059
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5060
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5061
!
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5062
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5063
printRomanOn:aStream naive:naive
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5064
    "print the receiver as roman number to the receiver, aStream.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5065
     The naive argument controls if the conversion is
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
  5066
     correct (i.e. subtracting prefix notation for 4,9,40,90, etc.),
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
  5067
     or naive (i.e. print 4 as IIII and 9 as VIIII); also called simple.
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5068
     The naive version is often used for page numbers in documents."
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5069
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5070
    |restValue spec|
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5071
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5072
    restValue := self.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5073
    restValue > 0 ifFalse:[self error:'negative roman'].
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5074
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5075
    naive ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5076
        spec := #(
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5077
                " value string repeat "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5078
                   1000 'M'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5079
                    500 'D'    false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5080
                    100 'C'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5081
                     50 'L'    false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5082
                     10 'X'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5083
                      5 'V'    false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5084
                      1 'I'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5085
                 ).
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5086
    ] ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5087
        spec := #(
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5088
                " value string repeat "
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5089
                   1000 'M'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5090
                    900 'CM'   false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5091
                    500 'D'    false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5092
                    400 'CD'   false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5093
                    100 'C'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5094
                     90 'XC'   false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5095
                     50 'L'    false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5096
                     40 'XL'   false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5097
                     10 'X'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5098
                      9 'IX'   false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5099
                      5 'V'    false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5100
                      4 'IV'   false
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5101
                      1 'I'    true
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5102
                 ).
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5103
    ].
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5104
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5105
    spec
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5106
        inGroupsOf:3
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5107
        do:[:rValue :rString :repeatFlag |
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5108
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5109
            [
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5110
                (restValue >= rValue) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5111
                    aStream nextPutAll:rString.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5112
                    restValue := restValue - rValue.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5113
                ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5114
            ] doWhile:[ repeatFlag and:[ restValue >= rValue] ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5115
        ].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5116
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5117
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5118
     1 to:10 do:[:i | i printRomanOn:Transcript naive:false. Transcript cr.].
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5119
     1 to:10 do:[:i | i printRomanOn:Transcript naive:true. Transcript cr.].
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5120
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5121
     1999 printRomanOn:Transcript. Transcript cr.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5122
     Date today year printRomanOn:Transcript. Transcript cr.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5123
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5124
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5125
    "test all between 1 and 9999:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5126
      1 to:9999 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5127
        |romanString|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5128
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5129
        romanString := String streamContents:[:stream | n printRomanOn:stream naive:false].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5130
        (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5131
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5132
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5133
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5134
    "test naive all between 1 and 9999:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  5135
      1 to:9999 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5136
        |romanString|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5137
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5138
        romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5139
        (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5140
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5141
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5142
!
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5143
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5144
printStringRadix:aRadix size:sz fill:fillCharacter
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5145
    "return a string representation of the receiver in the specified
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5146
     radix. The string is padded on the left with fillCharacter to make
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5147
     its size as specified in sz."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5148
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  5149
    |s actualSize|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5150
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5151
    s := self printStringRadix:aRadix.
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  5152
    actualSize := s size.
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  5153
    actualSize < sz ifTrue:[
23980
6644ef2d4826 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23944
diff changeset
  5154
        ^ (String new:(sz - actualSize) withAll:fillCharacter) , s
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5155
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5156
    ^ s
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5157
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  5158
    "
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5159
     1024 printStringRadix:16 size:4 fill:$0.
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  5160
     1024 printStringRadix:2 size:16 fill:$.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  5161
     1024 printStringRadix:16 size:8 fill:(Character space)
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  5162
    "
23980
6644ef2d4826 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23944
diff changeset
  5163
6644ef2d4826 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 23944
diff changeset
  5164
    "Modified: / 26-03-2019 / 11:54:52 / Claus Gittinger"
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  5165
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  5166
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5167
romanPrintString
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5168
    "return a roman number representation of the receiver as a string"
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5169
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5170
    ^ String streamContents:[:stream | self printRomanOn:stream].
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5171
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5172
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5173
     1999 romanPrintString.
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5174
     Date today year romanPrintString.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  5175
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5176
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5177
23496
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5178
!Integer methodsFor:'private'!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5179
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5180
numberOfDigits:n8BitDigits
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5181
    "initialize the instance to store n8BitDigits"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5182
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5183
    ^ self subclassResponsibility.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5184
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5185
    "Created: / 01-11-2018 / 11:28:56 / Stefan Vogel"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5186
!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5187
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5188
numberOfDigits:n8BitDigits sign:newSign
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5189
    "initialize the instance to store n8BitDigits and sign"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5190
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5191
    ^ self subclassResponsibility.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5192
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5193
    "Created: / 01-11-2018 / 12:12:56 / Stefan Vogel"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5194
!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5195
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5196
setSign:aNumber
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5197
    "private: for protocol completeness with LargeIntegers.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5198
     Returns a smallInteger with my absValue and the sign of the argument.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5199
     The method's name may be misleading: the receiver is not changed,
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5200
     but a new number is returned."
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5201
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5202
    |absVal|
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5203
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5204
    aNumber == 0 ifTrue:[
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5205
        ^ 0
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5206
    ].
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5207
    absVal := self abs.
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5208
    aNumber < 0 ifTrue:[
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5209
        ^ absVal negated
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5210
    ].
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5211
    ^ absVal
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5212
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5213
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5214
     -4 sign:-1
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5215
     -4 sign:0
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5216
     -4 sign:1
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5217
     -4 sign:-1
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5218
     -4 sign:0
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5219
     -4 sign:1
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5220
    "
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5221
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5222
    "Modified (format): / 01-11-2018 / 12:22:48 / Stefan Vogel"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5223
!
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5224
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5225
sign:aNumber
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5226
    <resource: #obsolete>
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5227
    "destructively change the sign of the receiver"
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5228
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5229
    ^ self setSign:aNumber
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5230
! !
c1ef03a844f8 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 23382
diff changeset
  5231
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5232
!Integer methodsFor:'queries'!
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  5233
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5234
digitAt:n
6055
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5235
    "return the n-th byte of the binary representation."
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5236
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5237
    self subclassResponsibility
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5238
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5239
    "This is a very stupid implementation, and should be redefined in
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5240
     concrete subclasses."
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  5241
6055
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5242
"/    |num count|
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5243
"/
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5244
"/    num := self.
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5245
"/    count := n.
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5246
"/    [count > 1] whileTrue:[
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5247
"/        num := num // 256.
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5248
"/        count := count - 1
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5249
"/    ].
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5250
"/    ^ num \\ 256
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  5251
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  5252
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5253
     16r44332211 digitAt:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5254
     16r44332211 digitAt:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5255
     16r44332211 digitAt:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5256
     16r44332211 digitAt:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5257
     16r44332211 digitAt:5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5258
     16r00332211 digitAt:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5259
     16r00332211 digitAt:5
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  5260
    "
6055
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5261
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5262
    "Modified: / 26.9.2001 / 21:21:21 / cg"
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5263
!
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5264
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5265
digitByteAt:n
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5266
    "return 8 bits of my signed value, starting at byte index.
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5267
     For positive receivers, this is the same as #digitAt:;
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5268
     for negative ones, the actual bit representation is returned."
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5269
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5270
    self subclassResponsibility
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5271
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5272
    "Created: / 26.9.2001 / 21:18:43 / cg"
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  5273
    "Modified: / 26.9.2001 / 21:20:19 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5274
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  5275
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5276
digitLength
19319
88ea441f7071 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19316
diff changeset
  5277
    "return the number of bytes needed for the unsigned binary representation of the receiver.
88ea441f7071 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19316
diff changeset
  5278
     For negative receivers, the result is not defined by the language standard.
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5279
     This method is redefined in concrete classes
19319
88ea441f7071 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 19316
diff changeset
  5280
     - the fallback here is actually never used."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5281
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5282
    ^ (self log:256) ceiling asInteger
2816
62edd11b5e66 commentary
Claus Gittinger <cg@exept.de>
parents: 2794
diff changeset
  5283
62edd11b5e66 commentary
Claus Gittinger <cg@exept.de>
parents: 2794
diff changeset
  5284
    "Modified: 31.7.1997 / 13:19:06 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5285
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5286
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5287
exponent
24968
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5288
    "return what would be the normalized float's (unbiased) exponent if I were a float.
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5289
     This is not for general use - it has been added for dolphin (soap) compatibility.
24968
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5290
     This assumes that a float's mantissa is normalized to
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5291
     0.5 .. 1.0 and the number's value is: mantissa * 2^exp"
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5292
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5293
    ^ self abs highBit
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5294
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5295
    "
24968
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5296
     16 mantissa * (2 raisedTo:16 exponent)
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5297
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5298
     self assert:( 1.0 exponent = 1 exponent ).
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5299
     self assert:( 2.0 exponent = 2 exponent ).
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5300
     self assert:( 3.0 exponent = 3 exponent ).
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5301
     self assert:( 4.0 exponent = 4 exponent ).
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5302
     self assert:( 12345.0 exponent = 12345 exponent ).
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5303
     self assert:( 0.0 exponent = 0 exponent ).
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5304
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5305
     self assert:( -1.0 exponent = -1 exponent ).
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5306
     self assert:( -2.0 exponent = -2 exponent ).
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5307
     self assert:( -3.0 exponent = -3 exponent ).
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5308
     self assert:( -4.0 exponent = -4 exponent ).
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5309
     self assert:( -12345.0 exponent = -12345 exponent ).
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5310
    "
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5311
!
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5312
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5313
isInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5314
    "return true, if the receiver is some kind of integer number"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5315
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5316
    ^ true
3036
f2d332547db7 added #isPowerOf2
Claus Gittinger <cg@exept.de>
parents: 2951
diff changeset
  5317
!
f2d332547db7 added #isPowerOf2
Claus Gittinger <cg@exept.de>
parents: 2951
diff changeset
  5318
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5319
isLiteral
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5320
    "return true, if the receiver can be used as a literal constant in ST syntax
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5321
     (i.e. can be used in constant arrays)"
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5322
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5323
    ^ true
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5324
!
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5325
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5326
isPerfectSquare
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5327
    "return true if I am a perfect square.
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5328
     That is a number for which the square root is an integer."
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5329
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5330
    |intSqrt realSqrt realSqrtTruncated|
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5331
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5332
    self strictlyPositive ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5333
        self == 0 ifTrue:[^ true].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5334
        "/ should we raise a domain error for negative receivers?
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5335
        ^ false
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5336
    ].
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5337
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5338
    "/ q&d check for common small squares
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5339
    self < 1024 ifTrue:[
25039
803a48c7a8c5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 25031
diff changeset
  5340
        self < 400 ifTrue:[
803a48c7a8c5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 25031
diff changeset
  5341
            self <= 100 ifTrue:[
803a48c7a8c5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 25031
diff changeset
  5342
                ^ #(1 4 9 16 25 36 49 64 81 100) includes:self.
803a48c7a8c5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 25031
diff changeset
  5343
            ].
803a48c7a8c5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 25031
diff changeset
  5344
            ^ #(121 144 169 196 225 256 289 324 361) includes:self.
803a48c7a8c5 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 25031
diff changeset
  5345
        ].
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5346
        ^ #(400 441 484 529 576 625 676 729 784 841 900 961) includes:self.
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5347
    ].
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5348
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5349
    "/ try powers of 2
24707
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5350
    self isPowerOf2 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5351
        ^ self lowBit odd
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5352
    ].
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5353
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5354
    "/ guess
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5355
    realSqrt := self sqrt.
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5356
    realSqrt isFinite ifTrue:[
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5357
        realSqrtTruncated := realSqrt truncated.
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5358
        realSqrt = realSqrtTruncated ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5359
            "/ still have to check due to rounding errors.
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5360
            intSqrt := realSqrtTruncated asInteger.
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5361
            (intSqrt squared = self) ifTrue:[^ true].
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5362
        ].
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5363
        "/ slow code
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5364
        intSqrt := self integerSqrtWithGuess:realSqrtTruncated asInteger.
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5365
    ] ifFalse:[
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5366
        "/ slow code
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5367
        intSqrt := self integerSqrt.
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5368
    ].
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5369
    ^ intSqrt squared = self
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5370
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5371
    "
19058
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5372
     0 isPerfectSquare
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5373
     3 isPerfectSquare
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5374
     4 isPerfectSquare
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5375
     9 isPerfectSquare
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5376
     (1 to:1000000) count:[:n | n isPerfectSquare] 1000
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5377
     12345678987654321234567 isPerfectSquare 
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5378
     123123123432 squared isPerfectSquare  
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5379
     (123123123432 raisedTo:7) isPerfectSquare
24868
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5380
     ((123456789123456789 raisedTo:7)) isPerfectSquare 
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5381
     ((123456789123456789 raisedTo:7)-1) isPerfectSquare 
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5382
     Time microsecondsToRun:[12345678987654321234567 isPerfectSquare] 
1e6dfa487830 #BUGFIX by exept
Claus Gittinger <cg@exept.de>
parents: 24707
diff changeset
  5383
     12345678987654321234567 squared isPerfectSquare 
24937
f74f01d332cf #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24881
diff changeset
  5384
     Time microsecondsToRun:[12345678987654321234567 squared isPerfectSquare]  
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5385
    "
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5386
!
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5387
24707
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5388
isPowerOf2
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5389
    "return true, if the receiver is a power of 2"
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5390
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5391
    "redefined, because the hacker's algorithm in smallInt is much slower for large numbers"
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5392
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5393
    |maxBytes "{ Class: SmallInteger }"|
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5394
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5395
    maxBytes := self digitLength.
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5396
    (self digitAt:maxBytes) isPowerOf2 ifFalse:[^ false].
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5397
    1 to:maxBytes-1 do:[:byteIndex |
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5398
        (self digitAt:byteIndex) ~~ 0 ifTrue:[^ false].
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5399
    ].
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5400
    ^ true
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5401
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5402
    "
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5403
     10000 factorial isPowerOf2
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5404
     |n| n := 10000 factorial. Time millisecondsToRun:[10000 timesRepeat:[ n isPowerOf2]]
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5405
    "
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5406
    "
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5407
     (2 raisedTo:10000) isPowerOf2
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5408
     |n| n := (2 raisedTo:10000). Time millisecondsToRun:[10000 timesRepeat:[ n isPowerOf2]]
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5409
    "
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5410
!
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5411
9134
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5412
isPowerOf:p
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5413
    "return true, if the receiver is a power of p"
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5414
24707
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5415
    p == 2 ifTrue:[ ^ self isPowerOf2].
9134
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5416
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5417
    "/ the following is a q&d hack, using existing code.
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5418
    ^ (Integer
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5419
        readFromString:(self printStringRadix:p)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5420
        radix:2
24707
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5421
        onError:-1) isPowerOf2
9134
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5422
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5423
    "
19058
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5424
     0 isPowerOf:2
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5425
     1 isPowerOf:2
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5426
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5427
     16r0000000000000000 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5428
     16r0000004000000000 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5429
     16r0000004000000001 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5430
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5431
     16r0000000000000001 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5432
     16r0000000000000002 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5433
     16r0000000000000004 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5434
     16r0000000000000008 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5435
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5436
     16r0000000000000001 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5437
     16r0000000000000002 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5438
     16r0000000000000004 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5439
     16r0000000000000008 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5440
     16r0000000000000010 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5441
     16r0000000000000020 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5442
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5443
     3r0000000000000001 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5444
     3r0000000000000010 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5445
     3r0000000000000100 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5446
     3r0000000000001000 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5447
     3r0000000000001001 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5448
     3r0000000000002000 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5449
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5450
     10 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5451
     20 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5452
     100 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5453
     110 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5454
     200 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5455
     1000 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5456
     10000 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5457
     100000 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  5458
     100001 isPowerOf:10
9134
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  5459
 "
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5460
!
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5461
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5462
isPowerOfTwo
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5463
    "return true, if the receiver is a power of 2"
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5464
24707
300102c54d79 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24697
diff changeset
  5465
    ^ self isPowerOf2
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5466
!
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5467
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5468
isPrime
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5469
    "return true if I am a prime Number.
22114
94a519213339 #BUGFIX by mawalch
mawalch
parents: 22107
diff changeset
  5470
     Pre-condition: I am positive.
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5471
     This is a q&d hack, which may need optimization if heavily used."
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5472
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5473
    |limit firstFewPrimes|
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5474
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5475
    self even ifTrue:[^ self == 2 ].
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5476
    self == 1 ifTrue:[^ false ].
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5477
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5478
    "/ See comment in initializePrimeCacheUpTo:limit
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5479
    "/      Integer initializePrimeCacheUpTo:(10 raisedTo:7)
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5480
    "/      Integer flushPrimeCache
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5481
    "/
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5482
    "/ by default, no primeCache is used.
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5483
    "/ if you do lots of number-stuff with primes, you may want to enable it with
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5484
    "/      Integer initializePrimeCacheUpTo:1000000
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5485
    "/ and when done, cleanup with flushPrimeCache
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5486
    PrimeCache notNil ifTrue:[
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5487
        self <= (PrimeCache size*2) ifTrue:[
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5488
            ^ PrimeCache at:self//2.
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5489
        ].
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5490
    ].
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5491
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5492
    firstFewPrimes := self class primesUpTo5000.
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5493
    limit := firstFewPrimes last + 1.
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5494
    self < (limit*limit) ifTrue:[
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5495
        limit := self sqrt asInteger.
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5496
    ].
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5497
    firstFewPrimes do:[:p |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5498
        p > limit ifTrue:[^ true].
24697
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5499
        (self \\ p) == 0 ifTrue:[
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5500
            "/ Transcript showCR:'divides by ',p asString.
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5501
            ^ false 
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5502
        ].
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5503
    ].
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5504
19118
c49679d75a5d #FEATURE
Stefan Vogel <sv@exept.de>
parents: 19094
diff changeset
  5505
    PrimeNumberGenerator notNil ifTrue:[    "from exept:libcrypt"
c49679d75a5d #FEATURE
Stefan Vogel <sv@exept.de>
parents: 19094
diff changeset
  5506
        "speed up a lot for large primes"
c49679d75a5d #FEATURE
Stefan Vogel <sv@exept.de>
parents: 19094
diff changeset
  5507
        ^ PrimeNumberGenerator isPrime:self.
c49679d75a5d #FEATURE
Stefan Vogel <sv@exept.de>
parents: 19094
diff changeset
  5508
    ].
c49679d75a5d #FEATURE
Stefan Vogel <sv@exept.de>
parents: 19094
diff changeset
  5509
22114
94a519213339 #BUGFIX by mawalch
mawalch
parents: 22107
diff changeset
  5510
    "/ Not absolutely correct, but was broken much worse before.
22118
bb1fee4735ae #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 22114
diff changeset
  5511
    limit := self integerSqrt.
24697
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5512
    (firstFewPrimes last+2) to:limit by:2 do:[:p |
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5513
        (self \\ p) == 0 ifTrue:[ 
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5514
            "/ Transcript showCR:'divides by ',p asString.
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5515
            ^ false 
c29977d36d13 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 24683
diff changeset
  5516
        ].
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5517
    ].
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5518
    ^ true
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5519
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5520
    "
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5521
     Integer primesUpTo:1000
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5522
     (1 to:1000000) count:[:n | n isPrime] 78498
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5523
     Time millisecondsToRun:[ (1 to:1000000) count:[:n | n isPrime]] 1295   w.o firstFewPrimes
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5524
     Time millisecondsToRun:[ (1 to:1000000) count:[:n | n isPrime]] 936    with firstFewPrimes (less tests)
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5525
     Time millisecondsToRun:[ (1 to:1000000) count:[:n | n isPrime]] 343    with primeCache
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5526
    "
22114
94a519213339 #BUGFIX by mawalch
mawalch
parents: 22107
diff changeset
  5527
94a519213339 #BUGFIX by mawalch
mawalch
parents: 22107
diff changeset
  5528
    "Modified (comment): / 26-07-2017 / 12:58:45 / mawalch"
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5529
!
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5530
24968
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5531
mantissa
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5532
    "return what would be the normalized float's mantissa if I were a float.
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5533
     This is not for general use - it has been added for dolphin (soap) compatibility.
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5534
     This assumes that a float's mantissa is normalized to
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5535
     0.5 .. 1.0 and the number's value is: mantissa * 2^exp"
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5536
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5537
    self < 0 ifTrue:[
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5538
        ^ (self abs / (1 bitShift:(self abs highBit))) negated
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5539
    ].
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5540
    ^ self / (1 bitShift:(self highBit))
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5541
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5542
    "
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5543
     16.0 mantissa  
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5544
     16 mantissa          
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5545
     16.0 exponent  
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5546
     16 exponent   
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5547
     16 mantissa * (2 raisedTo:16 exponent)    
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5548
     16.0 mantissa * (2 raisedTo:16.0 exponent)  
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5549
     -16 mantissa * (2 raisedTo:-16 exponent)     
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5550
     -16.0 mantissa * (2 raisedTo:-16.0 exponent)  
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5551
     #( 1.0 1
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5552
        2.0 2
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5553
        3.0 3
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5554
        4.0 4
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5555
        12345.0 12345
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5556
        0.0 0
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5557
        -1.0 -1
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5558
        -2.0 -2
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5559
        -3.0 -3
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5560
        -4.0 -4
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5561
        -12345.0 -12345
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5562
     ) pairWiseDo:[:f :i |
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5563
        self assert:( f exponent = i exponent ).
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5564
        self assert:( f mantissa = i mantissa ).
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5565
        self assert:( f mantissa * (2 raisedTo:f exponent))= f.
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5566
        self assert:( i mantissa * (2 raisedTo:i exponent)) = i.
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5567
     ].
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5568
    "
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5569
!
a6f15c3dca47 #FEATURE by exept
Claus Gittinger <cg@exept.de>
parents: 24937
diff changeset
  5570
23119
8ca65ffe917f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23118
diff changeset
  5571
nextMultipleOf:n
14680
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5572
    "return the multiple of n at or above the receiver.
23119
8ca65ffe917f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23118
diff changeset
  5573
     (?? The name of this method may be a bit misleading,
8ca65ffe917f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23118
diff changeset
  5574
      as it returns the receiver iff it is already a multiple)
16800
45ef192ee95f class: Integer
Claus Gittinger <cg@exept.de>
parents: 16723
diff changeset
  5575
     Useful for padding, aligning or rounding,
21774
c6fb8f0b4597 #OTHER by mawalch
mawalch
parents: 21637
diff changeset
  5576
     especially when reading aligned binary data."
14677
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5577
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5578
    |rest|
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5579
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5580
    rest := self \\ n.
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5581
    rest == 0 ifTrue:[ ^ self ].
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5582
    ^ self + (n - rest)
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5583
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5584
    "
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5585
     0 nextMultipleOf: 4 -> 0
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5586
     1 nextMultipleOf: 4 -> 4
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5587
     2 nextMultipleOf: 4 -> 4 
20269
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5588
     3 nextMultipleOf: 4 -> 4
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5589
     4 nextMultipleOf: 4 -> 4
0d108b055dfc #DOCUMENTATION by mawalch
mawalch
parents: 20268
diff changeset
  5590
     5 nextMultipleOf: 4 -> 8
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5591
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5592
     22 nextMultipleOf: 4
19128
0d9e7097fce7 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 19125
diff changeset
  5593
     100 factorial nextMultipleOf: 4
14677
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5594
    "
21774
c6fb8f0b4597 #OTHER by mawalch
mawalch
parents: 21637
diff changeset
  5595
c6fb8f0b4597 #OTHER by mawalch
mawalch
parents: 21637
diff changeset
  5596
    "Modified (comment): / 29-05-2017 / 15:40:45 / mawalch"
23119
8ca65ffe917f #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23118
diff changeset
  5597
    "Modified (comment): / 20-06-2018 / 15:36:33 / Claus Gittinger"
14677
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5598
!
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  5599
14680
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5600
nextPowerOf2
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5601
    "return the power of 2 at or above the receiver.
18769
Claus Gittinger <cg@exept.de>
parents: 18380
diff changeset
  5602
     Useful for padding.
19058
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5603
     Notice, that for a powerOf2, the receiver is returned.
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5604
     Also notice, that (because it is used for padding),
19058
Claus Gittinger <cg@exept.de>
parents: 19053
diff changeset
  5605
     0 is returned for zero."
14680
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5606
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5607
    |x t sh|
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5608
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5609
    x := self - 1.
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5610
    x := x bitOr: (x bitShift: -1).
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5611
    x := x bitOr: (x bitShift: -2).
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5612
    x := x bitOr: (x bitShift: -4).
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5613
    x := x bitOr: (x bitShift: -8).
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5614
    x := x bitOr: (t := x bitShift: -16).
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5615
    t == 0 ifFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5616
        sh := -32.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5617
        [
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5618
            x := x bitOr: (t := x bitShift: sh).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5619
            sh := sh + sh.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5620
        ] doWhile: [t ~~ 0]
14680
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5621
    ].
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5622
    ^ x + 1
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5623
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5624
    "
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5625
     0 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5626
     1 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5627
     2 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5628
     3 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5629
     4 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5630
     5 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5631
     6 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5632
     7 nextPowerOf2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5633
     8 nextPowerOf2
14680
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5634
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5635
     22 nextPowerOf2
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5636
     12 factorial nextPowerOf2  isPowerOf:2
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5637
     100 factorial nextPowerOf2  isPowerOf:2
18905
256565ff9803 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18865
diff changeset
  5638
     1000 factorial nextPowerOf2  isPowerOf:2
256565ff9803 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18865
diff changeset
  5639
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5640
         |v|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5641
         v := 1000 factorial.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5642
         1000 timesRepeat:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5643
            v nextPowerOf2
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5644
         ]
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5645
     ]
14680
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5646
    "
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5647
!
eb312d015dd6 class: Integer
Claus Gittinger <cg@exept.de>
parents: 14677
diff changeset
  5648
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5649
nextPrime
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5650
    "return the next prime after the receiver"
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5651
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5652
    |num|
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5653
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5654
    num := self + 1.
19015
8cce2933467a #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18981
diff changeset
  5655
    num <= 2 ifTrue:[^ 2].
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5656
    num even ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5657
        num := num + 1
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5658
    ].
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5659
    [num isPrime] whileFalse:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5660
        num := num + 2
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5661
    ].
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5662
    ^ num
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5663
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5664
    "
19015
8cce2933467a #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18981
diff changeset
  5665
     0 nextPrime
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5666
     1 nextPrime
19015
8cce2933467a #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 18981
diff changeset
  5667
     2 nextPrime
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5668
     22 nextPrime
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5669
     37 nextPrime
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5670
     36 nextPrime
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5671
     3456737 nextPrime
18865
1e6e937f7cf0 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 18851
diff changeset
  5672
     1000 factorial nextPrime
13815
a03b833fb6f8 category of:
Claus Gittinger <cg@exept.de>
parents: 13725
diff changeset
  5673
    "
13905
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5674
!
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5675
13906
5543bafd72a9 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13905
diff changeset
  5676
parityOdd
13914
725916ddad3f comment/format
Claus Gittinger <cg@exept.de>
parents: 13907
diff changeset
  5677
    "return true, if an odd number of bits are set in the receiver, false otherwise.
13905
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5678
     (i.e. true for odd parity)
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5679
     Undefined for negative values (smalltalk does not require the machine to use 2's complement)"
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5680
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5681
    ^ self bitCount odd
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5682
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5683
    "
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5684
     0 parityOdd
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5685
     1 parityOdd
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5686
     2 parityOdd
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5687
     4 parityOdd
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5688
     5 parityOdd
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5689
     7 parityOdd
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5690
     33 parityOdd
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5691
     6 parityOdd
13905
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5692
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5693
     1 to:1000000 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5694
        self assert:(n parityOdd = ((n printStringRadix:2) occurrencesOf:$1) odd).
13905
7eb024efb58a added: #parity
Claus Gittinger <cg@exept.de>
parents: 13815
diff changeset
  5695
     ]
13906
5543bafd72a9 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13905
diff changeset
  5696
5543bafd72a9 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13905
diff changeset
  5697
     0 to:255 do:[:n |
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5698
        |p|
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5699
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5700
        p :=
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5701
            (((((((((n rightShift: 7)
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5702
            bitXor: (n rightShift: 6))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5703
                bitXor: (n rightShift: 5))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5704
                    bitXor: (n rightShift: 4))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5705
                        bitXor: (n rightShift: 3))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5706
                            bitXor: (n rightShift: 2))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5707
                                bitXor: (n rightShift: 1))
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5708
                                    bitXor: n) bitAnd:1) == 1.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5709
        self assert:(n parityOdd = p).
13906
5543bafd72a9 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13905
diff changeset
  5710
     ]
5543bafd72a9 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13905
diff changeset
  5711
    "
5543bafd72a9 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13905
diff changeset
  5712
5543bafd72a9 added: #parityOdd
Claus Gittinger <cg@exept.de>
parents: 13905
diff changeset
  5713
    "Created: / 09-01-2012 / 17:18:06 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  5714
! !
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  5715
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5716
!Integer methodsFor:'special modulo arithmetic'!
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  5717
12605
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5718
add_32:anInteger
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5719
    "return a C-semantic 32bit sum of the receiver and the argument.
12605
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5720
     Both must be either Small- or LargeIntegers.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5721
     Returns a signed 32bit number.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5722
     This (nonstandard) specialized method is provided to allow simulation of
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5723
     modulu operations with C semantics."
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5724
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5725
%{  /* NOCONTEXT */
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5726
    int val1, val2, rslt;
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5727
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5728
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5729
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  5730
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5731
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5732
        if (!val1) goto bad;
12605
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5733
    }
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5734
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5735
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  5736
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5737
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5738
        if (!val2) goto bad;
12605
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5739
    }
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5740
    rslt = val1 + val2;
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5741
    RETURN(__MKINT(rslt));
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5742
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5743
  bad: ;
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5744
%}.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5745
    self primitiveFailed.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5746
!
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5747
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5748
add_32u:anInteger
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5749
    "return a C-semantic 32bit unsigned sum of the receiver and the argument.
12605
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5750
     Both must be either Small- or LargeIntegers.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5751
     Returns an unsigned 32bit number.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5752
     This (nonstandard) specialized method is provided to allow simulation of
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5753
     modulu operations with C semantics."
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5754
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5755
%{  /* NOCONTEXT */
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5756
    int val1, val2, rslt;
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5757
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5758
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5759
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  5760
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5761
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5762
        if (!val1) goto bad;
12605
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5763
    }
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5764
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5765
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  5766
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5767
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5768
        if (!val2) goto bad;
12605
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5769
    }
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5770
    rslt = val1 + val2;
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5771
    RETURN(__MKUINT((unsigned)rslt));
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5772
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5773
  bad: ;
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5774
%}.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5775
    self primitiveFailed.
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5776
!
9bf77c63d4b2 added:8 methods for 32bit modulu arithmetic
Claus Gittinger <cg@exept.de>
parents: 12588
diff changeset
  5777
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5778
mul_32:anInteger
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5779
    "return a C-semantic 32bit product of the receiver and the argument.
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5780
     Both must be either Small- or LargeIntegers.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5781
     Returns a signed 32bit number.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5782
     This (nonstandard) specialized method is provided to allow simulation of
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5783
     modulu operations with C semantics."
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5784
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5785
%{  /* NOCONTEXT */
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5786
    int val1, val2, rslt;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5787
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5788
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5789
        val1 = __intVal(self);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5790
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5791
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5792
        if (!val1) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5793
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5794
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5795
        val2 = __intVal(anInteger);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5796
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5797
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5798
        if (!val2) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5799
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5800
    rslt = val1 * val2;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5801
    RETURN(__MKINT(rslt));
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5802
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5803
  bad: ;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5804
%}.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5805
    self primitiveFailed.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5806
!
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5807
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5808
mul_32u:anInteger
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5809
    "return a C-semantic 32bit unsigned product of the receiver and the argument.
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5810
     Both must be either Small- or LargeIntegers.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5811
     Returns an unsigned 32bit number.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5812
     This (nonstandard) specialized method is provided to allow simulation of
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5813
     modulu operations with C semantics."
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5814
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5815
%{  /* NOCONTEXT */
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5816
    int val1, val2, rslt;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5817
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5818
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5819
        val1 = __intVal(self);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5820
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5821
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5822
        if (!val1) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5823
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5824
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5825
        val2 = __intVal(anInteger);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5826
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5827
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5828
        if (!val2) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5829
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5830
    rslt = val1 * val2;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5831
    RETURN(__MKUINT((unsigned)rslt));
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5832
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5833
  bad: ;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5834
%}.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5835
    self primitiveFailed.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5836
!
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5837
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5838
sub_32:anInteger
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5839
    "return a C-semantic 32bit difference of the receiver and the argument.
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5840
     Both must be either Small- or LargeIntegers.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5841
     Returns a signed 32bit number.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5842
     This (nonstandard) specialized method is provided to allow simulation of
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5843
     modulu operations with C semantics."
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5844
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5845
%{  /* NOCONTEXT */
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5846
    int val1, val2, rslt;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5847
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5848
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5849
        val1 = __intVal(self);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5850
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5851
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5852
        if (!val1) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5853
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5854
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5855
        val2 = __intVal(anInteger);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5856
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5857
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5858
        if (!val2) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5859
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5860
    rslt = val1 - val2;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5861
    RETURN(__MKINT(rslt));
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5862
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5863
  bad: ;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5864
%}.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5865
    self primitiveFailed.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5866
!
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5867
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5868
sub_32u:anInteger
19076
6765dbf123d8 now compilable with NUMBER-as-binexpr fix
Claus Gittinger <cg@exept.de>
parents: 19071
diff changeset
  5869
    "return a C-semantic 32bit unsigned difference of the receiver and the argument.
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5870
     Both must be either Small- or LargeIntegers.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5871
     Returns an unsigned 32bit number.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5872
     This (nonstandard) specialized method is provided to allow simulation of
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5873
     modulu operations with C semantics."
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5874
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5875
%{  /* NOCONTEXT */
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5876
    int val1, val2, rslt;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5877
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5878
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5879
        val1 = __intVal(self);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5880
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5881
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5882
        if (!val1) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5883
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5884
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5885
        val2 = __intVal(anInteger);
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5886
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5887
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5888
        if (!val2) goto bad;
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5889
    }
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5890
    rslt = val1 - val2;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5891
    RETURN(__MKUINT((unsigned)rslt));
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5892
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5893
  bad: ;
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5894
%}.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5895
    self primitiveFailed.
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5896
! !
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  5897
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5898
!Integer methodsFor:'special modulo bit operators'!
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5899
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5900
asSigned32
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5901
    "return a 32-bit integer with my bit-pattern. 
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5902
     For protocol completeness."
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5903
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5904
    ^ self
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5905
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5906
    "Modified (comment): / 17-03-2019 / 12:08:09 / Claus Gittinger"
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5907
!
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5908
22069
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5909
asUnsigned128
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5910
    "return a 128-bit integer with my bit-pattern, but positive.
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5911
     May be required for bit operations on the sign-bit and/or to
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5912
     convert C numbers.
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5913
     Does not check if the value is out of range, so callers
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5914
     may have to do a bitwise-and on the result"
22069
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5915
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5916
    self < 0 ifTrue:[
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5917
        ^ 16r1000000000000000000000000000000000 + self
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5918
    ].
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5919
    ^ self
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5920
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5921
    "
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5922
     (-1 asUnsigned128) hexPrintString
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5923
     1 asUnsigned128
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5924
     (SmallInteger minVal asUnsigned128) hexPrintString
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5925
     (SmallInteger maxVal asUnsigned128) hexPrintString
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5926
    "
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5927
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5928
    "Created: / 21-07-2017 / 14:44:19 / cg"
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5929
    "Modified (comment): / 17-03-2019 / 12:20:59 / Claus Gittinger"
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5930
!
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5931
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5932
asUnsigned16
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5933
    "return a 16-bit integer with my bit-pattern, but positive.
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5934
     May be required for bit operations on the sign-bit and/or to
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5935
     convert C/Java numbers.
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5936
     Does not check if the value is out of range, so callers
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5937
     may have to do a bitwise-and on the result"
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5938
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5939
    self < 0 ifTrue:[
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5940
        ^ 16r10000 + self
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5941
    ].
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5942
    ^ self
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5943
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5944
    "
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5945
     (-1 asUnsigned16) hexPrintString
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5946
     1 asUnsigned16
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5947
     (SmallInteger minVal asUnsigned16) hexPrintString
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5948
     (SmallInteger maxVal asUnsigned16) hexPrintString
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5949
    "
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5950
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5951
    "Created: / 17-03-2019 / 12:07:23 / Claus Gittinger"
22069
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5952
!
1898747d4358 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 21993
diff changeset
  5953
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5954
asUnsigned32
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5955
    "return a 32-bit integer with my bit-pattern, but positive.
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5956
     May be required for bit operations on the sign-bit and/or to
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5957
     convert C/Java numbers.
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5958
     Does not check if the value is out of range, so callers
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5959
     may have to do a bitwise-and on the result"
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5960
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5961
    self < 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5962
        ^ 16r100000000 + self
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5963
    ].
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5964
    ^ self
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5965
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5966
    "
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5967
     (-1 asUnsigned32) hexPrintString
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5968
     1 asUnsigned32
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5969
     (SmallInteger minVal asUnsigned32) hexPrintString
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5970
     (SmallInteger maxVal asUnsigned32) hexPrintString
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5971
    "
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5972
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5973
    "Modified (comment): / 17-03-2019 / 12:20:48 / Claus Gittinger"
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5974
!
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5975
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5976
asUnsigned64
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5977
    "return a 64-bit integer with my bit-pattern, but positive.
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5978
     May be required for bit operations on the sign-bit and/or to
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5979
     convert C/Java numbers.
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5980
     Does not check if the value is out of range, so callers
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  5981
     may have to do a bitwise-and on the result"
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5982
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5983
    self < 0 ifTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  5984
        ^ 16r10000000000000000 + self
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5985
    ].
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5986
    ^ self
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5987
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5988
    "
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5989
     (-1 asUnsigned64) hexPrintString
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5990
     1 asUnsigned64
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5991
     (SmallInteger minVal asUnsigned64) hexPrintString
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  5992
     (SmallInteger maxVal asUnsigned64) hexPrintString
24244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  5993
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  5994
     
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  5995
     (16r-8000000000000000 asUnsigned64) hexPrintString
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  5996
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  5997
     out of range: wrong results
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  5998
     (16r8000000000000000 asUnsigned64) hexPrintString
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  5999
     (16rFFFFFFFFFFFFFFFF asUnsigned64) hexPrintString
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  6000
     (16r-FFFFFFFFFFFFFFFF asUnsigned64) hexPrintString
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  6001
    "
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  6002
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  6003
    "Created: / 26-07-2013 / 13:45:11 / cg"
24244
1ff3f1032799 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 24192
diff changeset
  6004
    "Modified (comment): / 03-06-2019 / 18:49:12 / Claus Gittinger"
16293
0eb93c6dd384 class: Integer
Claus Gittinger <cg@exept.de>
parents: 16120
diff changeset
  6005
!
13725
90db4d7613ee category of:15 methods
Claus Gittinger <cg@exept.de>
parents: 13718
diff changeset
  6006
22072
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6007
asUnsigned:numBits
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6008
    "return a numBits integer with my bit-pattern, but positive.
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6009
     May be required for bit operations on the sign-bit and/or to
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  6010
     convert C/Java numbers, or to generate bitfields from signed numbers
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  6011
     (kind of the reverse operation to signExtenedFromBit:).
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  6012
     Does not check if the value is out of range, so callers
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  6013
     may have to do a bitwise-and on the result"
22072
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6014
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6015
    self < 0 ifTrue:[
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6016
        ^ (1 bitShift:numBits) + self
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6017
    ].
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6018
    ^ self
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6019
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6020
    "
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6021
     (-1 asUnsigned:64) hexPrintString
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6022
     1 asUnsigned:64
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6023
     (SmallInteger minVal asUnsigned:64) hexPrintString
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6024
     (SmallInteger maxVal asUnsigned:64) hexPrintString
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6025
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6026
     (-1 asUnsigned:4) hexPrintString
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6027
     (-7 asUnsigned:4) hexPrintString
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6028
     (-8 asUnsigned:4) hexPrintString
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6029
     1 asUnsigned:4
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6030
    "
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6031
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6032
    "Created: / 21-07-2017 / 15:11:40 / cg"
23930
4a6dd956e708 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 23646
diff changeset
  6033
    "Modified (comment): / 17-03-2019 / 12:21:15 / Claus Gittinger"
22072
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6034
!
c436a53aa43d #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 22071
diff changeset
  6035
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6036
bitAnd_32:anInteger
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6037
    "return a C-semantic 32bit locical-and of the receiver and
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6038
     the argument. Both must be either Small- or LargeIntegers.
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6039
     Returns a signed 32bit number.
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6040
     This (nonstandard) specialized method is provided to allow simulation of
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6041
     bit operations with C semantics."
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6042
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6043
%{  /* NOCONTEXT */
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6044
    int val1, val2, rslt;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6045
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6046
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6047
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6048
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6049
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6050
        if (!val1) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6051
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6052
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6053
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6054
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6055
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6056
        if (!val2) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6057
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6058
    rslt = val1 & val2;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6059
    RETURN(__MKINT(rslt));
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6060
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6061
  bad: ;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6062
%}.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6063
    self primitiveFailed.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6064
!
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6065
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6066
bitAnd_32u:anInteger
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6067
    "return a C-semantic 32bit locical-and of the receiver and
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6068
     the argument. Both must be either Small- or LargeIntegers.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6069
     Returns an unsigned 32bit number.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6070
     This (nonstandard) specialized method is provided to allow simulation of
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6071
     bit operations with C semantics."
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6072
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6073
%{  /* NOCONTEXT */
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6074
    int val1, val2, rslt;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6075
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6076
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6077
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6078
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6079
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6080
        if (!val1) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6081
    }
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6082
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6083
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6084
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6085
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6086
        if (!val2) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6087
    }
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6088
    rslt = val1 & val2;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6089
    RETURN(__MKUINT(rslt));
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6090
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6091
  bad: ;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6092
%}.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6093
    self primitiveFailed.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6094
!
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6095
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6096
bitInvert_32
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6097
    "return a C-semantic 32bit complement of the receiver,
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6098
     which must be either Small- or LargeIntegers.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6099
     Returns a signed 32bit number.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6100
     This (nonstandard) specialized method is provided to allow simulation of
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6101
     bit operations with C semantics."
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6102
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6103
%{  /* NOCONTEXT */
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6104
    int val, rslt;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6105
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6106
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6107
        val = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6108
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6109
        val = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6110
        if (!val) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6111
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6112
    rslt = ~val;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6113
    RETURN(__MKINT(rslt));
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6114
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6115
  bad: ;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6116
%}.
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6117
    self primitiveFailed.
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6118
!
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6119
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6120
bitInvert_32u
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6121
    "return a C-semantic 32bit complement of the receiver,
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6122
     which must be either Small- or LargeIntegers.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6123
     Returns an unsigned 32bit number.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6124
     This (nonstandard) specialized method is provided to allow simulation of
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6125
     bit operations with C semantics."
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6126
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6127
%{  /* NOCONTEXT */
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6128
    int val, rslt;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6129
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6130
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6131
        val = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6132
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6133
        val = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6134
        if (!val) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6135
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6136
    rslt = ~val;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6137
    RETURN(__MKUINT(rslt));
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6138
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6139
  bad: ;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6140
%}.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6141
    self primitiveFailed.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6142
!
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6143
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6144
bitOr_32:anInteger
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6145
    "return a C-semantic 32bit locical-or of the receiver and
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6146
     the argument. Both must be either Small- or LargeIntegers.
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6147
     Returns a signed 32bit number.
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6148
     This (nonstandard) specialized method is provided to allow simulation of
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6149
     bit operations with C semantics."
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6150
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6151
%{  /* NOCONTEXT */
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6152
    int val1, val2, rslt;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6153
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6154
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6155
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6156
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6157
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6158
        if (!val1) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6159
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6160
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6161
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6162
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6163
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6164
        if (!val2) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6165
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6166
    rslt = val1 | val2;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6167
    RETURN(__MKINT(rslt));
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6168
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6169
  bad: ;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6170
%}.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6171
    self primitiveFailed.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6172
!
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6173
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6174
bitOr_32u:anInteger
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6175
    "return a C-semantic 32bit locical-or of the receiver and
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6176
     the argument. Both must be either Small- or LargeIntegers.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6177
     Returns an unsigned 32bit number.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6178
     This (nonstandard) specialized method is provided to allow simulation of
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6179
     bit operations with C semantics."
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6180
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6181
%{  /* NOCONTEXT */
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6182
    int val1, val2, rslt;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6183
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6184
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6185
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6186
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6187
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6188
        if (!val1) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6189
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6190
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6191
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6192
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6193
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6194
        if (!val2) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6195
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6196
    rslt = val1 | val2;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6197
    RETURN(__MKUINT(rslt));
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6198
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6199
  bad: ;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6200
%}.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6201
    self primitiveFailed.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6202
!
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6203
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6204
bitXor_32:anInteger
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6205
    "return a C-semantic 32bit locical-xor of the receiver and
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6206
     the argument. Both must be either Small- or LargeIntegers.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6207
     Returns a signed 32bit number.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6208
     This (nonstandard) specialized method is provided to allow simulation of
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6209
     bit operations with C semantics."
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6210
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6211
%{  /* NOCONTEXT */
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6212
    int val1, val2, rslt;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6213
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6214
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6215
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6216
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6217
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6218
        if (!val1) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6219
    }
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6220
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6221
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6222
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6223
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6224
        if (!val2) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6225
    }
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6226
    rslt = val1 ^ val2;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6227
    RETURN(__MKINT(rslt));
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6228
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6229
  bad: ;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6230
%}.
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6231
    self primitiveFailed.
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6232
!
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6233
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6234
bitXor_32u:anInteger
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6235
    "return a C-semantic 32bit locical-xor of the receiver and
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6236
     the argument. Both must be either Small- or LargeIntegers.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6237
     Returns an unsigned 32bit number.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6238
     This (nonstandard) specialized method is provided to allow simulation of
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6239
     bit operations with C semantics."
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6240
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6241
%{  /* NOCONTEXT */
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6242
    int val1, val2, rslt;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6243
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6244
    if (__isSmallInteger(self)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6245
        val1 = __intVal(self);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6246
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6247
        val1 = __longIntVal(self);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6248
        if (!val1) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6249
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6250
    if (__isSmallInteger(anInteger)) {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6251
        val2 = __intVal(anInteger);
12652
840f87f12979 changed:14 methods
Claus Gittinger <cg@exept.de>
parents: 12605
diff changeset
  6252
    } else {
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6253
        val2 = __longIntVal(anInteger);
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6254
        if (!val2) goto bad;
12255
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6255
    }
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6256
    rslt = val1 ^ val2;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6257
    RETURN(__MKUINT(rslt));
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6258
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6259
  bad: ;
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6260
%}.
80362b5e0067 added:6 methods
Claus Gittinger <cg@exept.de>
parents: 12147
diff changeset
  6261
    self primitiveFailed.
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6262
! !
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  6263
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6264
!Integer methodsFor:'tracing'!
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6265
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4653
diff changeset
  6266
traceInto:aRequestor level:level from:referrer
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6267
    "double dispatch into tracer, passing my type implicitely in the selector"
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6268
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4653
diff changeset
  6269
    ^ aRequestor traceInteger:self level:level from:referrer
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6270
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6271
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6272
! !
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  6273
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6274
!Integer methodsFor:'truncation & rounding'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6275
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6276
ceiling
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6277
    "return the smallest integer which is larger or equal to the receiver.
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6278
     For integers, this is the receiver itself."
345
claus
parents: 328
diff changeset
  6279
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6280
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6281
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6282
    "Modified: 18.7.1996 / 12:44:06 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6283
!
345
claus
parents: 328
diff changeset
  6284
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6285
compressed
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6286
    "if the receiver can be represented as a SmallInteger, return
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6287
     a SmallInteger with my value; otherwise return self with leading
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6288
     zeros removed. This method is redefined in LargeInteger."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6289
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6290
    ^ self
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6291
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6292
    "Modified: 5.11.1996 / 14:07:41 / cg"
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  6293
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  6294
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6295
floor
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6296
    "return the largest integer which is smaller or equal to the receiver.
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6297
     For integers, this is the receiver itself."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6298
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6299
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6300
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6301
    "Modified: 18.7.1996 / 12:44:00 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6302
!
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  6303
1866
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6304
fractionPart
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6305
    "return a number with value from digits after the decimal point.
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6306
     (i.e. the receiver minus its truncated value)
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6307
     Since integers have no fraction, return 0 here."
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6308
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6309
    ^ 0
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6310
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6311
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6312
     1234.56789 fractionPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6313
     1.2345e6 fractionPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6314
     1000 fractionPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6315
     10000000000000000 fractionPart
1866
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6316
    "
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6317
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6318
    "Modified: 4.11.1996 / 20:27:44 / cg"
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6319
!
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6320
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6321
integerPart
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6322
    "return a number with value from digits before the decimal point.
18851
11fd28f8c61e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 18769
diff changeset
  6323
     (i.e. the receiver's truncated value)
1866
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6324
     Since integers have no fraction, return the receiver here."
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6325
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6326
    ^ self
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6327
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6328
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6329
     1234.56789 integerPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6330
     1.2345e6 integerPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6331
     1000 integerPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6332
     10000000000000000 integerPart
1866
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6333
    "
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6334
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6335
    "Modified: 4.11.1996 / 20:28:22 / cg"
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6336
!
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  6337
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6338
normalize
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6339
    "if the receiver can be represented as a SmallInteger, return
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6340
     a SmallInteger with my value; otherwise return self with leading
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6341
     zeros removed.
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6342
     This method is left for backward compatibility - it has been
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6343
     renamed to #compressed for ST-80 compatibility."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6344
9261
275c3c6392ed mark obsolete method
Stefan Vogel <sv@exept.de>
parents: 9141
diff changeset
  6345
    <resource: #obsolete>
275c3c6392ed mark obsolete method
Stefan Vogel <sv@exept.de>
parents: 9141
diff changeset
  6346
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6347
    ^ self compressed
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6348
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  6349
    "Modified: 5.11.1996 / 14:08:24 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6350
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6351
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6352
rounded
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6353
    "return the receiver rounded toward the next Integer -
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6354
     for integers this is the receiver itself."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6355
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6356
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6357
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6358
    "Modified: 18.7.1996 / 12:44:24 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6359
!
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  6360
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6361
truncated
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6362
    "return the receiver truncated towards zero as Integer
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6363
     for integers this is the receiver itself."
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  6364
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6365
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6366
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  6367
    "Modified: 18.7.1996 / 12:44:33 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6368
! !
569
7134eb78cf48 readFrom:onError: can now also read from a string
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  6369
8394
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  6370
!Integer methodsFor:'visiting'!
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  6371
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  6372
acceptVisitor:aVisitor with:aParameter
16723
12737e7310ae comment/format only
Claus Gittinger <cg@exept.de>
parents: 16379
diff changeset
  6373
    "dispatch for visitor pattern; send #visitInteger:with: to aVisitor"
8394
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  6374
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  6375
    ^ aVisitor visitInteger:self with:aParameter
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  6376
! !
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  6377
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6378
!Integer::ModuloNumber class methodsFor:'documentation'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6379
4803
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6380
copyright
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6381
"
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6382
 COPYRIGHT (c) 1999 by eXept Software AG
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6383
              All Rights Reserved
4803
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6384
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6385
 This software is furnished under a license and may be used
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6386
 only in accordance with the terms of that license and with the
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6387
 inclusion of the above copyright notice.   This software may not
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6388
 be provided or otherwise made available to, or used by, any
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6389
 other person.  No title to or ownership of the software is
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6390
 hereby transferred.
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6391
"
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6392
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6393
!
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6394
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6395
documentation
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6396
"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6397
    This is a helper class to perform fast computation of the modulus.
4609
6a1819c7a743 comment
Claus Gittinger <cg@exept.de>
parents: 4522
diff changeset
  6398
    (with big numbers, this does make a difference)
4803
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6399
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  6400
    WARNING: this does only work with numbers which have no common
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6401
             divisor (which is true for cryptographic applications).
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6402
             So, use this only if you know what you are doing ...
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6403
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6404
    [author:]
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6405
        Stefan Vogel
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6406
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6407
    [see also:]
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6408
        Integer SmallInteger LargeInsteger
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6409
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6410
    [instance variables:]
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6411
        modulus       the modulus
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6412
        reciprocal    reciprocal of the modulus
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6413
        shift         shift count to cut off some bits
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6414
"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6415
!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6416
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6417
examples
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6418
"
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6419
                                                                [exBegin]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6420
        17 asModuloNumber modulusOf:38
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6421
                                                                [exEnd]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6422
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6423
                                                                [exBegin]
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6424
        38 \\ 17
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6425
                                                                [exEnd]
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6426
"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6427
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6428
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6429
!Integer::ModuloNumber class methodsFor:'instance creation'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6430
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6431
modulus:anInteger
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6432
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6433
    ^ self new modulus:anInteger
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6434
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6435
    "Created: / 3.5.1999 / 11:13:15 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6436
    "Modified: / 3.5.1999 / 11:18:37 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6437
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6438
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6439
!Integer::ModuloNumber methodsFor:'accessing'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6440
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6441
modulus
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6442
    "return the modulus"
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6443
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6444
    ^ modulus
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6445
!
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6446
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6447
modulus:n
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6448
    "set the modulus"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6449
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6450
    modulus := n.
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6451
    reciprocal := n integerReciprocal.
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6452
    shift := n highBit negated.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6453
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6454
    "Created: / 3.5.1999 / 10:02:39 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6455
    "Modified: / 3.5.1999 / 14:30:49 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6456
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6457
5238
f7a816a660a3 categories
Claus Gittinger <cg@exept.de>
parents: 5210
diff changeset
  6458
!Integer::ModuloNumber methodsFor:'arithmetic'!
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6459
19125
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6460
modulusOf:dividend
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6461
    "compute the aNumber modulo myself.
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6462
     The shortcut works only, if dividend is < modulo * modulo
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6463
     (When doing arithmethic modulo something).
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6464
     Otherwise do it the long way"
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6465
19125
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6466
    |e t cnt abs isNegative|
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6467
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6468
    isNegative := dividend negative.
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6469
    isNegative ifTrue:[
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6470
        abs := dividend negated.
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6471
    ] ifFalse:[
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6472
        abs := dividend.
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6473
    ].
19874
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  6474
    abs < modulus ifTrue:[
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  6475
        ^ abs.
799e9018b187 #TUNING by stefan
Stefan Vogel <sv@exept.de>
parents: 19600
diff changeset
  6476
    ].
19125
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6477
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6478
"/    self assert:dividend < (modulus * modulus)
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6479
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6480
    "throw off low nbits(modulus)"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6481
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6482
    e := (abs bitShift:shift) * reciprocal.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6483
    e := (e bitShift:shift) * modulus.
19125
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6484
    e := abs - e.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6485
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6486
    "this subtract is done max 2 times"
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6487
    cnt := 2.
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6488
    [(t := e - modulus) >= 0] whileTrue:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6489
        e := t.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6490
        cnt == 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6491
            "shortcut didn't work, do it the long way"
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6492
            ^ e \\ modulus.
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6493
        ].
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6494
        cnt := cnt - 1.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6495
    ].
19125
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6496
    isNegative ifTrue:[
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6497
        ^ modulus - e.
Stefan Vogel <sv@exept.de>
parents: 19118
diff changeset
  6498
    ].
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6499
    ^ e.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6500
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6501
    "
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6502
     |m|
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6503
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6504
     m := self new modulus:7.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6505
     m modulusOf:55.
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6506
    "
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6507
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  6508
    "Shortcut does not work: (size of divisor vs. dividend):
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6509
     |m|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6510
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6511
     m := self new modulus:7.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6512
     m modulusOf:123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6513
    "
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6514
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6515
    "SLOW (using standard \\ operation):
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6516
     |m|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6517
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6518
     m := 123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6519
     Time millisecondsToRun:[
19078
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6520
        100000 timesRepeat:[
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6521
            874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658 \\ m
Claus Gittinger <cg@exept.de>
parents: 19076
diff changeset
  6522
        ]
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6523
     ]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6524
    "
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6525
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6526
    "fast (using moduloNumber with almost same-sized dividend and divisor):
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6527
     |m|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6528
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6529
     m := self new modulus:123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
19231
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6530
     Time millisecondsToRun:[
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6531
        100000 timesRepeat:[
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6532
            m modulusOf:874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6533
        ]
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6534
    ].
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6535
89380e45244b #REFACTORING
Stefan Vogel <sv@exept.de>
parents: 19164
diff changeset
  6536
10730930127807326146398409623772237722337234475792709784029183368622308259008044569184592041059181058049458041058052 
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  6537
    "
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  6538
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6539
    "Modified: / 3.5.1999 / 14:30:32 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6540
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6541
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6542
!Integer::ModuloNumber methodsFor:'converting'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6543
19405
Stefan Vogel <sv@exept.de>
parents: 19337
diff changeset
  6544
asInteger
Stefan Vogel <sv@exept.de>
parents: 19337
diff changeset
  6545
    "return the modulus"
Stefan Vogel <sv@exept.de>
parents: 19337
diff changeset
  6546
Stefan Vogel <sv@exept.de>
parents: 19337
diff changeset
  6547
    ^ modulus
Stefan Vogel <sv@exept.de>
parents: 19337
diff changeset
  6548
!
Stefan Vogel <sv@exept.de>
parents: 19337
diff changeset
  6549
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6550
asModuloNumber
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6551
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6552
    ^ self
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6553
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6554
    "Created: / 3.5.1999 / 14:48:27 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6555
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  6556
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  6557
!Integer class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6558
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  6559
version
18769
Claus Gittinger <cg@exept.de>
parents: 18380
diff changeset
  6560
    ^ '$Header$'
12122
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  6561
!
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  6562
Claus Gittinger <cg@exept.de>
parents: 11945
diff changeset
  6563
version_CVS
18769
Claus Gittinger <cg@exept.de>
parents: 18380
diff changeset
  6564
    ^ '$Header$'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  6565
! !
6858
13919a7544b6 raisedToInteger pushed up
Claus Gittinger <cg@exept.de>
parents: 6682
diff changeset
  6566
14677
9f2ca6ba577f class: Integer
Claus Gittinger <cg@exept.de>
parents: 14491
diff changeset
  6567
4996
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
  6568
Integer initialize!