Integer.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 18 Jul 2012 17:55:48 +0100
branchjv
changeset 17951 fa0e1d7467ea
parent 17938 e2aad1d7c317
child 17966 8b5df02e171f
permissions -rw-r--r--
Merged with /CVS
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
5435
ad6612cc6848 oops odd/even fallback was wrong
Claus Gittinger <cg@exept.de>
parents: 5238
diff changeset
    12
"{ Package: 'stx:libbasic' }"
ad6612cc6848 oops odd/even fallback was wrong
Claus Gittinger <cg@exept.de>
parents: 5238
diff changeset
    13
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
Number subclass:#Integer
1210
b2fbf119dbbd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    15
	instanceVariableNames:''
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
    16
	classVariableNames:'DefaultDisplayRadix BCDConversionErrorSignal PrimeCache'
1210
b2fbf119dbbd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    17
	poolDictionaries:''
b2fbf119dbbd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    18
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    21
Object subclass:#ModuloNumber
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    22
	instanceVariableNames:'modulus reciprocal shift'
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    23
	classVariableNames:''
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    24
	poolDictionaries:''
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    25
	privateIn:Integer
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    26
!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
    27
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    28
!Integer class methodsFor:'documentation'!
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    32
 COPYRIGHT (c) 1988 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
    33
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    34
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    43
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
documentation
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
    abstract superclass for all integer numbers.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    47
    See details in concrete subclasses LargeInteger and SmallInteger.
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
    48
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
    49
    Mixed mode arithmetic:
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    50
	int op int         -> int
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    51
	int op fix         -> fix; scale is fix's scale
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    52
	int op fraction    -> fraction
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    53
	int op float       -> float
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
    54
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
    55
    [Class variables:]
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
    56
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
    57
	DefaultDisplayRadix     the radix in which integers present their
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    58
				displayString (which is used in inspectors)
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    59
				If you are to look at many hex numbers, bitmasks
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    60
				etc. you may set this to 2 or 16.
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    61
				(avoids typing printStringRadix:.. all the time
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    62
				 - I know - I am lazy ;-). Default is 10.
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
    63
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
    64
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1210
diff changeset
    65
    [author:]
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    66
	Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1555
diff changeset
    67
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1555
diff changeset
    68
    [see also:]
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    69
	Number
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    70
	LargeInteger SmallInteger
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
    71
	Float ShortFloat Fraction FixedPoint
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    72
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    73
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    75
!Integer class methodsFor:'instance creation'!
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
    76
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    77
byte1:b1 byte2:b2 byte3:b3 byte4:b4
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    78
    "Squeak compatibility:
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    79
     Return an Integer given four value bytes.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    80
     The returned integer is either a Small- or a LargeInteger"
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    81
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    82
    |t|
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
    t := b4.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    85
    t := (t bitShift:8) + b3.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    86
    t := (t bitShift:8) + b2.
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    87
    ^ (t bitShift:8) + b1.
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
    "
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    90
     (Integer byte1:16r10 byte2:16r32 byte3:16r54 byte4:16r76) hexPrintString
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    91
     (Integer byte1:16r00 byte2:16r11 byte3:16r22 byte4:16r33) hexPrintString
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    92
    "
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    93
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    94
    "Created: 19.10.1997 / 18:08:52 / cg"
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    95
    "Modified: 19.10.1997 / 18:09:04 / cg"
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    96
!
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
    97
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
    98
fastFromString:aString at:startIndex
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
    99
    "return the next unsigned Integer from the string
4610
742650733761 comment
Claus Gittinger <cg@exept.de>
parents: 4609
diff changeset
   100
     as a decimal number, starting at startIndex.
742650733761 comment
Claus Gittinger <cg@exept.de>
parents: 4609
diff changeset
   101
     The number must be in the native machines int range
742650733761 comment
Claus Gittinger <cg@exept.de>
parents: 4609
diff changeset
   102
     (i.e. 63bit on alpha / 31 on all others);
742650733761 comment
Claus Gittinger <cg@exept.de>
parents: 4609
diff changeset
   103
     However, for portability, only use it for 31bit numbers.
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   104
     No spaces are skipped.
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   105
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   106
     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
   107
     returns garbage if the argument string is not a small integer number.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   108
     It has been added to allow high speed string decomposition into numbers,
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   109
     especially for mass-data."
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   110
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   111
%{   /* NOCONTEXT */
17735
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   112
    if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   113
        char *cp = (char *)(__stringVal(aString));
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   114
        int idx = __intVal(startIndex) - 1;
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   115
        unsigned INT val;
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   116
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   117
        if ((unsigned)idx < __stringSize(aString)) {
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   118
            val = atoi(cp + idx);
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   119
            if (val <= _MAX_INT) {
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   120
                RETURN(__mkSmallInteger(val));
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   121
            }
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   122
            RETURN (__MKUINT(val));
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   123
        }
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   124
    }
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   125
%}.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   126
    self primitiveFailed.
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   127
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   128
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   129
     Integer fastFromString:'12345' at:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   130
     Integer fastFromString:'12345' at:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   131
     Integer fastFromString:'12345' at:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   132
     Integer fastFromString:'12345' at:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   133
     Integer fastFromString:'12345' at:5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   134
     Integer fastFromString:'1234512345' at:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   135
     Integer fastFromString:'2147483647' at:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   136
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   137
     Integer fastFromString:'4294967295' at:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   138
     Integer fastFromString:'12345' at:6
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   139
     Integer fastFromString:'12345' at:0
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   140
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   141
     Time millisecondsToRun:[
17735
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   142
        100000 timesRepeat:[
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   143
            Integer readFrom:'12345'
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   144
        ]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   145
     ]
3639
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
    "
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   149
     Time millisecondsToRun:[
17735
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   150
        100000 timesRepeat:[
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   151
            Integer fastFromString:'12345' at:1
6a5bc05f696a Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17734
diff changeset
   152
        ]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   153
     ]
3639
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   154
    "
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   155
!
c4fbb700a569 added #fastFromString: (for Andis IEC-SocketInterface)
Claus Gittinger <cg@exept.de>
parents: 3638
diff changeset
   156
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   157
fromBCDBytes:aByteArray
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   158
    "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
   159
     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
   160
     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
   161
     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
   162
     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
   163
    "
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
    |val|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   166
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   167
    val := 0.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   168
    aByteArray do:[:twoDigits |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   169
	|hi lo|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   170
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   171
	hi := (twoDigits bitShift:-4) bitAnd:16r0F.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   172
	lo := twoDigits bitAnd:16r0F.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   173
	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
   174
    ].
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   175
    ^ val
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   176
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
   177
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   178
     Integer fromBCDBytes:#[16r12 16r34 16r56]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   179
     Integer fromBCDBytes:#[16r12 16r34 16r56 16r78]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   180
     Integer fromBCDBytes:#[16r12 16r34 16r56 16r78 16r90]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   181
     Integer fromBCDBytes:#[16r98 16r76 16r54]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   182
     Integer fromBCDBytes:#[16r98 16r76 16r54 16r32]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   183
     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
   184
     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
   185
    "
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
5171
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   188
fromSwappedBCDBytes:aByteArray
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   189
    "given a byteArray in BCD format, return an appropriate integer.
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   190
     The byteArray must contain the BCD encoded decimal string,
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   191
     starting with the LEAST significant digits.
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   192
     This conversion is useful for some communication protocols,
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   193
     or control systems (e.g. SMC), which represent big numbers this way...
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   194
    "
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
    |val|
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   197
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   198
    val := 0.
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   199
    aByteArray do:[:twoDigits |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   200
	|hi lo|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   201
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   202
	lo := (twoDigits bitShift:-4) bitAnd:16r0F.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   203
	hi := twoDigits bitAnd:16r0F.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   204
	lo <= 9 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   205
	    val := (val * 100) + (hi * 10) + lo
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   206
	] ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   207
	    "16rF is used to encode an odd number of digits"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   208
	    val := (val * 10) + hi.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   209
	].
5171
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   210
    ].
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   211
    ^ val
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   212
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   213
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   214
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   215
     Integer fromSwappedBCDBytes:#[16r12 16r34 16rF6]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   216
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56 16r78]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   217
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56 16r78 16r90]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   218
     Integer fromSwappedBCDBytes:#[16r98 16r76 16r54]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   219
     Integer fromSwappedBCDBytes:#[16r98 16r76 16r54 16r32]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   220
     Integer fromSwappedBCDBytes:#[16r98 16r76 16r54 16r32 16r10]
5171
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   221
     Integer fromSwappedBCDBytes:#[16r12 16r34 16r56 16r78 16r90 16r12 16r34 16r56 16r78 16r90]
6dc2f5a18953 Add #fromSwappedBCDBytes
Stefan Vogel <sv@exept.de>
parents: 5017
diff changeset
   222
    "
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
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   225
new:numberOfBytes neg:negative
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   226
    "for ST-80 compatibility:
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   227
     Return an empty Integer (uninitialized value) with space for
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   228
     numberOfBytes bytes (= digitLength). The additional argument
132
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   229
     negative specifies if the result should be a negative number.
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   230
     The digits can be stored byte-wise into the result, using digitAt:put:"
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   231
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   232
    ^ (LargeInteger basicNew numberOfDigits:numberOfBytes)
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
   233
		sign:(negative ifTrue:[-1] ifFalse:[1])
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   234
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   235
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   236
readFrom:aStringOrStream
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   237
    "return the next unsigned Integer from the (character-)stream aStream
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   238
     as decimal number.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   239
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   240
     NOTICE:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   241
       This behaves different from the default readFrom:, in returning
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   242
       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
   243
       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
   244
       - depending on the upcoming ANSI standard, this may change."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   245
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   246
    ^ self readFrom:aStringOrStream onError:0
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
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   249
     Integer readFrom:(ReadStream on:'foobar')
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   250
     Integer readFrom:(ReadStream on:'foobar') onError:nil
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   251
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   252
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   253
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   254
readFrom:aStringOrStream onError:exceptionBlock
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   255
    "return the next Integer from the (character-)stream aStream,
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   256
     handling initial XXr for arbitrary radix numbers and initial sign.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   257
     Also, all initial whitespace is skipped.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   258
     If the string does not represent a valid integer number,
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   259
     return the value of exceptionBlock."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   260
3995
777470826394 no need for another error-handler blcok in #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3993
diff changeset
   261
    |value|
777470826394 no need for another error-handler blcok in #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3993
diff changeset
   262
7093
60bad14d38fc Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 6907
diff changeset
   263
    Error handle:[:ex |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   264
	^ exceptionBlock value
1700
25223802076c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1560
diff changeset
   265
    ] do:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   266
	|str nextChar negative|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   267
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   268
	str := aStringOrStream readStream.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   269
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   270
	nextChar := str skipSeparators.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   271
	(nextChar == $-) ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   272
	    negative := true.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   273
	    str next.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   274
	    nextChar := str peekOrNil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   275
	] ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   276
	    negative := false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   277
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   278
	(nextChar isNil or:[nextChar isDigit not]) ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   279
	    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   280
	     the string does not represent an integer
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   281
	    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   282
	    ^ exceptionBlock value
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   283
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   284
	value := self readFrom:str radix:10.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   285
	nextChar := str peekOrNil.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   286
	((nextChar == $r) or:[ nextChar == $R]) ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   287
	    "-xxr<number> is invalid; should be xxr-<val>"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   288
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   289
	    negative ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   290
		'Integer [warning]: invalid (negative) radix ignored' errorPrintCR.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   291
		negative := false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   292
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   293
	    str next.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   294
	    value := self readFrom:str radix:value
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   295
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   296
	negative ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   297
	    value := value negated
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   298
	].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   299
    ].
3995
777470826394 no need for another error-handler blcok in #readFrom:onError:
Claus Gittinger <cg@exept.de>
parents: 3993
diff changeset
   300
    ^ value
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   301
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   302
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   303
     Integer readFrom:'12345'      onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   304
     Integer readFrom:'-12345'     onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   305
     Integer readFrom:'+12345'     onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   306
     Integer readFrom:'16rFFFF'    onError:['wrong']
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   307
     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
   308
     Integer readFrom:'foo'        onError:['wrong']
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   309
     Integer readFrom:'foo'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   310
    "
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   311
3374
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   312
    "Created: / 16.11.1995 / 22:48:59 / cg"
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   313
    "Modified: / 14.4.1998 / 19:17:28 / cg"
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
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   316
readFrom:aStringOrStream radix:radix
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   317
    "return the next unsigned Integer from the (character-)stream aStream
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   318
     in radix; (assumes that the initial XXr has already been read).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   319
     No whitespace-skipping is done.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   320
     Returns 0 if no number available.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   321
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   322
     NOTICE:
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   323
       This behaves different from the default readFrom:, in returning
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   324
       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
   325
       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
   326
       - depending on the upcoming ANSI standard, this may change."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   327
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   328
    ^ self readFrom:aStringOrStream radix:radix onError:0
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   329
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   330
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   331
readFrom:aStringOrStream radix:radix onError:exceptionBlock
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   332
    "return the next unsigned Integer from the (character-)stream aStream
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   333
     in radix; (assumes that the initial XXr has already been read).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   334
     No whitespace-skipping is done.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   335
     Returns the value of exceptionBlock, if no number is available."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   336
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   337
    |str nextChar nextChar2 nextChar3 nextChar4 value
4169
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   338
     r     "{ Class: SmallInteger }"
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   339
     r2    "{ Class: SmallInteger }"
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   340
     r3    "{ Class: SmallInteger }"
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   341
     r4    "{ Class: SmallInteger }"
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   342
     digit1 digit2 digit3 digit4 |
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   343
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   344
    str := aStringOrStream readStream.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   345
3374
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   346
    nextChar := str peekOrNil.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   347
    (nextChar notNil and:[nextChar isDigitRadix:radix]) ifFalse:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   348
	^ exceptionBlock value
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   349
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   350
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   351
    value := nextChar digitValue.
3374
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   352
    str next.
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   353
    nextChar := str peekOrNil.
4169
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   354
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   355
"/ OLD code
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   356
"/    [nextChar notNil and:[nextChar isDigitRadix:radix]] whileTrue:[
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   357
"/        str next.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   358
"/        value := value * radix + nextChar digitValue.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   359
"/        nextChar := str peekOrNil.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   360
"/    ].
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   361
"/    ^ value.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   362
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   363
    "/ 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
   364
    "/ converted number is large
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   365
    "/ (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
   366
    "/ It should not be slower for smallIntegers.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   367
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   368
    r := radix.
7079cb06963b tuned string -> integer conversion for Large numbers.
Claus Gittinger <cg@exept.de>
parents: 4158
diff changeset
   369
    r2 := r * r.
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   370
    r3 := r2 * r.
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   371
    r4 := r2 * r2.
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   372
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   373
    [nextChar notNil and:[ (digit1 := nextChar digitValueRadix:r) notNil]] whileTrue:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   374
	"/ read 4 chars and pre-compute their value to avoid largeInt operations.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   375
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   376
	str next.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   377
	nextChar2 := str peekOrNil.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   378
	(nextChar2 isNil or:[ (digit2 := nextChar2 digitValueRadix:r) isNil]) ifTrue:[
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   379
	    ^ (value * r) + digit1.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   380
	].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   381
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   382
	str next.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   383
	nextChar3 := str peekOrNil.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   384
	(nextChar3 isNil or:[ (digit3 := nextChar3 digitValueRadix:r) isNil]) ifTrue:[
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   385
	    ^ (value * r2) + ((digit1*r) + digit2).
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   386
	].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   387
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   388
	str next.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   389
	nextChar4 := str peekOrNil.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   390
	(nextChar4 isNil or:[ (digit4 := nextChar4 digitValueRadix:r) isNil]) ifTrue:[
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   391
	    ^ (value * r3) + ((((digit1*r) + digit2)*r) + digit3).
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   392
	].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   393
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   394
	value := (value * r4) + ((((((digit1*r) + digit2)*r) + digit3)*r) + digit4).
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   395
	str next.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   396
	nextChar := str peekOrNil.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   397
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   398
    ^ value
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   399
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   400
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   401
     Integer readFrom:(ReadStream on:'12345') radix:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   402
     Integer readFrom:(ReadStream on:'FFFF') radix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   403
     Integer readFrom:(ReadStream on:'1010') radix:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   404
     Integer readFrom:(ReadStream on:'foobar') radix:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   405
     Integer readFrom:(ReadStream on:'foobar') radix:10 onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   406
     Integer readFrom:'gg' radix:10 onError:0
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   407
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   408
     Time millisecondsToRun:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   409
	1000 timesRepeat:[
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   410
	    (String new:1000 withAll:$1) asInteger
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   411
	]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   412
     ]
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   413
    "
3374
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   414
6897f584accb faster conversion from string (due to slow #pastEnd)
Claus Gittinger <cg@exept.de>
parents: 3298
diff changeset
   415
    "Modified: / 14.4.1998 / 19:16:46 / cg"
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   416
!
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   417
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   418
readFromRomanString:aStringOrStream
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   419
    "convert a string or stream containing a roman representation into an integer.
11125
89eb8912ef38 comment
Claus Gittinger <cg@exept.de>
parents: 11095
diff changeset
   420
     Raises a RomanNumberFormatError, if the inputs format is completely wrong.
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   421
     Raises BadRomanNumberFormatError if its wrong, but could be parsed.
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   422
     Notifies via NaiveRomanNumberFormatNotification, if its a bit wrong (naive format).
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   423
     Will read both real and naive roman numbers (see printRomanOn: vs. printRomanOn:naive:),
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   424
     however, a notification is raised for for naive numbers (catch it if you are interested in it)."
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   425
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   426
    |romanValues s c val digitVal prevDigitVal countSame delta
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   427
     stopOnSeparator finish|
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   428
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   429
    romanValues := Dictionary
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   430
		    withKeys:#($M $D $C $L $X $V $I)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   431
		    andValues:#(1000 500 100 50 10 5 1).
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   432
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   433
    (stopOnSeparator := aStringOrStream isStream) ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   434
	s := aStringOrStream readStream.
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   435
    ].
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   436
    s atEnd ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   437
	^ RomanNumberFormatError raiseErrorString:'empty string'
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   438
    ].
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   439
    val := 0.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   440
    prevDigitVal := 99999.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   441
    countSame := 1.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   442
    finish := false.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   443
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   444
    [s atEnd or:[finish]] whileFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   445
	c := s next asUppercase.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   446
	c isSeparator ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   447
	    stopOnSeparator ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   448
		^ RomanNumberFormatError raiseErrorString:'garbage at the end'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   449
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   450
	    finish := true.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   451
	] ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   452
	    digitVal := romanValues at:c ifAbsent:nil.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   453
	    digitVal isNil ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   454
		^ RomanNumberFormatError raiseErrorString:'invalid character'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   455
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   456
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   457
	    digitVal = prevDigitVal ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   458
		( #( 1 10 100 1000) includes:digitVal) ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   459
		    ^ RomanNumberFormatError raiseErrorString:'character may not be repeated'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   460
		].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   461
		val := val + digitVal.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   462
		countSame := countSame + 1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   463
		countSame >= 4 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   464
		    digitVal ~= 1000 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   465
			countSame > 4 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   466
			    "/ this is a bad roman number (such as MCCCCCCCCXXXXXXII);
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   467
			    "/ Its not correct, but sometimes encountered on buildings.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   468
			    "/ If you do not want to be too picky,
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   469
			    "/ provide a proceeding handler in order to proceed the conversion.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   470
			    BadRomanNumberFormatError raiseRequestErrorString:'more than 4 occurrences of same character'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   471
			] ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   472
			    "/ this is a naive roman number (such as VIIII);
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   473
			    "/ Its not correct, but very often encountered (especially as page numbers).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   474
			    "/ The notification below normally goes unnoticed, unless some input validator
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   475
			    "/ wants to be very picky, and treat this as an error.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   476
			    "/ To do so, provide a handler for NaiveRomanNumberFormatNotification.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   477
			    NaiveRomanNumberFormatNotification raiseRequestErrorString:'more than 3 occurrences of same character'.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   478
			]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   479
		    ]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   480
		].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   481
	    ] ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   482
		digitVal < prevDigitVal ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   483
		    val := val + digitVal.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   484
		] ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   485
		    countSame == 1 ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   486
			^ RomanNumberFormatError raiseErrorString:'invalid character combination'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   487
		    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   488
		    delta := digitVal - prevDigitVal.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   489
		    ( #( 4 9 40 90 400 900) includes:delta) ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   490
			^ RomanNumberFormatError raiseErrorString:'invalid character combination'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   491
		    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   492
		    val := val - prevDigitVal.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   493
		    val := val + delta.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   494
		    digitVal := prevDigitVal - 0.1.  "/ trick: prevent prevDigit from arriving again.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   495
		].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   496
		countSame := 1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   497
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   498
	    prevDigitVal := digitVal.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   499
	].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   500
    ].
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   501
"/    val > 5000 ifTrue:[
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   502
"/        ^ RomanNumberFormatError raiseErrorStirng:'number out of range (1..5000)'
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   503
"/    ].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   504
    ^ val.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   505
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   506
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   507
     Integer readFromRomanString:'I'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   508
     Integer readFromRomanString:'II'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   509
     Integer readFromRomanString:'III'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   510
     Integer readFromRomanString:'IV'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   511
     Integer readFromRomanString:'clix'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   512
     Integer readFromRomanString:'MIX'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   513
     Integer readFromRomanString:'MCMXCIX'
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   514
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   515
   Naive cases (which are accepted):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   516
     Integer readFromRomanString:'IIII'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   517
     Integer readFromRomanString:'VIIII'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   518
     Integer readFromRomanString:'CLXXXXVIIII'
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   519
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   520
    Error case (not proceedable):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   521
     Integer readFromRomanString:'LC'
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   522
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   523
    Error case (proceedable):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   524
     Integer readFromRomanString:'MCCCCCCCCXXXXXXIIIIII'
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   525
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   526
     BadRomanNumberFormatError ignoreIn:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   527
	 Integer readFromRomanString:'MCCCCCCCCXXXXXXIIIIII'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   528
     ]
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   529
    "
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   530
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   531
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   532
    "naive cases:
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   533
     #(
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   534
	'MCMXCIX'           1999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   535
	'MCMXCVIIII'        1999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   536
	'MCMLXXXXIX'        1999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   537
	'MDCCCCXCIX'        1999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   538
	'MDCCCCXCVIIII'     1999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   539
	'MDCCCCLXXXXIX'     1999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   540
	'MDCCCCLXXXXVIIII'  1999
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   541
     ) pairWiseDo:[:goodString :expectedValue |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   542
	(Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   543
     ]
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   544
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   545
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   546
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   547
    "error cases:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   548
      #(
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   549
	'XIIX'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   550
	'VV'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   551
	'VVV'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   552
	'XXL'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   553
	'XLX'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   554
	'LC'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   555
	'LL'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   556
	'DD'
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   557
     ) do:[:badString |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   558
	(Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   559
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   560
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   561
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   562
    "good cases:
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   563
     #( 'I'     1
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   564
	'II'    2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   565
	'III'   3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   566
	'IV'    4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   567
	'V'     5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   568
	'VI'    6
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   569
	'VII'   7
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   570
	'VIII'  8
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   571
	'IX'    9
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   572
	'X'     10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   573
	'XI'    11
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   574
	'XII'   12
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   575
	'XIII'  13
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   576
	'XIV'   14
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   577
	'XV'    15
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   578
	'XVI'   16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   579
	'XVII'  17
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   580
	'XVIII' 18
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   581
	'XIX'   19
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   582
	'XX'    20
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   583
	'XXX'   30
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   584
	'L'     50
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   585
	'XL'    40
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   586
	'LX'    60
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   587
	'LXX'   70
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   588
	'LXXX'  80
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   589
	'CXL'   140
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   590
	'CL'    150
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   591
	'CLX'   160
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   592
	'MMM'                   3000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   593
	'MMMM'                  4000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   594
	'MMMMCMXCIX'            4999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   595
	'MMMMMMMMMCMXCIX'       9999
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   596
     ) pairWiseDo:[:goodString :expectedValue |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   597
	(Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   598
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   599
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   600
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   601
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   602
      1 to:9999 do:[:n |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   603
	|romanString|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   604
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   605
	romanString := String streamContents:[:stream | n printRomanOn:stream].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   606
	(Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   607
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   608
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   609
!
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   610
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   611
readFromRomanString:aStringOrStream onError:exceptionalValue
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   612
    "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
   613
     Raises an exception, if the inputs format is wrong.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   614
     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
   615
     bad (not using L and D) roman numbers.
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   616
     (Such numbers can be seen on some medevial buildings. "
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   617
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   618
    |val|
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   619
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   620
    RomanNumberFormatError
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   621
	handle:[:ex |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   622
	    val := exceptionalValue value
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   623
	]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   624
	do:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   625
	    val := self readFromRomanString:aStringOrStream
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   626
	].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   627
    ^ val
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   628
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   629
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   630
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   631
     Integer readFromRomanString:'I'    onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   632
     Integer readFromRomanString:'II'   onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   633
     Integer readFromRomanString:'III'  onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   634
     Integer readFromRomanString:'IV'   onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   635
     Integer readFromRomanString:'clix' onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   636
     Integer readFromRomanString:'MCMXCIX' onError:nil
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   637
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   638
   Naive cases (which are accepted):
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   639
     Integer readFromRomanString:'IIII' onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   640
     Integer readFromRomanString:'VIIII' onError:nil
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   641
     Integer readFromRomanString:'CLXXXXVIIII' onError:nil
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   642
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   643
   Error cases:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   644
\     Integer readFromRomanString:'LC'   onError:nil
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   645
    "
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
    "error cases:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   648
      #(
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   649
	'XIIX'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   650
	'VV'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   651
	'VVV'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   652
	'XXL'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   653
	'XLX'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   654
	'LC'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   655
	'LL'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   656
	'DD'
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   657
     ) do:[:badString |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   658
	(Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
6673
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
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   661
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   662
    "naive (but handled) cases:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   663
      #(
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   664
	'IIII'   4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   665
	'VIIII'  9
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   666
	'XIIII'  14
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   667
	'XVIIII' 19
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   668
     ) pairWiseDo:[:goodString :expectedValue |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   669
	(Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   670
     ]
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   671
    "
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
   672
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   673
    "good cases:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   674
     #( 'I'     1
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   675
	'II'    2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   676
	'III'   3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   677
	'IV'    4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   678
	'V'     5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   679
	'VI'    6
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   680
	'VII'   7
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   681
	'VIII'  8
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   682
	'IX'    9
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   683
	'X'     10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   684
	'XI'    11
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   685
	'XII'   12
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   686
	'XIII'  13
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   687
	'XIV'   14
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   688
	'XV'    15
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   689
	'XVI'   16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   690
	'XVII'  17
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   691
	'XVIII' 18
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   692
	'XIX'   19
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   693
	'XX'    20
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   694
	'XXX'   30
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   695
	'L'     50
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   696
	'XL'    40
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   697
	'LX'    60
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   698
	'LXX'   70
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   699
	'LXXX'  80
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   700
	'CXL'   140
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   701
	'CL'    150
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   702
	'CLX'   160
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   703
	'MMM'                   3000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   704
	'MMMM'                  4000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   705
	'MMMMCMXCIX'            4999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   706
	'MMMMMMMMMCMXCIX'       9999
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   707
     ) pairWiseDo:[:goodString :expectedValue |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   708
	(Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   709
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   710
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   711
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   712
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   713
      1 to:9999 do:[:n |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   714
	|romanString|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   715
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   716
	romanString := String streamContents:[:stream | n printRomanOn:stream].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   717
	(Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   718
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   719
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   720
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   721
    "reading naive numbers:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   722
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
   723
      1 to:9999 do:[:n |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   724
	|romanString|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   725
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   726
	romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   727
	(Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   728
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
   729
    "
8897
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   730
!
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   731
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   732
readFromString:aString radix:base onError:exceptionBlock
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   733
    |str val|
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   734
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   735
    str := ReadStream on:aString.
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   736
    val := self readFrom:str radix:base onError:[^ exceptionBlock value].
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   737
    str atEnd ifFalse:[ ^ exceptionBlock value].
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
   738
    ^ val
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   739
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   740
9141
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   741
!Integer class methodsFor:'Compatibility-Squeak'!
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   742
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   743
readFrom:aStringOrStream base:aBase
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   744
    "for squeak compatibility"
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   745
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   746
    ^ self readFrom:aStringOrStream radix:aBase
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   747
! !
dc20ee8ba916 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9136
diff changeset
   748
4996
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   749
!Integer class methodsFor:'Signal constants'!
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   750
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   751
bcdConversionErrorSignal
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   752
    "return the signal which is raised when bcd conversion fails
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   753
     (i.e. when trying to decode an invalid BCD number)"
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   754
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   755
    ^ BCDConversionErrorSignal
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   756
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   757
    "Modified: / 15.11.1999 / 20:35:20 / cg"
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   758
! !
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
   759
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   760
!Integer class methodsFor:'class initialization'!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   761
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   762
initialize
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   763
    BCDConversionErrorSignal isNil ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   764
	BCDConversionErrorSignal := ConversionError newSignal.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   765
	BCDConversionErrorSignal nameClass:self message:#bcdConversionErrorSignal.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   766
	BCDConversionErrorSignal notifierString:'bcd conversion error'.
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   767
    ].
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   768
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   769
    "Modified: / 15.11.1999 / 20:36:04 / cg"
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   770
! !
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   771
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   772
!Integer class methodsFor:'constants'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   773
7727
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   774
epsilon
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   775
    "return the maximum relative spacing"
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   776
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   777
    "don't know, what to really return here.
8635
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   778
     Returning 1 gives stupid values when doing some taylor series approximations
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   779
     (although it is correct)"
7727
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   780
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   781
    ^ Float epsilon.
8635
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   782
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   783
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   784
     2 sqrt_withAccuracy:(Integer epsilon)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   785
     2 sqrt_withAccuracy:1
8635
38674ba49a14 comment
Claus Gittinger <cg@exept.de>
parents: 8573
diff changeset
   786
    "
7727
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   787
!
bda9f88c6847 Define #epsilon
Stefan Vogel <sv@exept.de>
parents: 7685
diff changeset
   788
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   789
unity
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   790
    "return the neutral element for multiplication (1)"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   791
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   792
    ^ 1
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   793
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   794
    "Modified: 18.7.1996 / 12:26:43 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   795
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   796
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   797
zero
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   798
    "return the neutral element for addition (0)"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   799
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   800
    ^ 0
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   801
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
   802
    "Modified: 18.7.1996 / 12:26:38 / cg"
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   803
! !
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   804
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   805
!Integer class methodsFor:'misc'!
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   806
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   807
displayRadix:aNumber
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 52
diff changeset
   808
    "being tired of always sending #printStringRadix: in the inspectors,
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   809
     this allows you to change the default print radix for the displayString
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   810
     method."
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   811
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   812
    DefaultDisplayRadix := aNumber
132
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   813
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   814
    "
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   815
     Integer displayRadix:16. 123456 inspect
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   816
     Integer displayRadix:10. 123456 inspect
ab2cfccd218c *** empty log message ***
claus
parents: 92
diff changeset
   817
    "
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   818
! !
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
   819
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   820
!Integer class methodsFor:'prime numbers'!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   821
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   822
flushPrimeCache
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   823
    "cleanup after using a primeCache"
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   824
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   825
    PrimeCache := nil.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   826
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   827
    "
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   828
     Integer initializePrimeCacheUpTo:1000000
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   829
     Integer flushPrimeCache.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   830
    "
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   831
!
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   832
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   833
initializePrimeCacheUpTo:limit
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   834
    "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
   835
     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
   836
     (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
   837
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   838
    |bits|
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   839
11563
a91c8d348760 could have returned an uncompressed largeint after bitShift
Claus Gittinger <cg@exept.de>
parents: 11521
diff changeset
   840
    PrimeCache := nil.
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   841
    bits := BooleanArray new:limit//2.
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   842
    self primesUpTo:limit do:[:p |
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   843
	bits at:p//2 put:true
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   844
    ].
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   845
    PrimeCache := bits.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   846
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   847
    "
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   848
     Integer initializePrimeCacheUpTo:1000000.
11654
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   849
     Integer initializePrimeCacheUpTo:10000000.
9dd403ddfb91 tuned largeInteger reading
Claus Gittinger <cg@exept.de>
parents: 11587
diff changeset
   850
     Integer initializePrimeCacheUpTo:100000000.
11563
a91c8d348760 could have returned an uncompressed largeint after bitShift
Claus Gittinger <cg@exept.de>
parents: 11521
diff changeset
   851
     Integer initializePrimeCacheUpTo:1000000000.
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   852
     Integer flushPrimeCache.
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   853
    "
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   854
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   855
    "
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   856
     Integer flushPrimeCache.
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   857
     Transcript showCR:(
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   858
	Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   859
     ).
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   860
     Integer initializePrimeCacheUpTo:100000.
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   861
     Transcript showCR:(
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
   862
	Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
   863
     ).
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   864
     Integer flushPrimeCache.
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   865
    "
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   866
!
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   867
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   868
largePrimesUpTo: max do: aBlock
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
   869
    "Evaluate aBlock with all primes up and including maxValue.
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   870
     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
   871
     It encodes prime numbers much more compactly than #primesUpTo:
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   872
     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
   873
     (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
   874
     the regular #primesUpTo: would require 4 *GIGA*bytes).
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   875
     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
   876
     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
   877
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   878
    | limit flags maskBitIndex bitIndex maskBit byteIndex index primesUpTo2310 indexLimit |
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   879
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
   880
    limit := max asInteger.
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   881
    indexLimit := max sqrt truncated + 1.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   882
    "Create the array of flags."
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   883
    flags := ByteArray new: (limit + 2309) // 2310 * 60 + 60.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   884
    flags atAllPut: 16rFF. "set all to true"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   885
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   886
    "Compute the primes up to 2310"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   887
    primesUpTo2310 := self primesUpTo: 2310.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   888
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   889
    "Create a mapping from 2310 integers to 480 bits (60 byte)"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   890
    maskBitIndex := Array new: 2310.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   891
    bitIndex := -1. "for pre-increment"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   892
    maskBitIndex at: 1 put: (bitIndex := bitIndex + 1).
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   893
    maskBitIndex at: 2 put: (bitIndex := bitIndex + 1).
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   894
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   895
    1 to: 5 do:[:i| aBlock value: (primesUpTo2310 at: i)].
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   896
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   897
    index := 6.
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   898
    2 to: 2309 do:[:n|
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   899
	[(primesUpTo2310 at: index) < n]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   900
	    whileTrue:[index := index + 1].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   901
	n = (primesUpTo2310 at: index) ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   902
	    maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   903
	] ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   904
	    "if modulo any of the prime factors of 2310, then could not be prime"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   905
	    (n \\ 2 = 0 or:[n \\ 3 = 0 or:[n \\ 5 = 0 or:[n \\ 7 = 0 or:[n \\ 11 = 0]]]])
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   906
		    ifTrue:[maskBitIndex at: n+1 put: 0]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   907
		    ifFalse:[maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1)].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   908
	].
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   909
    ].
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   910
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   911
    "Now the real work begins...
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   912
    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
   913
    increment by 2 for odd numbers only."
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   914
    13 to: limit by: 2 do:[:n|
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   915
	(maskBit := maskBitIndex at: (n \\ 2310 + 1)) = 0 ifFalse:["not a multiple of 2,3,5,7,11"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   916
	    byteIndex := n // 2310 * 60 + (maskBit-1 bitShift: -3) + 1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   917
	    bitIndex := 1 bitShift: (maskBit bitAnd: 7).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   918
	    ((flags at: byteIndex) bitAnd: bitIndex) = 0 ifFalse:["not marked -- n is prime"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   919
		aBlock value: n.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   920
		"Start with n*n since any integer < n has already been sieved
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   921
		(e.g., any multiple of n with a number k < n has been cleared
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   922
		when k was sieved); add 2 * i to avoid even numbers and
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   923
		mark all multiples of this prime. Note: n < indexLimit below
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   924
		limits running into LargeInts -- nothing more."
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   925
		n < indexLimit ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   926
		    index := n * n.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   927
		    (index bitAnd: 1) = 0 ifTrue:[index := index + n].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   928
		    [index <= limit] whileTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   929
			(maskBit := maskBitIndex at: (index \\ 2310 + 1)) = 0 ifFalse:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   930
			    byteIndex := (index // 2310 * 60) + (maskBit-1 bitShift: -3) + 1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   931
			    maskBit := 255 - (1 bitShift: (maskBit bitAnd: 7)).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   932
			    flags at: byteIndex put: ((flags at: byteIndex) bitAnd: maskBit).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   933
			].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   934
			index := index + (2 * n)].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   935
		].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   936
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   937
	].
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   938
    ].
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
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   941
     Integer largePrimesUpTo:1000000 do:[:i | i > 900000 ifTrue:[self halt] ]
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   942
     (Integer primesUpTo:1000000) inspect
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   943
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   944
!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   945
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   946
primeCacheSize
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   947
    ^ PrimeCache size * 2
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   948
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   949
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   950
     Integer initializePrimeCacheUpTo:1000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   951
     Integer initializePrimeCacheUpTo:1000000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   952
     Integer initializePrimeCacheUpTo:1000000000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   953
     Integer flushPrimeCache.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   954
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   955
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   956
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   957
     Integer flushPrimeCache.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   958
     Transcript showCR:(
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   959
	Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   960
     ).
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   961
     Integer initializePrimeCacheUpTo:100000.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   962
     Transcript showCR:(
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   963
	Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   964
     ).
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   965
     Integer flushPrimeCache.
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   966
    "
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   967
!
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   968
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
   969
primesUpTo2000
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   970
    "/ primes up to 1000
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   971
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   972
    ^ #(
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   973
	    2 3   5   7  11  13  17  19  23  29  31  37  41  43  47  53  59  61  67  71
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   974
	     73  79  83  89  97 101 103 107 109 113 127 131 137 139 149 151 157 163 167
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   975
	    173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   976
	    277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   977
	    397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   978
	    509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   979
	    641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   980
	    761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   981
	    887 907 911 919 929 937 941 947 953 967 971 977 983 991 997
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   982
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   983
	    1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   984
	    1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   985
	    1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   986
	    1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   987
	    1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   988
	    1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   989
	    1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   990
	    1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   991
	    1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
   992
	).
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   993
!
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   994
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   995
primesUpTo: max
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
   996
    "Return a list of prime integers up to abd including the given integer."
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   997
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
   998
    ^ Array streamContents:[:s| self primesUpTo: max do:[:prime| s nextPut: prime]]
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
   999
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1000
    "
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1001
     Integer primesUpTo: 100
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1002
     Integer primesUpTo: 13
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1003
     (Integer primesUpTo: 100) select:[:p | p between:10 and:99]
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1004
    "
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1005
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1006
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1007
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1008
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1009
     N := 1000.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1010
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1011
     a := (1 to:1000)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1012
	 collect:[:i | p := p nextPrime. p ]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1013
	 thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1014
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1015
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1016
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1017
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1018
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1019
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1020
     N := 1000 nextPrime.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1021
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1022
     a := (1 to:1000)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1023
	 collect:[:i | p := p nextPrime. p ]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1024
	 thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1025
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1026
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1027
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1028
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1029
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1030
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1031
     N := 1000 nextPrime-1.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1032
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1033
     a := (1 to:1000)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1034
	 collect:[:i | p := p nextPrime. p ]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1035
	 thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1036
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1037
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1038
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1039
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1040
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1041
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1042
     N := 100000.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1043
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1044
     a := (1 to:N)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1045
	 collect:[:i | p := p nextPrime. p ]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1046
	 thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1047
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1048
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1049
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1050
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1051
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1052
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1053
     N := 100000 nextPrime.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1054
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1055
     a := (1 to:N)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1056
	 collect:[:i | p := p nextPrime. p ]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1057
	 thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1058
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1059
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1060
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1061
    "
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1062
     |p N a b|
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1063
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1064
     N := 100000 nextPrime-1.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1065
     p := 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1066
     a := (1 to:N)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1067
	 collect:[:i | p := p nextPrime. p ]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1068
	 thenSelect:[:p | p <= N].
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1069
     b := Integer primesUpTo:N.
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1070
     self assert:(a = b)
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1071
    "
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1072
!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1073
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1074
primesUpTo: max do: aBlock
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1075
    "Compute aBlock with all prime integers up to and including the given integer."
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1076
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1077
    | limit flags prime k |
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1078
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1079
    max <= 2000 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1080
	self primesUpTo2000 do:[:p |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1081
	    p > max ifTrue:[^ self].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1082
	    aBlock value:p.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1083
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1084
	^ self.
11521
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
  1085
    ].
1f5b947c7fc8 primeCache
Claus Gittinger <cg@exept.de>
parents: 11520
diff changeset
  1086
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  1087
    max <= self primeCacheSize ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1088
	aBlock value:2.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1089
	3 to:max by:2 do:[:p |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1090
	    (PrimeCache at:p//2) ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1091
		aBlock value:p
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1092
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1093
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1094
	^ self.
11520
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1095
    ].
79ae7618543f primeCache
Claus Gittinger <cg@exept.de>
parents: 11517
diff changeset
  1096
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1097
    limit := max asInteger - 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1098
    "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
  1099
    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
  1100
    limit > 25000 ifTrue:[^ self largePrimesUpTo: max do: aBlock].
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1101
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1102
    "/ sieve, on the fly
11495
833b96ce156d subtile bug in primesUpTo: - did not include the limit,
Claus Gittinger <cg@exept.de>
parents: 11494
diff changeset
  1103
    flags := (ByteArray new: limit) atAllPut: 1.
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1104
    1 to: limit do: [:i |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1105
	(flags at: i) == 1 ifTrue: [
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1106
	    prime := i + 1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1107
	    k := i + prime.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1108
	    [k <= limit] whileTrue: [
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1109
		flags at: k put: 0.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1110
		k := k + prime
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1111
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1112
	    aBlock value: prime
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1113
	]
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1114
    ].
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1115
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1116
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1117
     Integer primesUpTo: 100
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1118
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1119
! !
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1120
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1121
!Integer class methodsFor:'queries'!
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1122
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1123
hasSharedInstances
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1124
    "return true if this class has shared instances, that is, instances
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1125
     with the same value are identical.
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1126
     Although not always shared (LargeIntegers), these should be treated
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1127
     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
  1128
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1129
    ^ true
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1130
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1131
8892
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1132
!
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1133
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1134
isAbstract
11223
7536833995bb comment
Claus Gittinger <cg@exept.de>
parents: 11125
diff changeset
  1135
    "Return if this class is an abstract class.
7536833995bb comment
Claus Gittinger <cg@exept.de>
parents: 11125
diff changeset
  1136
     True is returned for Integer here; false for subclasses.
7536833995bb comment
Claus Gittinger <cg@exept.de>
parents: 11125
diff changeset
  1137
     Abstract subclasses must redefine again."
7536833995bb comment
Claus Gittinger <cg@exept.de>
parents: 11125
diff changeset
  1138
8892
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8635
diff changeset
  1139
    ^ self == Integer
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1140
! !
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  1141
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7173
diff changeset
  1142
!Integer methodsFor:'Compatibility-Dolphin'!
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1143
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1144
& aNumber
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1145
    "return the bitwise-and of the receiver and the argument, anInteger.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1146
     Same as bitAnd: - added for compatibility with Dolphin Smalltalk"
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1147
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1148
    ^ self bitAnd:aNumber
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1149
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1150
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1151
     14 | 1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1152
     9 & 8
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1153
    "
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1154
!
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1155
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1156
highWord
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1157
    "return the high 16 bits of a 32 bit value"
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1158
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1159
    ^ self bitShift:-16
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1160
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1161
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1162
     (16r12345678 highWord) hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1163
     (16r12345678 lowWord) hexPrintString
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1164
    "
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1165
!
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1166
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1167
lowWord
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1168
    "return the low 16 bits of a 32 bit value"
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1169
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1170
    ^ self bitAnd:16rFFFF
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1171
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1172
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1173
     (16r12345678 lowWord) hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1174
     (16r12345678 highWord) hexPrintString
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1175
    "
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1176
!
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1177
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1178
mask:integerMask set:aBoolean
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1179
    "Answer the result of setting/resetting the specified mask in the receiver."
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1180
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1181
    ^ aBoolean
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1182
	    ifTrue:  [self maskSet:integerMask]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1183
	    ifFalse: [self maskClear:integerMask]
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1184
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1185
    "turn on the 1-bit:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1186
	 |v|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1187
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1188
	 v := 2r0100.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1189
	 v mask:1 set:true
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1190
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1191
     turn off the 1-bit:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1192
	 |v|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1193
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1194
	 v := 2r0101.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1195
	 v mask:1 set:false
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1196
    "
6875
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1197
!
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1198
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1199
printStringRadix:aRadix padTo:sz
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1200
    "return a printed representation of the receiver in a given radix,
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1201
     padded with spaces (at the right) up to size.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1202
     If the printString is longer than size,
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1203
     it is returned unchanged (i.e. not truncated).
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1204
     See also printStringRadix:size:fill:"
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1205
6875
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1206
    ^ self printStringRadix:aRadix size:sz fill:$0
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1207
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1208
    "
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1209
     1024 printStringRadix:16 padTo:4
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1210
     16rABCD printStringRadix:16 padTo:3
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1211
     1024 printStringRadix:2 padTo:16
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1212
     1024 printStringRadix:16 padTo:8
6875
d064224376bf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6858
diff changeset
  1213
    "
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1214
!
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1215
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1216
| aNumber
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1217
    "return the bitwise-or of the receiver and the argument, anInteger.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1218
     Same as bitOr: - added for compatibility with Dolphin Smalltalk"
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1219
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1220
    ^ self bitOr:aNumber
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1221
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1222
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1223
     14 | 1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1224
     9 & 8
6907
a77451f0c14c dolphin compatibility
Claus Gittinger <cg@exept.de>
parents: 6875
diff changeset
  1225
    "
6249
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1226
! !
fa8cb1110cef dolphin
Claus Gittinger <cg@exept.de>
parents: 6195
diff changeset
  1227
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7173
diff changeset
  1228
!Integer methodsFor:'Compatibility-Squeak'!
4867
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1229
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1230
asByteArray
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1231
    "return my hexBytes in MSB"
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1232
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1233
    ^ self digitBytesMSB:true
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1234
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1235
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1236
asByteArrayOfSize:size
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1237
    "return my hexBytes in MSB, optionally padded at the left with zeros"
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1238
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1239
    "(((
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1240
        | repeats number | 
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1241
        repeats := 1000000.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1242
        number := 123456789123456789123456789123456789123456789123456789.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1243
         [repeats timesRepeat: (number asByteArrayOfSize: 1024) ] timeToRun.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1244
     )))"
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1245
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1246
    | bytes |
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1247
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1248
    size < self digitLength ifTrue: [^ self error: 'number too big for ', size asString].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1249
    bytes := self digitBytesMSB:true.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1250
    ^ (ByteArray new: (size - bytes size)), bytes
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1251
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1252
    "
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1253
     123 asByteArrayOfSize:1 #[123]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1254
     123 asByteArrayOfSize:2 #[0 123]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1255
     123 asByteArrayOfSize:4 #[0 0 0 123]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1256
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1257
     255 asByteArrayOfSize:1 #[255]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1258
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1259
     256 asByteArrayOfSize:1 
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1260
     256 asByteArrayOfSize:2
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1261
     256 asByteArrayOfSize:4
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1262
    "
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1263
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1264
4867
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1265
atRandom
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1266
    "return a random number between 1 amd myself"
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1267
8573
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1268
    ^ self atRandom:Random.
8572
3e649d2e3167 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8461
diff changeset
  1269
3e649d2e3167 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8461
diff changeset
  1270
    "
3e649d2e3167 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8461
diff changeset
  1271
     100 atRandom
3e649d2e3167 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8461
diff changeset
  1272
     1000 atRandom
3e649d2e3167 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8461
diff changeset
  1273
    "
4867
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1274
!
4376
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1275
8573
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1276
atRandom:aRandomGenerator
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1277
    "return a random number between 1 amd myself"
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1278
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1279
    self < 1 ifTrue:[^ self].
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1280
    ^ aRandomGenerator nextIntegerBetween:1 and:self
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1281
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1282
    "
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1283
     100 atRandom:(Random new)
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1284
     1000 atRandom:(Random new)
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1285
    "
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1286
!
240f0fa27d20 +atRandom:
Claus Gittinger <cg@exept.de>
parents: 8572
diff changeset
  1287
17728
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1288
printPaddedWith:padChar to:size base:base
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1289
    ^ (self printStringRadix:base) paddedTo:size with:padChar
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1290
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1291
    "
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1292
     1234 printPaddedWith:$0 to:4 base:16
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1293
    "
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1294
!
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  1295
4376
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1296
printStringBase:base
4867
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1297
    "return my printString in a base;
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1298
     same as printStringRadix:"
3bb80fe9bb8f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4830
diff changeset
  1299
4376
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1300
    ^ self printStringRadix:base
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1301
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1302
    "
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1303
     1234 printStringBase:16
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1304
    "
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1305
!
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1306
9125
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1307
printStringHex
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1308
    "return my printString in base 16;
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1309
     same as printStringRadix:"
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1310
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1311
    ^ self printStringRadix:16
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1312
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1313
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1314
     4096 printStringHex
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1315
    "
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1316
!
73e759072361 i pushed up;
Claus Gittinger <cg@exept.de>
parents: 9069
diff changeset
  1317
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1318
printStringRoman
9069
e5ba0dc84a53 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9068
diff changeset
  1319
    "return my roman printString;
e5ba0dc84a53 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9068
diff changeset
  1320
     almost the same as romanPrintString:"
e5ba0dc84a53 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9068
diff changeset
  1321
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1322
    "funny - although the romans did not have negative numbers - squeak has"
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1323
    self negative ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1324
	^ '-' , self negated romanPrintString
9068
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1325
    ].
ad6967cff1b4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9057
diff changeset
  1326
    ^ self romanPrintString
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1327
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1328
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1329
raisedTo:exp modulo:mod
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1330
    ^ self raisedTo:exp mod:mod
4376
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1331
! !
8df0935ac5b1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4278
diff changeset
  1332
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7173
diff changeset
  1333
!Integer methodsFor:'Compatibility-V''Age'!
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1334
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1335
<< aNumber
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  1336
    "V'Age compatibility: left shift"
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1337
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1338
    ^ self bitShift:aNumber
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1339
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1340
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1341
     1 << 5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1342
     64 << -5
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1343
    "
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1344
!
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1345
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1346
>> aNumber
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  1347
    "V'Age compatibility: right shift"
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1348
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1349
    ^ self bitShift:(aNumber negated)
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1350
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1351
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1352
     1 >> -5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1353
     64 >> 5
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1354
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1355
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1356
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1357
!Integer methodsFor:'bcd conversion'!
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1358
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1359
decodeFromBCD
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1360
    "return a number representing the value of the BCD encoded receiver."
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1361
4424
f0f658ed8995 bcd support
Claus Gittinger <cg@exept.de>
parents: 4423
diff changeset
  1362
    |v rslt multiplier nibble|
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1363
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1364
    v := self.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1365
    rslt := 0.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1366
    multiplier := 1.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1367
    [v > 0] whileTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1368
	nibble := v bitAnd:16r0F.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1369
	nibble > 9 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1370
	    ^ BCDConversionErrorSignal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1371
		    raiseRequestWith:self
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1372
		    errorString:'bad BCD coded value'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1373
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1374
	rslt := rslt + (nibble * multiplier).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1375
	multiplier := multiplier * 10.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1376
	v := v bitShift:-4.
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1377
    ].
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1378
    ^ rslt
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1379
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1380
    "
4949
4c0462bd4d6a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4921
diff changeset
  1381
     16r1234567890123 decodeFromBCD
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1382
     16r1073741823 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1383
     16r1073741824 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1384
     16r1073741825 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1385
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1386
     16r55 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1387
     16r127 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1388
     16r800000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1389
     16r8000000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1390
     16r80000000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1391
     16r800000000 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1392
     16r127567890 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1393
     16r1234567890 decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1394
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1395
     16r5A decodeFromBCD
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1396
     16rFF decodeFromBCD
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1397
    "
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1398
4996
c3716cebe47b added a bcdConversionErrorSignal
Claus Gittinger <cg@exept.de>
parents: 4973
diff changeset
  1399
    "Modified: / 15.11.1999 / 20:37:20 / cg"
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1400
!
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1401
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1402
encodeAsBCD
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1403
    "return a BCD encoded number representing the same value as the
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1404
     receiver."
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1405
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1406
    |v rslt shift|
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1407
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1408
    v := self.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1409
    rslt := shift := 0.
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1410
    [v > 0] whileTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1411
	rslt := rslt + ((v \\ 10) bitShift:shift).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1412
	shift := shift + 4.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1413
	v := v // 10.
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1414
    ].
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1415
    ^ rslt
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1416
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1417
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1418
     55 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1419
     127 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1420
     127 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1421
     8912345 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1422
     89123456 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1423
     891234567 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1424
     900000000 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1425
     1073741823 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1426
     1073741824 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1427
     1073741825 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1428
     1891234567 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1429
     8912345678 encodeAsBCD hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1430
     1234567890 encodeAsBCD hexPrintString
4423
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1431
    "
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1432
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1433
! !
2a478882f765 bcd support
Claus Gittinger <cg@exept.de>
parents: 4376
diff changeset
  1434
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1435
!Integer methodsFor:'bit operators'!
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1436
4643
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1437
allMask:anInteger
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1438
    "return true if all 1-bits in anInteger are also 1 in the receiver"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1439
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1440
    ^ (self bitAnd:anInteger) == anInteger
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1441
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1442
    "2r00001111 allMask:2r00000001"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1443
    "2r00001111 allMask:2r00011110"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1444
    "2r00001111 allMask:2r00000000"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1445
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1446
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1447
anyMask:anInteger
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1448
    "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
  1449
     (somewhat incorrect, if the mask is zero)"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1450
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1451
    ^ (self bitAnd:anInteger) ~~ 0
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1452
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1453
    "2r00001111 anyMask:2r00000001"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1454
    "2r00001111 anyMask:2r11110000"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1455
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  1456
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1457
bitAnd:anInteger
357
claus
parents: 356
diff changeset
  1458
    "return the bitwise-and of the receiver and the argument, anInteger.
claus
parents: 356
diff changeset
  1459
     This is a general and slow implementation, walking over the bytes of
claus
parents: 356
diff changeset
  1460
     the receiver and the argument."
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1461
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1462
    |n "{ Class: SmallInteger }"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1463
     result byte|
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1464
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1465
    anInteger isInteger ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1466
	^ anInteger bitAndFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1467
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1468
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1469
    n := (anInteger digitLength) min:(self digitLength).
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1470
    result := self class basicNew numberOfDigits:n.
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1471
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1472
    1 to:n do:[:index |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1473
	byte := (anInteger digitAt:index) bitAnd:(self digitAt:index).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1474
	result digitAt:index put:byte.
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1475
    ].
3162
c7c8af356ff2 dont hardcode the numberof bytes (use maxBytes for alpha);
Claus Gittinger <cg@exept.de>
parents: 3138
diff changeset
  1476
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1477
	^ result compressed
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1478
    ].
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1479
    ^ result
357
claus
parents: 356
diff changeset
  1480
claus
parents: 356
diff changeset
  1481
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1482
     (16r112233445566778899 bitAnd:16rFF                ) printStringRadix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1483
     (16r112233445566778899 bitAnd:16rFFFFFFFFFFFFFFFF00) printStringRadix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1484
     (16r112233445566778899 bitAnd:16rFF0000000000000000) printStringRadix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1485
     (16r112233445566778899 bitAnd:16r00000000000000FFFF) printStringRadix:16
357
claus
parents: 356
diff changeset
  1486
    "
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  1487
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  1488
    "Modified: 5.11.1996 / 14:06:26 / cg"
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1489
!
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  1490
85
claus
parents: 77
diff changeset
  1491
bitAt:index
11499
fa02ab9a83f0 comment
Claus Gittinger <cg@exept.de>
parents: 11496
diff changeset
  1492
    "return the value of the index's bit (index starts at 1) as 0 or 1.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1493
     Notice: the result of bitAt: on negative receivers is not
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1494
	     defined in the language standard (since the implementation
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1495
	     is free to choose any internal representation for integers)"
85
claus
parents: 77
diff changeset
  1496
claus
parents: 77
diff changeset
  1497
    |i "{Class: SmallInteger}"|
claus
parents: 77
diff changeset
  1498
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  1499
    i := index - 1.
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  1500
    i < 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1501
	^ SubscriptOutOfBoundsSignal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1502
		raiseRequestWith:index
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1503
		errorString:'index out of bounds'
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  1504
    ].
85
claus
parents: 77
diff changeset
  1505
    ^ (self digitAt:(i // 8 + 1)) bitAt:(i \\ 8 + 1)
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1506
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1507
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1508
     1 bitAt:1                     => 1
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1509
     1 bitAt:2                     => 0
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1510
     1 bitAt:0                     index error
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1511
     2r1000100010001000100010001000100010001000100010001000 bitAt:48 => 1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1512
     2r1000100010001000100010001000100010001000100010001000 bitAt:47 => 0
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1513
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1514
     (1 bitShift:1000) bitAt:1000  => 0
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1515
     (1 bitShift:1000) bitAt:1001  => 1
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1516
     (1 bitShift:1000) bitAt:1002  => 0
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1517
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1518
     (1 bitShift:30) bitAt:30
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1519
     (1 bitShift:30) bitAt:31
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1520
     (1 bitShift:30) bitAt:32
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1521
     (1 bitShift:31) bitAt:31
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1522
     (1 bitShift:31) bitAt:32
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1523
     (1 bitShift:31) bitAt:33
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1524
     (1 bitShift:32) bitAt:32
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1525
     (1 bitShift:32) bitAt:33
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1526
     (1 bitShift:32) bitAt:34
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1527
     (1 bitShift:64) bitAt:64
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1528
     (1 bitShift:64) bitAt:65
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1529
     (1 bitShift:64) bitAt:66
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1530
    "
85
claus
parents: 77
diff changeset
  1531
!
claus
parents: 77
diff changeset
  1532
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  1533
bitClear:anInteger
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1534
    "return the bitwise-and of the receiver and the complement of argument, anInteger.
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1535
     This is a general and slow implementation, walking over the bytes of
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1536
     the receiver and the argument."
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1537
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1538
    |n "{ Class: SmallInteger }"
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1539
     result byte|
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  1540
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1541
    n := (anInteger digitLength) max:(self digitLength).
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1542
    result := self class basicNew numberOfDigits:n.
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1543
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1544
    1 to:n do:[:index |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1545
	byte :=  (self digitAt:index) bitClear:(anInteger digitAt:index).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1546
	result digitAt:index put:byte.
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1547
    ].
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1548
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1549
	^ result compressed
3884
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1550
    ].
ddda4144e331 fixed bitClear
ca
parents: 3874
diff changeset
  1551
    ^ result
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  1552
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  1553
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1554
bitCount
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1555
    "return the number of 1-bits in the receiver"
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1556
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1557
    |n "{ Class: SmallInteger }"
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1558
     cnt byte|
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1559
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1560
    n := self digitLength.
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1561
    cnt := 0.
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1562
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1563
    1 to:n do:[:index |
17910
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  1564
        byte := self digitAt:index.
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  1565
        cnt := cnt + (byte bitCount)
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1566
    ].
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1567
    ^ cnt
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1568
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1569
     "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1570
      2r100000000000000000000000000000000000000000000000000000000001 bitCount
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1571
      2r111111111111111111111111111111111111111111111111111111111111111111 bitCount
17910
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  1572
      100 factorial bitCount -> 207
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  1573
      1000 factorial bitCount -> 3788
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1574
     "
17910
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  1575
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  1576
    "Modified (comment): / 09-01-2012 / 19:51:00 / cg"
11492
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1577
!
4532fa5c3224 +bitCount
Claus Gittinger <cg@exept.de>
parents: 11491
diff changeset
  1578
11504
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1579
bitIndicesOfOneBitsDo:aBlock
11505
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1580
    "evaluate aBlock for all indices of a 1-bit, starting with the index of the lowest bit.
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1581
     The index for the least significant bit is 1."
11504
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1582
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1583
    1 to:self digitLength do:[:i8 |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1584
	|byte|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1585
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1586
	byte := self digitAt:i8.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1587
	byte ~~ 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1588
	    1 to:8 do:[:i |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1589
		(byte bitAt:i) == 1 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1590
		    aBlock value:(((i8-1)*8) + i).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1591
		].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1592
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1593
	]
11504
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1594
    ].
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1595
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1596
    "
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1597
     1 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i].
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1598
     2 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1599
     4 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1600
     12 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1601
     127 bitIndicesOfOneBitsDo:[:i | Transcript showCR:i]
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1602
    "
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1603
!
70b4d447e172 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11499
diff changeset
  1604
11505
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1605
bitIndicesOfOneBitsReverseDo:aBlock
17841
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1606
    "evaluate aBlock for all indices of a 1-bit, starting with the index of the highest
11505
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1607
     and ending with the lowest bit.
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1608
     The index for the least significant bit is 1."
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1609
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1610
    self digitLength downTo:1 do:[:i8 |
17841
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1611
        |byte|
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1612
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1613
        byte := self digitAt:i8.
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1614
        byte ~~ 0 ifTrue:[
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1615
            8 downTo:1 do:[:i |
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1616
                (byte bitAt:i) == 1 ifTrue:[
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1617
                    aBlock value:(((i8-1)*8) + i).
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1618
                ].
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1619
            ].
7abcc4aef871 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17834
diff changeset
  1620
        ]
11505
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1621
    ].
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1622
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1623
    "
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1624
     1 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i].
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1625
     2 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1626
     4 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1627
     12 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1628
     127 bitIndicesOfOneBitsReverseDo:[:i | Transcript showCR:i]
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1629
    "
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1630
!
8fab7b8377fe *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11504
diff changeset
  1631
3455
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1632
bitInvert
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1633
    "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
  1634
     This does not really make sense for negative largeIntegers,
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1635
     since the digits are stored as absolute value.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1636
     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
  1637
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1638
"/    ^ -1 - self
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1639
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1640
    |n "{ Class: SmallInteger }"
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1641
     result byte|
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1642
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1643
    n := self digitLength.
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1644
    result := self class basicNew numberOfDigits:n.
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1645
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1646
    1 to:n do:[:index |
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1647
        byte := self digitAt:index.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1648
        result digitAt:index put:(byte bitInvert bitAnd:16rFF).
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1649
    ].
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1650
    (byte == 255 or:[n <= SmallInteger maxBytes]) ifTrue:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  1651
        ^ result compressed
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1652
    ].
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1653
    ^ result
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1654
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1655
     "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1656
      16rffffffff bitInvert
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1657
      16rff00ff00 bitInvert hexPrintString
4614
14d5ce4bf117 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4611
diff changeset
  1658
     "
3455
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1659
!
2b19e1e70adc added bitInvert for LargeIntegers (positive only)
Claus Gittinger <cg@exept.de>
parents: 3395
diff changeset
  1660
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1661
bitOr:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1662
    "return the bitwise-or of the receiver and the argument, anInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1663
     This is a general and slow implementation, walking over the bytes of
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1664
     the receiver and the argument."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1665
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1666
    |n "{ Class: SmallInteger }"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1667
     result byte|
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1668
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1669
    anInteger isInteger ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1670
	^ anInteger bitOrFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1671
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1672
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1673
    n := (anInteger digitLength) max:(self digitLength).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1674
    result := self class basicNew numberOfDigits:n.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1675
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1676
    1 to:n do:[:index |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1677
	byte := (anInteger digitAt:index) bitOr:(self digitAt:index).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1678
	result digitAt:index put:byte.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1679
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1680
"/ no need to normalize - if the operands were correct
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1681
"/    byte == 0 ifTrue:[
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1682
"/        ^ result normalize
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1683
"/    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1684
    ^ result
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1685
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1686
85
claus
parents: 77
diff changeset
  1687
bitShift:shiftCount
claus
parents: 77
diff changeset
  1688
    "return the value of the receiver shifted by shiftCount bits;
claus
parents: 77
diff changeset
  1689
     leftShift if shiftCount > 0; rightShift otherwise.
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1690
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1691
     Notice: the result of bitShift: on negative receivers is not
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1692
	     defined in the language standard (since the implementation
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1693
	     is free to choose any internal representation for integers)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1694
	     However, ST/X preserves the sign."
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1695
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1696
    |result
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1697
     prev       "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1698
     next       "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1699
     byte       "{ Class: SmallInteger }"
359
claus
parents: 357
diff changeset
  1700
     byte2      "{ Class: SmallInteger }"
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1701
     bitShift   "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1702
     revShift   "{ Class: SmallInteger }"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1703
     digitShift "{ Class: SmallInteger }"
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1704
     n          "{ Class: SmallInteger }"
3044
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
  1705
     nn         "{ Class: SmallInteger }"
a0bbac91639b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3036
diff changeset
  1706
     nDigits    "{ Class: SmallInteger }" |
85
claus
parents: 77
diff changeset
  1707
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1708
    shiftCount isInteger ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1709
	^ shiftCount bitShiftFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1710
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1711
85
claus
parents: 77
diff changeset
  1712
    shiftCount > 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1713
	"left shift"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1714
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1715
	digitShift := shiftCount // 8.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1716
	bitShift := shiftCount \\ 8.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1717
	n := self digitLength.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1718
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1719
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1720
	 modulo 8 shifts can be done faster ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1721
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1722
	bitShift == 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1723
	    n := n + digitShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1724
	    result := self class basicNew numberOfDigits:n.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1725
	    result sign:self sign.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1726
	    result digitBytes replaceFrom:(digitShift + 1) to:n with:self digitBytes.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1727
	    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1728
	     no normalize needed, since receiver was already normalized
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1729
	    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1730
	    ^ result
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1731
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1732
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1733
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1734
	 less-than-8 shifts can be done faster ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1735
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1736
	digitShift == 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1737
	    nn := n+1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1738
	    result := self class basicNew numberOfDigits:nn.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1739
	    result sign:self sign.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1740
	    prev := 0.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1741
	    1 to:n do:[:index |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1742
		byte := self digitAt:index.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1743
		byte := (byte bitShift:bitShift) bitOr:prev.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1744
		result digitAt:index put:(byte bitAnd:16rFF).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1745
		prev := byte bitShift:-8.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1746
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1747
	    result digitAt:nn put:prev.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1748
	    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1749
	     might have stored a 0-byte ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1750
	    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1751
	    prev == 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1752
		^ result compressed
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1753
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1754
	    ^ result.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1755
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1756
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1757
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1758
	 slow case ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1759
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1760
	n := n + digitShift + 1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1761
	result := self class basicNew numberOfDigits:n.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1762
	result sign:self sign.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1763
	byte := self digitAt:1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1764
	byte := (byte bitShift:bitShift) bitAnd:16rFF.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1765
	result digitAt:(digitShift + 1) put:byte.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1766
	revShift := -8 + bitShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1767
	nDigits := self digitLength.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1768
	2 to:nDigits do:[:index |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1769
	    byte := self digitAt:index.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1770
	    byte2 := self digitAt:index-1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1771
	    byte := byte bitShift:bitShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1772
	    byte2 := byte2 bitShift:revShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1773
	    byte := (byte bitOr:byte2) bitAnd:16rFF.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1774
	    result digitAt:(index + digitShift) put:byte.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1775
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1776
	byte2 := self digitAt:nDigits.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1777
	byte2 := (byte2 bitShift:revShift) bitAnd:16rFF.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1778
	result digitAt:(nDigits + digitShift + 1) put:byte2.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1779
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1780
	 might have stored a 0-byte ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1781
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1782
	byte2 == 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1783
	    ^ result compressed
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1784
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1785
	^ result
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1786
    ].
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1787
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1788
    shiftCount < 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1789
	"right shift"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1790
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1791
	digitShift := shiftCount negated // 8.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1792
	bitShift := shiftCount negated \\ 8.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1793
	n := self digitLength.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1794
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1795
	digitShift >= n ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1796
	    ^ 0
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1797
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1798
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1799
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1800
	 modulo 8 shifts can be done faster ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1801
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1802
	bitShift == 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1803
	    n := n-digitShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1804
	    result := self class basicNew numberOfDigits:n.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1805
	    result sign:self sign.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1806
	    result digitBytes replaceFrom:1 to:n with:self digitBytes startingAt:(digitShift + 1) .
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1807
	    n <= SmallInteger maxBytes ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1808
		^ result compressed
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1809
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1810
	    ^ result
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1811
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1812
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1813
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1814
	 less-than-8 shifts can be done faster ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1815
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1816
	digitShift == 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1817
	    result := self class basicNew numberOfDigits:n.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1818
	    result sign:self sign.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1819
	    prev := 0.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1820
	    bitShift := bitShift negated.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1821
	    revShift := 8 + bitShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1822
	    n to:1 by:-1 do:[:index |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1823
		byte := self digitAt:index.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1824
		next := (byte bitShift:revShift) bitAnd:16rFF.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1825
		byte := (byte bitShift:bitShift) bitOr:prev.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1826
		result digitAt:index put:(byte bitAnd:16rFF).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1827
		prev := next.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1828
	    ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1829
	    ^ result compressed
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1830
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1831
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1832
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1833
	 slow case ...
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1834
	"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1835
	nn := n-digitShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1836
	result := self class basicNew numberOfDigits:nn.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1837
	result sign:self sign.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1838
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1839
	prev := 0.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1840
	bitShift := bitShift negated.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1841
	revShift := 8 + bitShift.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1842
	nn := digitShift + 1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1843
	n to:nn by:-1 do:[:index |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1844
	    byte := self digitAt:index.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1845
	    next := (byte bitShift:revShift) bitAnd:16rFF.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1846
	    byte := (byte bitShift:bitShift) bitOr:prev.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1847
	    result digitAt:(index - digitShift) put:byte.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1848
	    prev := next.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1849
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1850
	"the last stored byte ..."
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1851
	^ result compressed
85
claus
parents: 77
diff changeset
  1852
    ].
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1853
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1854
    ^ self "no shift"
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  1855
3638
edf314b220d2 fixed #bitShift: (right)
Claus Gittinger <cg@exept.de>
parents: 3455
diff changeset
  1856
    "Modified: / 8.7.1998 / 12:45:24 / cg"
4151
6d6971c27567 Some speedups.
Stefan Vogel <sv@exept.de>
parents: 4142
diff changeset
  1857
    "Modified: / 5.5.1999 / 16:05:05 / stefan"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1858
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1859
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1860
bitTest:anInteger
5782
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1861
    "return true, if any bit from aMask is set in the receiver.
dcc037e5bdbf comment change
Claus Gittinger <cg@exept.de>
parents: 5496
diff changeset
  1862
     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
  1863
     is non-0, false otherwise.
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1864
     This is a general and slow implementation, walking over the bytes of
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1865
     the receiver and the argument."
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1866
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1867
    |n "{ Class: SmallInteger }"
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1868
     byte|
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1869
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1870
    n := (anInteger digitLength) min:(self digitLength).
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1871
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1872
    1 to:n do:[:index |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1873
	byte := (anInteger digitAt:index) bitAnd:(self digitAt:index).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1874
	byte ~~ 0 ifTrue:[^ true].
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1875
    ].
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1876
    ^ false
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1877
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1878
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1879
     16r112233445566778899 bitTest:16rFF
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1880
     16r112233445566778800 bitTest:16rFF
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1881
     16r112233445566778899 bitTest:16rFFFFFFFFFFFFFFFF00
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1882
     16r112233445566778899 bitTest:16rFF0000000000000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1883
     16r112233445566778899 bitTest:16r00000000000000FFFF
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1884
     16r1234567800000000 bitTest:16r8000000000000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1885
     16r8765432100000000 bitTest:16r8000000000000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1886
     16r12345678 bitTest:16r80000000
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1887
     16r87654321 bitTest:16r80000000
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1888
    "
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1889
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  1890
    "Modified: / 6.6.1999 / 15:10:33 / cg"
1407
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1891
!
6c278dcd5570 added #bitTest: for general integers
Claus Gittinger <cg@exept.de>
parents: 1337
diff changeset
  1892
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1893
bitXor:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1894
    "return the bitwise-or of the receiver and the argument, anInteger.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1895
     This is a general and slow implementation, walking over the bytes of
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1896
     the receiver and the argument."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1897
927
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1898
    |n "{ Class: SmallInteger }"
8d8edf9df0ae fixed \\ vs. rem: and // vs. quo: stupidities;
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1899
     result byte|
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1900
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1901
    anInteger isInteger ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1902
	^ anInteger bitXorFromInteger:self.
6358
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1903
    ].
706234560a0b allow double dispatch for bit* operations
Claus Gittinger <cg@exept.de>
parents: 6249
diff changeset
  1904
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1905
    n := (anInteger digitLength) max:(self digitLength).
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1906
    result := self class basicNew numberOfDigits:n.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1907
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1908
    1 to:n do:[:index |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1909
	byte := (anInteger digitAt:index) bitXor:(self digitAt:index).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1910
	result digitAt:index put:byte.
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1911
    ].
3993
a5a09b2d36cd oops - bitXor: did not always compress the result.
Claus Gittinger <cg@exept.de>
parents: 3908
diff changeset
  1912
    (byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1913
	^ result compressed
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1914
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1915
    ^ result
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1916
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1917
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1918
     (16r112233445566778899 bitXor:16rFF                ) printStringRadix:16 '112233445566778866'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1919
     (16r112233445566778899 bitXor:16rFFFFFFFFFFFFFFFF00) printStringRadix:16 'EEDDCCBBAA99887799'
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1920
     (16r112233445566778899 bitXor:16rFF0000000000000000) printStringRadix:16 'EE2233445566778899'
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1921
     (16r112233445566778899 bitXor:16r112233445566778800) printStringRadix:16
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1922
    "
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  1923
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  1924
    "Modified: 5.11.1996 / 14:06:40 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1925
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1926
5210
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1927
changeBit:index to:aBooleanOrNumber
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1928
    "return a new number where the specified bit is on or off,
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1929
     depending on aBooleanOrNumber.
5210
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1930
     Bits are counted from 1 starting with the least significant.
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1931
     The methods name may be missleading: the receiver is not changed,
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1932
     but a new number is returned. Should be named #withBit:changedTo:"
5210
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1933
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1934
    (aBooleanOrNumber == 0 or:[aBooleanOrNumber == false]) ifTrue:[
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1935
        ^ self clearBit:index
5210
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1936
    ].
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1937
    ^ self setBit:index
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1938
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1939
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1940
     (16r3fffffff changeBit:31 to:1) hexPrintString
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1941
     (16r3fffffff asLargeInteger setBit:31) hexPrintString
5210
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1942
    "
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1943
!
f56e448396f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5209
diff changeset
  1944
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1945
changeMask:mask to:aBooleanOrNumber
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1946
    "return a new number where the specified mask-bit is on or off,
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1947
     depending on aBooleanOrNumber.
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1948
     The methods name may be missleading: the receiver is not changed,
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1949
     but a new number is returned. Should be named #withMask:changedTo:"
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1950
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1951
    (aBooleanOrNumber == 0 or:[aBooleanOrNumber == false]) ifTrue:[
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1952
        ^ self bitClear:mask
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1953
    ].
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1954
    ^ self bitOr:mask
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1955
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1956
    "
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1957
     (16r3fffffff changeMask:16r80 to:0) hexPrintString 
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1958
     (16r3fff0000 changeMask:16r80 to:1) hexPrintString
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1959
    "
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1960
!
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  1961
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1962
clearBit:index
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  1963
    "return a new integer where the specified bit is off.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  1964
     Bits are counted from 1 starting with the least significant.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  1965
     The methods name may be missleading: the receiver is not changed,
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  1966
     but a new number is returned. Should be named #withBitCleared:"
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1967
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1968
    |n         "{ Class: SmallInteger }"
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1969
     byteIndex "{ Class: SmallInteger }"
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  1970
     bitIndex  "{ Class: SmallInteger }"
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1971
     result byte|
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1972
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  1973
    index <= 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1974
	^ SubscriptOutOfBoundsSignal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1975
		raiseRequestWith:index
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1976
		errorString:'bit index out of bounds'
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  1977
    ].
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1978
    byteIndex := ((index - 1) // 8) + 1.
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1979
    n := self digitLength.
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1980
    byteIndex > n ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1981
	^ self
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1982
    ].
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1983
9057
13bd29f579c6 Bug 343: #clearBit: changed the receiver (shouldn't do that).
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1984
    result := self simpleDeepCopy.
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1985
    bitIndex := ((index - 1) \\ 8) + 1.
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1986
    byte := (result digitAt:byteIndex) clearBit:bitIndex.
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1987
    result digitAt:byteIndex put:byte.
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1988
    (byte == 0 or:[n == byteIndex and:[n <= SmallInteger maxBytes]]) ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  1989
	^ result compressed
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1990
    ].
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1991
    ^ result
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1992
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1993
    "
9057
13bd29f579c6 Bug 343: #clearBit: changed the receiver (shouldn't do that).
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  1994
     3111111111 clearBit:1
3683
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1995
    "
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1996
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1997
    "Modified: / 28.7.1998 / 18:35:50 / cg"
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1998
!
2eac599d04c1 fixed clearBit:
Claus Gittinger <cg@exept.de>
parents: 3639
diff changeset
  1999
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2000
even
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2001
    "return true if the receiver is even"
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2002
9401
65f884297c68 speed up #even and #odd
Stefan Vogel <sv@exept.de>
parents: 9316
diff changeset
  2003
    ^ (self bitAt:1) == 0
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2004
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2005
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2006
     16r112233445566778899 even
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2007
     16r112233445566778800 even
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2008
     1 even
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2009
     2 even
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2010
    "
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2011
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2012
    "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
  2013
!
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2014
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2015
highBit
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2016
    "return the bitIndex of the highest bit set. The returned bitIndex
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2017
     starts at 1 for the least significant bit.
6481
d5c94e93067c highBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6480
diff changeset
  2018
     Returns 0 if no bit is set."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2019
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2020
    |byteNr highByte|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2021
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2022
    byteNr := self digitLength.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2023
    byteNr == 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2024
	^ 0
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2025
    ].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2026
    highByte := self digitAt:byteNr.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2027
    ^ (byteNr - 1) * 8 + highByte highBit
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2028
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2029
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2030
     0 highBit
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2031
     -1 highBit
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2032
     (1 bitShift:1) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2033
     (1 bitShift:30) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2034
     (1 bitShift:31) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2035
     (1 bitShift:32) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2036
     (1 bitShift:33) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2037
     (1 bitShift:64) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2038
     (1 bitShift:1000) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2039
     (1 bitShift:1000) negated highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2040
     ((1 bitShift:64)-1) highBit
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2041
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2042
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2043
    "Modified: / 3.5.1999 / 09:20:57 / stefan"
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2044
!
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2045
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2046
invertBit:index
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2047
    "return a new number where the specified bit is inverted.
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2048
     Bits are counted from 1 starting with the least significant.
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2049
     The methods name may be missleading: the receiver is not changed,
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2050
     but a new number is returned. Should be named #withBitInverted:"
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2051
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2052
    index <= 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2053
	^ SubscriptOutOfBoundsSignal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2054
		raiseRequestWith:index
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2055
		errorString:'index out of bounds'
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2056
    ].
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2057
    ^ self bitXor:(1 bitShift:index-1)
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2058
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2059
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2060
     0 invertBit:3         => 4 (2r100)
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2061
     0 invertBit:48        => 140737488355328 (2r1000.....000)
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2062
     ((0 invertBit:99) invertBit:100) printStringRadix:2
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2063
    "
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2064
!
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2065
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2066
isBitSet:index
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2067
    "return true if the index' bit is set; false otherwise.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2068
     Bits are counted from 1 starting with the least significant."
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2069
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2070
    ^ (self bitAt:index) ~~ 0
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2071
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2072
    "
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2073
     5 isBitSet:3       => true
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2074
     2r0101 isBitSet:2  => false
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2075
     2r0101 isBitSet:1  => true
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2076
     2r0101 isBitSet:0  index error
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2077
    "
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2078
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2079
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2080
lowBit
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2081
    "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
  2082
     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
  2083
     Returns 0 if no bit is set."
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2084
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2085
    |maxBytes "{ Class: SmallInteger }"
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2086
     byte|
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2087
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2088
    maxBytes := self digitLength.
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2089
    1 to:maxBytes do:[:byteIndex |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2090
	byte := self digitAt:byteIndex.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2091
	byte ~~ 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2092
	    ^ (byteIndex-1)*8 + (byte lowBit)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2093
	].
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2094
    ].
6480
4ff7f2af25fc lowBit now returns 0 if no bit is set.
Claus Gittinger <cg@exept.de>
parents: 6358
diff changeset
  2095
    ^ 0 "/ should not happen
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2096
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2097
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2098
     0 lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2099
     1 lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2100
     (1 bitShift:1) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2101
     (1 bitShift:1) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2102
     (1 bitShift:30) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2103
     (1 bitShift:30) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2104
     (1 bitShift:31) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2105
     (1 bitShift:31) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2106
     (1 bitShift:32) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2107
     (1 bitShift:32) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2108
     (1 bitShift:33) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2109
     (1 bitShift:33) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2110
     (1 bitShift:64) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2111
     (1 bitShift:64) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2112
     (1 bitShift:1000) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2113
     (1 bitShift:1000) highBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2114
     ((1 bitShift:64)-1) lowBit
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2115
     ((1 bitShift:64)-1) highBit
2429
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2116
    "
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2117
1aeeadaa162e added #lowBit
Claus Gittinger <cg@exept.de>
parents: 2428
diff changeset
  2118
    "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
  2119
!
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2120
4643
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2121
maskClear:aMask
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2122
    ^ self bitAnd:aMask bitInvert
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2123
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2124
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2125
maskSet:aMask
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2126
    ^ self bitOr:aMask
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2127
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2128
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2129
noMask:anInteger
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2130
    "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
  2131
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2132
    ^ (self bitAnd:anInteger) == 0
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2133
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2134
    "2r00001111 noMask:2r00000001"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2135
    "2r00001111 noMask:2r11110000"
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2136
!
48ee5b949c81 moved anyMask, allMask ... from SmallInteger.
Claus Gittinger <cg@exept.de>
parents: 4614
diff changeset
  2137
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2138
odd
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2139
    "return true if the receiver is odd"
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2140
9401
65f884297c68 speed up #even and #odd
Stefan Vogel <sv@exept.de>
parents: 9316
diff changeset
  2141
    ^ (self bitAt:1) == 1
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2142
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2143
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2144
     16r112233445566778899 odd
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2145
     16r112233445566778800 odd
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2146
     1 odd
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2147
     2 odd
4278
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2148
    "
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2149
78c34fcd9952 added #odd and #even for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 4169
diff changeset
  2150
    "Created: / 6.6.1999 / 15:00:55 / cg"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2151
!
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2152
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2153
rightShift:shiftCount
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2154
    "return the value of the receiver shifted right by shiftCount bits;
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2155
     rightShift if shiftCount > 0; leftShift otherwise.
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2156
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2157
     Notice: the result of bitShift: on negative receivers is not
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2158
	     defined in the language standard (since the implementation
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2159
	     is free to choose any internal representation for integers)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2160
	     However, ST/X preserves the sign."
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2161
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2162
    ^ self bitShift:(shiftCount negated)
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2163
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2164
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2165
     16r100000000 rightShift:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2166
     16r100000000 negated rightShift:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2167
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2168
     16r100000000 rightShift:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2169
     16r100000000 negated rightShift:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2170
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2171
     16r100000000 rightShift:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2172
     16r100000000 negated rightShift:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2173
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2174
     ((16r100000000 rightShift:1) rightShift:1) rightShift:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2175
     ((16r100000000 negated rightShift:1) rightShift:1) rightShift:1
7155
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2176
    "
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2177
!
8112e11f850a +rightShift:
Claus Gittinger <cg@exept.de>
parents: 7093
diff changeset
  2178
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2179
setBit:index
8937
4f2508548327 comment
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2180
    "return a new integer, where the specified bit is on.
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2181
     Bits are counted from 1 starting with the least significant.
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2182
     The methods name may be missleading: the receiver is not changed,
11499
fa02ab9a83f0 comment
Claus Gittinger <cg@exept.de>
parents: 11496
diff changeset
  2183
     but a new number is returned. Should be named #withBitSet:"
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2184
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2185
    index <= 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2186
	^ SubscriptOutOfBoundsSignal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2187
		raiseRequestWith:index
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2188
		errorString:'index out of bounds'
5496
338c81a04468 index bounds in bit operations;
Claus Gittinger <cg@exept.de>
parents: 5469
diff changeset
  2189
    ].
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2190
    ^ self bitOr:(1 bitShift:index-1)
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2191
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2192
    "
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2193
     0 setBit:3         => 4 (2r100)
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2194
     0 setBit:48        => 140737488355328 (2r1000.....000)
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2195
     ((0 setBit:99) setBit:100) printStringRadix:2
5209
3a52e2f97ec4 setBit/clearBit.
Claus Gittinger <cg@exept.de>
parents: 5186
diff changeset
  2196
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2197
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2198
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2199
!Integer methodsFor:'byte access'!
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2200
17756
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2201
byteAt:anIndex
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2202
    "compatibility with ByteArrays etc."
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2203
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2204
    ^ self digitAt:anIndex
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2205
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2206
    "
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2207
        12345678 byteAt:2
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2208
        12345678 digitBytes at:2
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2209
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2210
        -12345678 byteAt:2
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2211
        -12345678 digitBytes at:2
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2212
    "
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2213
!
f4d72b8d0d89 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17747
diff changeset
  2214
17921
4069fe8e9039 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17911
diff changeset
  2215
byteSwapped
4069fe8e9039 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17911
diff changeset
  2216
    ^ LargeInteger 
4069fe8e9039 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17911
diff changeset
  2217
        digitBytes:(self digitBytes) MSB:true
4069fe8e9039 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17911
diff changeset
  2218
4069fe8e9039 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17911
diff changeset
  2219
    "Created: / 31-01-2012 / 12:17:57 / cg"
4069fe8e9039 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17911
diff changeset
  2220
!
4069fe8e9039 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17911
diff changeset
  2221
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2222
digitByteLength
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2223
    "return the number bytes required for a 2's complement
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2224
     binary representation of this Integer.
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2225
     For positive receivers, thats the same as the digitLength."
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2226
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2227
    "
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2228
     check if there is a 0-byte ...
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2229
     this allows to ask unnormalized LargeIntegers
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2230
     for their digitLength
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2231
    "
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2232
    |l "{ Class: SmallInteger }" |
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2233
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2234
    self >= 0 ifTrue:[^ self digitLength].
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2235
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2236
    l := self negated digitLength.
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2237
    (self digitByteAt:l) == 16rFF ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2238
	^ (l - 1) max:1
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2239
    ].
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2240
    ^ l
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2241
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2242
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2243
     -129 digitByteLength
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2244
    "
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2245
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2246
    "Created: / 25.10.1998 / 14:58:09 / cg"
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2247
    "Modified: / 25.10.1998 / 19:20:33 / cg"
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2248
!
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2249
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2250
digitBytes
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2251
    "return a byteArray filled with the receivers bits
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2252
     (8 bits of the absolute value per element),
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2253
     least significant byte is first"
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2254
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2255
    ^ self subclassResponsibility
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2256
!
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2257
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2258
digitBytesMSB:msbFlag
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2259
    "return a byteArray filled with the receivers bits
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2260
     (8 bits of the absolute value per element),
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2261
     if msbflag = true, most significant byte is first,
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2262
     otherwise least significant byte is first"
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2263
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2264
    msbFlag ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2265
	^ self digitBytes copyReverse.  "digitBytes may be shared - reverse a copy!!"
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2266
    ].
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2267
    ^ self digitBytes
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2268
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2269
    "
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2270
      16r12 digitBytesMSB:true
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2271
      16r1234 digitBytesMSB:true
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2272
      16r1234 digitBytesMSB:false
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2273
      16r12345678 digitBytesMSB:true
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2274
      16r12345678 digitBytesMSB:false
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  2275
    "
17951
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2276
!
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2277
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2278
swapBytes
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2279
    ^ LargeInteger digitBytes:(self digitBytes swapBytes)
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2280
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2281
    "
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2282
        16rFFEE2211 swapBytes hexPrintString
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  2283
    "
3890
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2284
! !
a024811ed304 added #digitByteLength
Claus Gittinger <cg@exept.de>
parents: 3884
diff changeset
  2285
5238
f7a816a660a3 categories
Claus Gittinger <cg@exept.de>
parents: 5210
diff changeset
  2286
!Integer methodsFor:'coercing & converting'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2287
1888
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2288
asFixedPoint
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2289
    "return the receiver as a fixedPoint number"
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2290
6640
2de8925ad2cd fixed asFixedPoint (did return int due to reduce).
Claus Gittinger <cg@exept.de>
parents: 6639
diff changeset
  2291
    ^ FixedPoint basicNew
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2292
	setNumerator:self denominator:1 scale:1
1888
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2293
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2294
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2295
     100 asFixedPoint
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2296
     100 asFixedPoint + 0.1 asFixedPoint
1888
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2297
    "
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2298
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2299
    "Modified: 5.11.1996 / 15:13:17 / cg"
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2300
!
463d49ca22e3 fixedPoint support
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2301
2141
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2302
asFixedPoint:scale
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2303
    "return the receiver as fixedPoint number, with the given number
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2304
     of post-decimal-point digits."
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2305
6639
d88a51b081ae fixed asFixedPoint (did return int due to reduce).
Claus Gittinger <cg@exept.de>
parents: 6635
diff changeset
  2306
    ^ FixedPoint basicNew
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2307
	setNumerator:self denominator:1 scale:scale
2141
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2308
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2309
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2310
     100 asFixedPoint:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2311
     100 asFixedPoint + (0.1 asFixedPoint:2)
2141
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2312
    "
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2313
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2314
    "Modified: 10.1.1997 / 20:00:08 / cg"
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2315
!
bba0027204fd added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 2133
diff changeset
  2316
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2317
asFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2318
    "return a Float with same value as myself.
11240
4ce9c8fa3d37 comment
Claus Gittinger <cg@exept.de>
parents: 11223
diff changeset
  2319
     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
  2320
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2321
    ^ Float fromInteger:self
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2322
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2323
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2324
     1234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2325
     1234567890 asFloat asInteger
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2326
     12345678901234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2327
     12345678901234567890 asFloat asInteger
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2328
    "
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2329
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2330
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2331
asFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2332
    "return a Fraction with same value as receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2333
2794
862ee34a4821 when coercing an integer, do not reduce the result.
Claus Gittinger <cg@exept.de>
parents: 2793
diff changeset
  2334
    ^ 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
  2335
862ee34a4821 when coercing an integer, do not reduce the result.
Claus Gittinger <cg@exept.de>
parents: 2793
diff changeset
  2336
    "Modified: 28.7.1997 / 19:26:06 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2337
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2338
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2339
asInteger
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2340
    "return the receiver truncated towards zero -
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2341
     for integers this is self"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2342
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2343
    ^ self
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2344
!
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2345
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2346
asLargeFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2347
    "return a LargeFloat with same value as myself.
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2348
     Since largeFloats have a limited precision, you usually loose bits when
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2349
     doing this."
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2350
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2351
    ^ LargeFloat fromInteger:self
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2352
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2353
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2354
     1234567890 asLargeFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2355
     1234567890 asLargeFloat asInteger
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2356
     12345678901234567890 asLargeFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2357
     12345678901234567890 asLargeFloat asInteger
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2358
    "
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2359
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2360
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2361
asLongFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2362
    "return a LongFloat with same value as myself.
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2363
     Since longFloats have a limited precision, you usually loose bits when
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2364
     doing this."
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2365
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2366
    ^ LongFloat fromInteger:self
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2367
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2368
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2369
     1234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2370
     1234567890 asFloat asInteger
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2371
     12345678901234567890 asFloat
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2372
     12345678901234567890 asFloat asInteger
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2373
    "
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2374
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2375
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2376
asModuloNumber
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2377
    "return a precomputed modulo number"
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2378
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  2379
    ^ ModuloNumber modulus:self.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2380
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2381
    "Created: / 3.5.1999 / 14:48:03 / stefan"
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2382
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2383
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2384
asShortFloat
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2385
    "return a ShortFloat with same value as receiver"
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2386
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2387
    ^ ShortFloat fromInteger:self
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2388
!
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2389
17928
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2390
signExtended24BitValue
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2391
    "return a smallInteger from sign-extending the 24'th bit.
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2392
     May be useful for communication interfaces"
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2393
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2394
    ^ (self bitAnd:16rFFFFFF) signExtended24BitValue
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2395
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2396
    "Modified: / 07-05-1996 / 09:31:57 / cg"
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2397
    "Created: / 05-03-2012 / 14:37:55 / cg"
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2398
!
8e8dad2e6269 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17921
diff changeset
  2399
1337
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2400
signExtendedByteValue
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2401
    "return a smallInteger from sign-extending the 8'th bit.
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2402
     May be useful for communication interfaces"
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2403
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2404
    ^ (self bitAnd:16rFF) signExtendedByteValue
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2405
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2406
    "Created: 7.5.1996 / 09:31:52 / cg"
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2407
!
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2408
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2409
signExtendedShortValue
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2410
    "return a smallInteger from sign-extending the 16'th bit.
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2411
     May be useful for communication interfaces"
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2412
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2413
    ^ (self bitAnd:16rFFFF) signExtendedShortValue
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2414
e5e00eecd4c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
  2415
    "Modified: 7.5.1996 / 09:31:57 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2416
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2417
1976
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2418
!Integer methodsFor:'comparing'!
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2419
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2420
hash
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2421
    "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
  2422
3298
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  2423
    ^ self bitAnd:16r3FFFFFFF.
1976
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2424
3298
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  2425
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2426
	-20000000000000 hash
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2427
	 20000000000000 hash
3298
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  2428
    "
1976
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2429
3298
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  2430
    "Created: / 14.11.1996 / 12:12:27 / cg"
bf837fee7a15 Do not return negative hash values.
Stefan Vogel <sv@exept.de>
parents: 3188
diff changeset
  2431
    "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
  2432
! !
f6e7094cd3e4 Integer>>hash returns a value clamped to the SmallInteger range
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
  2433
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2434
!Integer methodsFor:'dependents access'!
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2435
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2436
addDependent:anObject
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2437
    Transcript show:'*** trying to make dependent on an integer: '.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2438
    thisContext sender printOn:Transcript. Transcript cr.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2439
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2440
    "Created: / 28-07-2010 / 20:29:00 / cg"
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2441
! !
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  2442
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2443
!Integer methodsFor:'double dispatching'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2444
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2445
differenceFromFraction:aFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2446
    "sent when a fraction does not know how to subtract the receiver, an integer"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2447
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2448
    |d|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2449
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2450
    d := aFraction denominator.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2451
    ^ aFraction class
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2452
	numerator:(aFraction numerator - (self * d))
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2453
	denominator:d
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2454
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2455
    "Modified: 28.7.1997 / 19:08:30 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2456
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2457
11517
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2458
differenceFromTimestamp:aTimestamp
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2459
    "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
  2460
     before aTimestamp"
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2461
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2462
    ^ aTimestamp subtractSeconds:self.
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2463
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2464
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2465
     Timestamp now subtractSeconds:100
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2466
     100 differenceFromTimestamp:Timestamp now
11517
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2467
    "
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2468
!
e949ec17d9fc double dispatch for time-difference
sr
parents: 11510
diff changeset
  2469
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2470
equalFromFraction:aFraction
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2471
    "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
  2472
     if resulting from an arithmetic operation.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2473
     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
  2474
     allows comparing unnormalized fractions as might appear within the fraction class"
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2475
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2476
    |denominator numerator|
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2477
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2478
    denominator := aFraction denominator.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2479
    numerator := aFraction numerator.
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2480
    (denominator == 1) ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2481
	^ numerator = (self * denominator)
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2482
    ].
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2483
    ^ numerator = self
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2484
!
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2485
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2486
productFromFraction:aFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2487
    "sent when a fraction does not know how to multiply the receiver, an integer"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2488
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2489
    ^ aFraction class
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2490
	numerator:(self * aFraction numerator)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2491
	denominator:aFraction denominator
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2492
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2493
    "Modified: 28.7.1997 / 19:08:27 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2494
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2495
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2496
quotientFromFraction:aFraction
7444
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2497
    "Return the quotient of the argument, aFraction and the receiver.
e228b1ba6d6a double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
  2498
     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
  2499
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2500
    ^ aFraction class
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2501
	numerator:aFraction numerator
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2502
	denominator:(self * aFraction denominator)
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2503
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2504
    "Modified: 28.7.1997 / 19:08:23 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2505
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2506
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2507
sumFromFraction:aFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2508
    "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
  2509
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2510
    |d|
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2511
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2512
    d := aFraction denominator.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2513
    ^ aFraction class
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2514
	numerator:(aFraction numerator + (self * d))
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2515
	denominator:d
2793
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2516
e40dedf51177 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2745
diff changeset
  2517
    "Modified: 28.7.1997 / 19:08:11 / cg"
10681
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2518
!
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2519
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2520
sumFromTimestamp:aTimestamp
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2521
    "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
  2522
     after aTimestamp"
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2523
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2524
    ^ aTimestamp addSeconds:self.
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2525
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2526
    "
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2527
     Timestamp now addSeconds:100
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2528
     100 sumFromTimestamp:Timestamp now
835be355e638 adding timeDurations to a timeStamp (double dispatch)
sr
parents: 10488
diff changeset
  2529
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2530
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2531
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2532
!Integer methodsFor:'helpers'!
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2533
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2534
gcd_helper:anInteger
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2535
    "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
  2536
     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
  2537
     larger than the arg."
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2538
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2539
    | a b selfLowBit argLowBit shift t |
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2540
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2541
    a := self.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2542
    b := anInteger.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2543
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2544
    selfLowBit := a lowBit - 1.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2545
    argLowBit := b lowBit - 1.
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2546
    shift := selfLowBit min:argLowBit.
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2547
    b := b bitShift:(argLowBit negated).
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2548
    [a = 0] whileFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2549
	a := a bitShift:(selfLowBit negated).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2550
	a < b ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2551
	    t := a. a := b. b := t
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2552
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2553
	a := a - b.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2554
	selfLowBit := a lowBit - 1.
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2555
    ].
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2556
    ^ b bitShift:shift
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2557
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2558
    "Created: 1.3.1997 / 16:38:17 / cg"
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2559
    "Modified: 1.3.1997 / 16:45:17 / cg"
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2560
! !
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2561
17736
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2562
!Integer methodsFor:'iteration'!
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2563
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2564
to:stop collect:aBlock
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2565
    "syntactic sugar; 
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2566
     same as (self to:stop) collect:aBlock"
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2567
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2568
    |n a|
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2569
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2570
    n := stop - self + 1.
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2571
    a := Array new:n.
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2572
    self to:stop do:[:i |
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2573
        a at:(i-self+1) put:(aBlock value:i).
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2574
    ].
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2575
    ^ a.
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2576
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2577
    "
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2578
     1 to:10 collect:[:i | i squared]
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2579
     10 to:20 collect:[:i | i squared]  
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2580
     (10 to:20) collect:[:i | i squared]
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2581
    "
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2582
! !
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  2583
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2584
!Integer methodsFor:'misc math'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2585
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2586
acker:n
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2587
    "return the value of acker(self, n).
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2588
      ;-) Do not try with receivers > 3"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2589
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2590
    (self == 0) ifTrue:[^ n + 1].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2591
    (n == 0) ifTrue:[^ (self - 1) acker: 1].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2592
    ^ (self - 1) acker:(self acker:(n - 1))
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2593
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2594
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2595
     3 acker:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2596
     3 acker:7
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2597
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2598
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2599
    "Modified: 18.7.1996 / 13:08:16 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2600
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  2601
11491
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  2602
binco:kIn
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2603
    "an alternative name for the binomial coefficient for squeak compatibility"
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2604
11491
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  2605
    ^ self binomialCoefficient:kIn
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2606
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2607
    "Modified: / 17-08-2010 / 17:29:07 / cg"
11491
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  2608
!
4920830c3d9a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11486
diff changeset
  2609
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2610
binomialCoefficient:kIn
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2611
    "The binomial coefficient
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2612
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2613
      / n \     with self being n, and 0 <= k <= n.
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2614
      \ k /
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2615
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2616
     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
  2617
     also known as a combination or combinatorial number.
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2618
     Sometimes also called C(n,k) (for choose k from n)
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2619
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2620
     binCo is defined as:
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2621
	n!!
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2622
     ----------
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2623
     k!! (n-k)!!
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2624
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2625
     but there is a faster, recursive formula:
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2626
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2627
      / n \  = / n - 1 \  + / n - 1 \
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2628
      \ k /    \ k - 1 /    \   k   /
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2629
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2630
     with:
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2631
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2632
      / n \  = / n \  =  1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2633
      \ 0 /    \ n /
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2634
    "
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2635
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2636
    |k acc|
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2637
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2638
    kIn > self ifTrue:[^ 0].
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2639
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2640
    k := kIn.
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2641
    k > (self / 2) ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2642
	"/ symmetry
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2643
	k := self - k.
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2644
    ].
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2645
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2646
    acc := 1.
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2647
    1 to:k do:[:i |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2648
	acc := acc * (self - k + i) / i.
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2649
    ].
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2650
    ^ acc
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2651
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2652
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2653
     (7 binomialCoefficient:3)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2654
     (10 binomialCoefficient:5)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2655
     (100 binomialCoefficient:5)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2656
     (1000 binomialCoefficient:5)
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2657
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2658
     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
  2659
     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
  2660
     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
  2661
     TestCase assert: (10000 binomialCoefficient:78) = (10000 factorial / (78 factorial * (10000-78) factorial))
11486
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2662
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2663
     Time millisecondsToRun:[ (10000 binomialCoefficient:78) ]                            -> 0
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2664
     Time millisecondsToRun:[ (10000 factorial / (78 factorial * (10000-78) factorial)) ] -> 437
6371ea09c6f0 comment
Claus Gittinger <cg@exept.de>
parents: 11485
diff changeset
  2665
11476
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2666
    "
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2667
!
bdf0c2c2ef09 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11464
diff changeset
  2668
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2669
divMod:aNumber
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2670
    "return an array filled with self // aNumber and
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2671
     self \\ aNumber.
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2672
     The result is only defined for positive receiver and argument.
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2673
     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
  2674
     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
  2675
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2676
    ^ Array
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  2677
	with:(self // aNumber)
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  2678
	with:(self \\ aNumber)
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2679
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2680
    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2681
     10 divMod:3
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2682
     100 factorial divMod:103
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2683
    "
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2684
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2685
    "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
  2686
!
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2687
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2688
extendedEuclid:tb
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2689
    "return the solution of 'ax + by = gcd(a,b)'.
7356
fe8fb0a571f2 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  2690
     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
  2691
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2692
    |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
  2693
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  2694
    self < tb ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2695
	a := self.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2696
	b := tb.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2697
	swap := false.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2698
    ] ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2699
	a := tb.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2700
	b := self.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2701
	swap := true.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2702
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2703
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2704
    shift := ((a lowBit) min:(b lowBit))-1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2705
    shift > 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2706
	tmp := shift negated.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2707
	a := a bitShift:tmp.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2708
	b := b bitShift:tmp.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2709
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2710
9057
13bd29f579c6 Bug 343: #clearBit: changed the receiver (shouldn't do that).
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  2711
    gcd  := a.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2712
    gcd1 := b.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2713
    u := 1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2714
    u1 := 0.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2715
    v := 0.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2716
    v1 := 1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2717
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2718
    [
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  2719
"/      The following condition is true:
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  2720
"/        (a * u1) + (b * v1) ~= gcd1 ifTrue:[self halt].
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2721
	t := gcd1 divMod:gcd.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2722
	gcd1 := gcd.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2723
	gcd := t at:2.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2724
	t := t at:1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2725
	tmp := v.
5003
304be9a3a226 Add some debug in #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 5001
diff changeset
  2726
"/v1 - (v * t) - v1 + (v * t) ~= 0 ifTrue:[self halt].
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2727
	v := v1 - (v * t).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2728
	v1 := tmp.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2729
	tmp := u.
5003
304be9a3a226 Add some debug in #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 5001
diff changeset
  2730
"/u1 - (u * t) - u1 + (u * t) ~= 0 ifTrue:[self halt].
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2731
	u := u1 - (u * t).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2732
	u1 := tmp.
9057
13bd29f579c6 Bug 343: #clearBit: changed the receiver (shouldn't do that).
Stefan Vogel <sv@exept.de>
parents: 8937
diff changeset
  2733
    gcd > 0] whileTrue.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2734
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2735
    shift > 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2736
	gcd1 := gcd1 bitShift:shift.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2737
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2738
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2739
    swap ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2740
	^ Array with:v1 with:u1 with:gcd1.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2741
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2742
    ^ Array with:u1 with:v1 with:gcd1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2743
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2744
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2745
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2746
     14 extendedEuclid:5
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2747
     14 extendedEuclid:2
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2748
     25 extendedEuclid:15
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2749
    "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2750
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2751
    "Created: / 27.4.1999 / 15:19:22 / stefan"
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  2752
    "Modified: / 18.11.1999 / 16:19:24 / stefan"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2753
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2754
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2755
factorial
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2756
    "return fac(self) (i.e. 1*2*3...*self) using an iterative algorithm.
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2757
     This is slightly faster than the recursive algorithm, and does not
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2758
     suffer from stack overflow problems (with big receivers)"
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2759
2745
bdf76e380d27 errorString to DomainError
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2760
    |p i|
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2761
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2762
    (self < 2) ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2763
	self < 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2764
	    "/
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2765
	    "/ requested factorial of a negative number
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2766
	    "/
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2767
	    ^ self class
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2768
		raise:#domainErrorSignal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2769
		receiver:self
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2770
		selector:#factorial
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2771
		arguments:#()
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2772
		errorString:'factorial of negative number'
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2773
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2774
	^ 1
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  2775
    ].
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2776
    p := 2.
2745
bdf76e380d27 errorString to DomainError
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2777
    i := 3.
bdf76e380d27 errorString to DomainError
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2778
    [i <= self] whileTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2779
	p := p * i.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2780
	i := i + 1.
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2781
    ].
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2782
    ^ p
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2783
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2784
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2785
     10 factorial
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2786
     1000 factorial
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2787
     10000 factorial
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2788
     10000 factorialR
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2789
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2790
     Time millisecondsToRun:[2000 factorial]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2791
     Time millisecondsToRun:[2000 factorialR]
2745
bdf76e380d27 errorString to DomainError
Claus Gittinger <cg@exept.de>
parents: 2458
diff changeset
  2792
     -1 factorial
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2793
    "
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2794
10027
36281068b212 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9401
diff changeset
  2795
    "Modified: / 04-10-2006 / 14:31:12 / cg"
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2796
!
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2797
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2798
factorialR
3908
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  2799
    "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
  2800
3908
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  2801
     This is included to demonstration purposes - if you really need
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  2802
     factorial numbers, use the iterative #factorial, which is slightly
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  2803
     faster and does not suffer from stack overflow problems (with big receivers)."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2804
356
claus
parents: 345
diff changeset
  2805
    (self >= 2) ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2806
	^ self * (self - 1) factorialR
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2807
    ].
356
claus
parents: 345
diff changeset
  2808
    ^ 1
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
  2809
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
  2810
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2811
     10 factorialR
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2812
     1000 factorialR
4158
e04b61500e51 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4151
diff changeset
  2813
     Time millisecondsToRun:[10000 factorial]
212
3edd10edefaf *** empty log message ***
claus
parents: 202
diff changeset
  2814
    "
1560
f5ffcc5c3834 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1559
diff changeset
  2815
3908
b893f399f517 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3890
diff changeset
  2816
    "Created: / 18.7.1996 / 12:48:36 / cg"
4158
e04b61500e51 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4151
diff changeset
  2817
    "Modified: / 8.5.1999 / 18:40:13 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2818
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2819
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2820
fib
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2821
    "compute the fibionacci number for the receiver.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2822
	fib(0) := 0
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2823
	fib(1) := 1
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2824
	fib(n) := fib(n-1) + fib(n-2)"
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2825
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2826
    self <= 0 ifTrue:[
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2827
	self == 0 ifTrue:[^ 0].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2828
    ].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2829
    ^ self fib_helper
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2830
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2831
    "
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2832
     30 fib
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2833
     60 fib
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2834
     1000 fib
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2835
    "
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2836
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2837
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2838
fib_helper
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2839
    "compute the fibionacci number for the receiver.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2840
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2841
        Fib(n) = Fib(n-1) + Fib(n-2)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2842
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2843
     Knuth:
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2844
        Fib(n+m) = Fib(m) * Fib(n+1) + Fib(m-1) * Fib(n)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2845
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2846
     This is about 3 times faster than fib_iterative.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2847
    "
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2848
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2849
    |fibUsingDict dict|
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2850
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2851
    dict := Dictionary new:100.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2852
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2853
    fibUsingDict := [:x |
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2854
        |n fib fibN fibNp1 fibNm1 fibXm1 fibXm2 fibXp1|
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2855
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2856
        x <= 30 ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2857
                "/ 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
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2858
            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
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2859
                     ) at:x
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2860
        ] ifFalse:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2861
            fib := dict at:x ifAbsent:nil.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2862
            fib isNil ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2863
                fibXm1 := dict at:(x-1) ifAbsent:nil.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2864
                fibXm1 notNil ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2865
                    fibXm2 := dict at:(x-2) ifAbsent:nil.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2866
                    fibXm2 notNil ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2867
                        fib := fibXm1 + fibXm2.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2868
                    ] ifFalse:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2869
                        fibXp1 := dict at:(x+1) ifAbsent:nil.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2870
                        fibXp1 notNil ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2871
                            fib := fibXp1 - fibXm1.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2872
                        ]
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2873
                    ]
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2874
                ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2875
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2876
                fib isNil ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2877
                    n := x // 2.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2878
                    x odd ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2879
                        "/ m is set to n+1; therefore:
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2880
                        "/ Fib(x) = Fib(n+n+1)      ; x odd; setting n = (x-1)/2
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2881
                        "/ using Knuth:
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2882
                        "/ Fib(n+n+1) = Fib(n+1) * Fib(n+1) + Fib(n+1-1) * Fib(n)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2883
                        "/            = (Fib(n+1) ^ 2) + (Fib(n) ^ 2)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2884
                        fibN   := fibUsingDict value:n.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2885
                        fibNp1 := fibUsingDict value:(n+1).
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2886
                        fib := fibN squared + fibNp1 squared
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2887
                    ] ifFalse:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2888
                        "/ as
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2889
                        "/    Fib(n+1) = Fib(n) + Fib(n-1)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2890
                        "/ therefore:
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2891
                        "/    Fib(n) = Fib(n+1) - Fib(n-1)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2892
                        "/ and, since n is even, n+1 and n-1 are odd, and can be computed as above.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2893
                        "/ This gives us:
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2894
                        "/    Fib(x) = Fib(x+1) - Fib(x-1)      ; x even; setting n = x/2
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2895
                        "/           = Fib(n+n+1) - Fib(n+n-1)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2896
                        "/           = Fib(n+n+1) - Fib((n-1)+(n-1)+1)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2897
                        "/           = ((Fib(n+1)^2) + (Fib(n)^2)) - ((Fib((n-1)+1)^2) + (Fib((n-1))^2))
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2898
                        "/           = (Fib(n+1)^2) + (Fib(n)^2) - (Fib(n)^2) - (Fib((n-1))^2)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2899
                        "/           = (Fib(n+1)^2) - (Fib((n-1))^2)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2900
                        fibNm1 := fibUsingDict value:(n-1).
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2901
                        fibNp1 := fibUsingDict value:(n+1).
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2902
                        fib := fibNp1 squared - fibNm1 squared
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2903
                    ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2904
                ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2905
                dict at:x put:fib.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2906
            ]
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2907
        ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2908
        fib
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2909
    ].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2910
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2911
    ^ fibUsingDict value:self
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2912
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2913
    "the running time is mostly dictated by the LargeInteger multiplication performance...
17900
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  2914
     (therefore, we get O execution times, even for a linear number of multiplications)
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2915
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2916
     Time millisecondsToRun:[50000 fib_iterative]  312    (DUO 1.7Ghz CPU)
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2917
     Time millisecondsToRun:[50000 fib_helper]     109
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2918
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2919
     Time millisecondsToRun:[100000 fib_iterative] 1248
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2920
     Time millisecondsToRun:[100000 fib_helper]    374
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2921
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2922
     Time millisecondsToRun:[200000 fib_iterative] 4758
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2923
     Time millisecondsToRun:[200000 fib_helper]    1544
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2924
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2925
     Time millisecondsToRun:[400000 fib_iterative] 18892
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2926
     Time millisecondsToRun:[400000 fib_helper]    6084
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2927
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2928
     1 to:100 do:[:i | self assert:(i fib_iterative = i fib_helper) ]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2929
     1 to:100 do:[:i | self assert:(i fib_iterative = i fib) ]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2930
    "
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2931
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  2932
    "Modified: / 17-08-2010 / 17:29:34 / cg"
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2933
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2934
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2935
gcd:anInteger
2428
d54efc515824 better gcd for large integers
Claus Gittinger <cg@exept.de>
parents: 2408
diff changeset
  2936
    "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
  2937
     Euclids & Knuths algorithm."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2938
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2939
    |a b t|
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2940
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2941
    a := self abs.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2942
    b := anInteger abs.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2943
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2944
    a < b ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2945
	t := a.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2946
	a := b.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2947
	b := t.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2948
    ].
52
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  2949
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2950
    b = 0 ifTrue: [^ a].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2951
    a := a \\ b.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2952
    a = 0 ifTrue:[^ b].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2953
    ^ b gcd_helper:a
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  2954
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2955
    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2956
     3141589999999999 gcd:1000000000000000
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2957
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2958
     Time millisecondsToRun:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2959
	10000 timesRepeat:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2960
	   123456789012345678901234567890 gcd: 9876543210987654321
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2961
	]
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  2962
     ]
3060
0faf242e1142 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  2963
    "
0faf242e1142 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  2964
0faf242e1142 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  2965
    "Modified: / 25.10.1997 / 16:08:45 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2966
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2967
17938
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2968
integerLog2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2969
    "return the floor of log2 of the receiver"
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2970
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2971
    self <= 0 ifTrue:[
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2972
        ^ self class
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2973
            raise:#domainErrorSignal
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2974
            receiver:self
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2975
            selector:#intlog10
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2976
            arguments:#()
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2977
            errorString:'logarithm of negative integer'
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2978
    ].
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2979
    ^ self highBit - 1.
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2980
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2981
    "
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2982
      100 integerLog2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2983
      100 log:2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2984
      999 integerLog2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2985
      999 log:2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2986
      120000 integerLog2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2987
      120000 log:2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2988
      -1 integerLog2
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2989
    "
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2990
!
e2aad1d7c317 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17928
diff changeset
  2991
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2992
integerReciprocal
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2993
    "return an integer representing 1/self * 2**n.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2994
     Where an integer is one bit longer than self.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  2995
     This is a helper for modulu numbers"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2996
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  2997
    |b rem result|
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2998
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  2999
    b := self highBit.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3000
    rem := 1 bitShift:b.
10488
8c254af93816 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 10030
diff changeset
  3001
    result := LargeInteger basicNew numberOfDigits:(b // 8)+1.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3002
    b := b+1.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3003
    [b > 0] whileTrue:[
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3004
        rem >= self ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3005
            rem := rem -= self.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3006
            result digitBytes bitSetAt:b.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3007
        ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3008
        rem := rem mul2.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3009
        b := b - 1.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3010
    ].
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3011
    ^ result compressed.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3012
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3013
    "
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3014
     333 integerReciprocal                (2 raisedTo:18) // 333
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3015
     393 integerReciprocal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3016
     8 integerReciprocal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3017
     15 integerReciprocal
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3018
     15112233445566 integerReciprocal
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3019
     10239552311579 integerReciprocal
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3020
   "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3021
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3022
    "Modified: / 03-05-1999 / 14:27:18 / stefan"
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3023
    "Modified: / 17-08-2010 / 17:30:22 / cg"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3024
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3025
17736
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3026
integerSqrt
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3027
    "newton's method to get the largest integer which is less or equal to the
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3028
     receiver's square root. 
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3029
     This might be needed for some number theoretic problems with large numbers
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3030
     (ans also in cryptography)"
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3031
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3032
    |guess prevGuess guessSquared|
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3033
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3034
    guess := (1 bitShift:(self highBit // 2)).
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3035
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3036
    [ 
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3037
        prevGuess ~= guess
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3038
        and:[ ((guessSquared := guess squared) - self) abs >= guess ]
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3039
    ] whileTrue:[
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3040
        prevGuess := guess.
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3041
        guess := (guess + (self / guess)) // 2.
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3042
    ].
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3043
    guessSquared > self ifTrue:[
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3044
        guess := guess - 1.
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3045
    ].
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3046
    "/ self assert:(guess squared <= self).
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3047
    "/ self assert:((guess + 1) squared > self).
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3048
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3049
    ^ guess.
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3050
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3051
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3052
    "
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3053
     333 integerSqrt          
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3054
     325 integerSqrt          
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3055
     324 integerSqrt          
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3056
     323 integerSqrt          
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3057
     10239552311579 integerSqrt
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3058
     5397346292805549782720214077673687806275517530364350655459511599582614290 integerSqrt
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3059
     1000 factorial integerSqrt 
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3060
   "
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3061
!
26cfea63471d Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17735
diff changeset
  3062
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3063
inverseMod:n
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3064
    "find the modular inverse for myself to n.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3065
     This is defined as the solution of: '1 = (self * x) mod n.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3066
     This is a helper for modulu numbers"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3067
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3068
    |e ret|
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3069
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  3070
    "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
  3071
     (self * x) + (n * y) = self gcd:n"
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  3072
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3073
    e := self extendedEuclid:n.
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3074
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3075
    (e at:3) == 1 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3076
	ret := e at:1.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3077
	ret negative ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3078
	    ^ ret + n
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3079
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3080
	^ ret.
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3081
    ].
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3082
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3083
    ^ 0
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3084
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3085
    "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3086
     14 inverseMod:5      -> 4
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3087
     5 inverseMod:14      -> 3
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3088
     14 inverseMod:11     -> 4                (4 * 14) \\ 11
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3089
     11 inverseMod:14     -> 9                (9 * 11) \\ 14
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3090
     79 inverseMod:3220   -> 1019
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3091
     3220 inverseMod:79   -> 54               (54 * 3220) \\ 79
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3092
     1234567891 inverseMod:1111111111119
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3093
			  -> 148726663534     (148726663534*1234567891) \\ 1111111111119
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3094
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3095
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3096
     14 extendedEuclid:11
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3097
     5 extendedEuclid:14
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3098
     14 extendedEuclid:2
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3099
     3220 extendedEuclid:79
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3100
    "
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3101
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3102
    "Created: / 27.4.1999 / 15:19:22 / stefan"
5001
732ea614d36d Comments for #inverseMod: and #extendedEuclid:
Stefan Vogel <sv@exept.de>
parents: 4996
diff changeset
  3103
    "Modified: / 18.11.1999 / 16:21:37 / stefan"
4136
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3104
!
8c8bfa5808a3 Optimisations and modulo arithmethic
Stefan Vogel <sv@exept.de>
parents: 4039
diff changeset
  3105
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3106
lcm:anInteger
52
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  3107
    "return the least common multiple (using gcd:)"
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  3108
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  3109
    ^ (self * anInteger) abs // (self gcd: anInteger)
cf23b8901602 *** empty log message ***
claus
parents: 49
diff changeset
  3110
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3111
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3112
     65 lcm:15
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3113
     3 lcm:15
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3114
    "
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3115
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3116
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3117
primeFactors
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3118
    "return a collection of prime factors of the receiver.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3119
     For prime numbers, an empty collection is returned.
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3120
     Can take a long time for big numbers"
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3121
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3122
    ^ self primeFactorsUpTo:nil
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3123
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3124
    "
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3125
     2 to:10000 do:[:n |
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3126
        self assert:((n isPrime and:[ n primeFactors isEmpty])
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3127
                    or:[ n isPrime not and:[n primeFactors product = n]])
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3128
     ]
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3129
     3 to:10000 do:[:n |
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3130
        self assert:(n factorial primeFactors product = n factorial)
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3131
     ]
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3132
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3133
     13195 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3134
     12 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3135
     2 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3136
     3 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3137
     5 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3138
     14 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3139
     13423453625634765 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3140
     13423453625634765 isPrime
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3141
     13423453625634765 gcd:(3 * 5 * 19 * 29)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3142
     13423453625634765 / 8265
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3143
     1624132320101 isPrime
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3144
     1624132320101 gcd: 8265
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3145
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3146
     1000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3147
     100000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3148
     1000000000 primeFactors
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3149
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3150
     Time millisecondsToRun:[
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3151
        1000 timesRepeat:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3152
            10000000000000000000000000000000000000 primeFactors
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3153
        ]
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3154
     ]   421
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3155
    "
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3156
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3157
    "Modified: / 17-08-2010 / 17:27:33 / cg"
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3158
!
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3159
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3160
primeFactorsUpTo:limitArgOrNil
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3161
    "return a collection of prime factors of the receiver.
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3162
     For prime numbers, an empty collection is returned.
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3163
     Can take a long time for big numbers
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3164
     (win a nobel price, if you find something quick (*)
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3165
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3166
     (*):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
  3167
11582
56088c49011e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11563
diff changeset
  3168
    |rest n factors limit lastPrime checkThisFactor nextTry|
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3169
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3170
    factors := Bag new.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3171
    rest := self.
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3172
    limit := (rest // 2).
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3173
    limitArgOrNil notNil ifTrue:[
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3174
        limit := limit min:limitArgOrNil.
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3175
    ].
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3176
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3177
    "/ try to get the number down fast:
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3178
    n := rest lowBit.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3179
    n ~~ 1 ifTrue:[
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3180
        self == 2 ifTrue:[^ #() ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3181
        factors add:2 withOccurrences:(n-1).
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3182
        rest := rest rightShift:(n-1).
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3183
    ].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3184
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3185
    checkThisFactor := [:prime |
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3186
            prime*prime > rest ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3187
                (rest ~~ 1 and:[factors notEmpty]) ifTrue:[ factors add:rest ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3188
                ^ factors.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3189
            ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3190
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3191
            [rest \\ prime == 0] whileTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3192
                factors add:prime.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3193
                rest := rest // prime.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3194
                rest == 1 ifTrue:[^ factors].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3195
            ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3196
            lastPrime := prime.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3197
        ].
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3198
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3199
    limit <= 2000 ifTrue:[
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3200
        Integer primesUpTo2000 do:checkThisFactor.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3201
        ^ factors
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3202
    ].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3203
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3204
    "/ 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
  3205
    "/ 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
  3206
    "/ which may slow things down quite a bit.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3207
    "/ (the primesUpTo uses a faster sieve, but can only represent primes to upTo (say)
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3208
    "/ a few millions).
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3209
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3210
    Integer primesUpTo:(limit min:(1000000 max:Integer primeCacheSize)) do:checkThisFactor.
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3211
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3212
    nextTry := lastPrime + 2.
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3213
    [ nextTry <= limit ] whileTrue:[
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3214
        "/ now, we are beyond the list of pre-generated primes.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3215
        "/ change our strategy to: see if it divides an odd number;
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3216
        "/ if so, add the divisor's prime factors.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3217
        nextTry*nextTry > rest ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3218
            (rest ~~ 1 and:[factors notEmpty]) ifTrue:[ factors add:rest ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3219
            ^ factors.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3220
        ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3221
        [(rest \\ nextTry) == 0] whileTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3222
            "/ can only happen relatively late after the last prime,
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3223
            "/ because otherwise, the primeFactors of nextTry would already have
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3224
            "/ been found as divisors.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3225
            "/ first chance is: (lastPrime + 2) squared
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3226
            nextTry < lastPrime squared ifTrue:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3227
                "/ nextTry is a prime !!
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3228
                factors add:nextTry
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3229
            ] ifFalse:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3230
                factors addAll:(nextTry primeFactors).
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3231
            ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3232
            rest := rest // nextTry.
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3233
        ].
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3234
        nextTry := nextTry + 2.
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3235
    ].
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3236
    ^ factors
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3237
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3238
    "
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3239
     2 to:10000 do:[:n |
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3240
        self assert:((n isPrime and:[ n primeFactors isEmpty])
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3241
                    or:[ n isPrime not and:[n primeFactors product = n]])
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3242
     ]
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3243
     3 to:10000 do:[:n |
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3244
        self assert:(n factorial primeFactors product = n factorial)
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3245
     ]
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3246
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3247
     13195 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3248
     12 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3249
     2 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3250
     3 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3251
     5 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3252
     14 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3253
     13423453625634765 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3254
     13423453625634765 isPrime
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3255
     13423453625634765 gcd:(3 * 5 * 19 * 29)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3256
     13423453625634765 / 8265
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3257
     1624132320101 isPrime
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3258
     1624132320101 gcd: 8265
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3259
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3260
     1000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3261
     100000000 primeFactors
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3262
     1000000000 primeFactors
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3263
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3264
     Time millisecondsToRun:[
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3265
        1000 timesRepeat:[
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3266
            10000000000000000000000000000000000000 primeFactors
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3267
        ]
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3268
     ]   421
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3269
    "
17797
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3270
71451ae83564 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17795
diff changeset
  3271
    "Modified: / 17-08-2010 / 17:28:05 / cg"
11496
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3272
!
74c8c4d468d7 prime stuff
Claus Gittinger <cg@exept.de>
parents: 11495
diff changeset
  3273
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3274
raisedTo:exp mod:mod
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3275
    "return the modulo (remainder) of
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3276
     the receiver raised to exp (an Integer) and mod (another Integer)"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3277
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3278
    |result m t
5816
ce15ce5294b4 Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5799
diff changeset
  3279
"/     eI   "{Class: SmallInteger}"
ce15ce5294b4 Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5799
diff changeset
  3280
     bits "{Class: SmallInteger}"|
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3281
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3282
    "use the addition chaining algorithm"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3283
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3284
    exp == 0 ifTrue:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3285
        ^ 1
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3286
    ].
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3287
    exp == 1 ifTrue:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3288
        mod isNumber ifTrue:[
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3289
            ^ self \\ mod.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3290
        ]
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3291
    ].
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3292
    exp negative ifTrue:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3293
        ^ self class
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3294
            raise:#domainErrorSignal
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3295
            receiver:self
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3296
            selector:#raisedTo:mod:
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3297
            arguments:(Array with:exp with:mod)
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3298
            errorString:'modulo arithmethic with negative exponent'
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3299
    ].
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3300
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3301
    m := mod asModuloNumber.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3302
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3303
    result := 1.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3304
    t := m modulusOf:self.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3305
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3306
    "/ to be validated ...
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3307
"/    (exp class == SmallInteger) ifTrue:[
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3308
"/        eI := exp.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3309
"/        [eI ~~ 0] whileTrue:[
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3310
"/            (eI bitAnd:1) == 1 ifTrue:[
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3311
"/                result := m modulusOf:(result * t).
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3312
"/            ].
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3313
"/            t := m modulusOf:(t * t).
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3314
"/            eI := eI bitShift:-1.
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3315
"/        ].
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3316
"/        ^ result.
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3317
"/    ].
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3318
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3319
    bits := exp highBit.
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3320
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3321
    1 to:bits-1 do:[:i|
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3322
        (exp bitAt:i) == 1 ifTrue:[
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3323
            result := m modulusOf:(result * t).
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3324
        ].
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3325
        t := m modulusOf:(t * t).
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3326
    ].
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3327
    result := m modulusOf:(result * t).
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3328
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3329
    ^ result
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3330
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3331
    "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3332
     2 raisedTo:2 mod:3
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3333
      20000000000000 raisedTo:200 mod:190  ->  30
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3334
     (20000000000000 raisedTo:200) \\ 190
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3335
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3336
      Time millisecondsToRun:[10000 timesRepeat:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3337
                                20000000000000 raisedTo:200 mod:190
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3338
                              ]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3339
                             ]
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3340
8335
e7fa7779b1b9 Fix #raisedTo:mod: for expontents 1 and 0
Stefan Vogel <sv@exept.de>
parents: 8289
diff changeset
  3341
     Time millisecondsToRun:[1000 timesRepeat:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3342
                                (20000000000000 raisedTo:200) \\ 190
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3343
                             ]
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3344
                            ]
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3345
    "
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3346
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3347
    "Created: / 27.4.1999 / 15:19:22 / stefan"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3348
    "Modified: / 5.5.1999 / 11:18:20 / stefan"
6195
9e60c38d1d61 #raise:receiver:selector...
Claus Gittinger <cg@exept.de>
parents: 6055
diff changeset
  3349
    "Modified: / 16.11.2001 / 14:15:21 / cg"
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3350
!
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3351
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3352
raisedToCrtModP:p q:q ep:ep eq:eq u:u
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3353
    "Application of the Chinese Remainder Theorem (CRT).
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3354
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3355
     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
  3356
     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
  3357
     modulus, the Chinese Remainder Theorem to do the computation mod p and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3358
     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
  3359
     precomputed values, but does not actually require the modulus n or the
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3360
     exponent e.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3361
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3362
     expout = expin ^ e mod (p*q).
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3363
     We form this by evaluating
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3364
     p2 = (expin ^ e) mod p and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3365
     q2 = (expin ^ e) mod q
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3366
     and then combining the two by the CRT.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3367
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3368
     Two optimisations of this are possible.  First, we can reduce expin
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3369
     modulo p and q before starting.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3370
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3371
     Second, since we know the factorisation of p and q (trivially derived
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3372
     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
  3373
     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
  3374
     to throw away multiples of phi(p) or phi(q) in e.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3375
     Letting ep = e mod phi(p) and
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3376
	      eq = e mod phi(q)
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3377
     then combining these two speedups, we only need to evaluate
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3378
     p2 = ((expin mod p) ^ ep) mod p and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3379
     q2 = ((expin mod q) ^ eq) mod q.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3380
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3381
     Now we need to apply the CRT.  Starting with
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3382
     expout = p2 (mod p) and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3383
     expout = q2 (mod q)
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3384
     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
  3385
     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
  3386
     (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
  3387
     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
  3388
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3389
     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
  3390
     Since we want 0 <= k < q, we can thus find k as
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3391
     k = (u * (q2-p2)) mod q.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3392
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3393
     Once we have k, evaluating p2 + p * k is easy, and
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3394
     that gives us the result
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3395
    "
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3396
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3397
    |result t mp mq|
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3398
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3399
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3400
    mp := p asModuloNumber.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3401
    t := mp modulusOf:self.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3402
    result := t raisedTo:ep mod:mp.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3403
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3404
    mq := q asModuloNumber.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3405
    t := mq modulusOf:self.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3406
    t := t raisedTo:eq mod:mq.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3407
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3408
    "now p2 is in result, q2 in t"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3409
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3410
    t := t -= result.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3411
    t < 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3412
	t := t + q.
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3413
    ].
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3414
    t := t *= u.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3415
    t := mq modulusOf:t.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3416
    t := t *= p.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3417
    result := result += t.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3418
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3419
    ^ result.
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3420
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3421
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3422
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3423
    "
4973
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3424
     2 raisedTo:2 mod:3
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3425
      20000000000000 raisedTo:200 mod:190
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3426
     (20000000000000 raisedTo:200) \\ 190
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3427
    "
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3428
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3429
    "Created: / 30.4.1999 / 15:53:15 / stefan"
2bbd09250179 Fix CRT
Stefan Vogel <sv@exept.de>
parents: 4972
diff changeset
  3430
    "Modified: / 5.5.1999 / 11:01:15 / stefan"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3431
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3432
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3433
!Integer methodsFor:'printing & storing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3434
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3435
asBCDBytes
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3436
    "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
  3437
     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
  3438
     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
  3439
     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
  3440
     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
  3441
    "
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3442
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3443
    |s rest twoDigits hi lo|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3444
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3445
    self == 0 ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3446
	^ #[ 16r00 ]
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3447
    ].
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3448
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3449
    "/ 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
  3450
    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
  3451
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3452
    rest := self.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3453
    [rest > 0] whileTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3454
	twoDigits := rest \\ 100.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3455
	rest := rest // 100.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3456
	hi := twoDigits \\ 10.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3457
	lo := twoDigits // 10.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3458
	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
  3459
    ].
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3460
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3461
    ^ s contents reverse
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3462
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3463
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3464
     12345678 asBCDBytes
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3465
     12345678901234567890 asBCDBytes
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3466
    "
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3467
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3468
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3469
!
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  3470
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3471
displayString
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3472
    "return a string for displaying in a view (as in inspector).
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3473
     The output radix is usually 10, but can be changed by setting
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3474
     DefaultDisplayRadix (see Integer>>displayRadix:)"
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3475
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 52
diff changeset
  3476
    (DefaultDisplayRadix isNil or:[DefaultDisplayRadix == 10]) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  3477
	^ self printString
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 52
diff changeset
  3478
    ].
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3479
    ^ self radixPrintStringRadix:DefaultDisplayRadix
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3480
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3481
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3482
     Integer displayRadix:16. 12345
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3483
     Integer displayRadix:2.  12345
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3484
     Integer displayRadix:10. 12345
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3485
    "
49
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3486
!
f1c2d75f2eb6 *** empty log message ***
claus
parents: 44
diff changeset
  3487
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3488
errorPrintHex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3489
    "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
  3490
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3491
     (self printStringRadix:16) errorPrint
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3492
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3493
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3494
hexPrintString
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3495
    "return a hex string representation of the receiver"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3496
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3497
    ^ self printStringRadix:16
3874
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  3498
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  3499
    "
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  3500
     127 hexPrintString
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  3501
     -1 hexPrintString
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  3502
    "
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  3503
a04715e25340 comment
Claus Gittinger <cg@exept.de>
parents: 3683
diff changeset
  3504
    "Modified: / 11.10.1998 / 01:15:43 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3505
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3506
2408
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3507
hexPrintString:size
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3508
    "return a hex string representation of the receiver,
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3509
     padded to size characters"
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3510
5799
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3511
"/    ^ (self printStringRadix:16) leftPaddedTo:size with:$0
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3512
    ^ self printStringRadix:16 size:size fill:$0
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3513
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3514
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3515
     12345 hexPrintString:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3516
     123 hexPrintString:4
5799
547c417b23cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5782
diff changeset
  3517
    "
2408
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3518
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3519
    "Created: 18.2.1997 / 13:32:33 / cg"
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3520
!
fd31506f31ef added #hexPrintString:
Claus Gittinger <cg@exept.de>
parents: 2141
diff changeset
  3521
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3522
printHex
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3523
    "print the receiver as a hex number on the standard output stream"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3524
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3525
     (self printStringRadix:16) print
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3526
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3527
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3528
printOn:aStream
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3529
    "append a printed description of the receiver to aStream"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3530
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3531
    self printOn:aStream base:10
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3532
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3533
    "Modified: / 20.1.1998 / 14:10:45 / stefan"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3534
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3535
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4424
diff changeset
  3536
printOn:aStream base:b
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3537
    "return a string representation of the receiver in the specified
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3538
     radix (without the initial XXr)"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3539
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3540
    ^ self printOn:aStream base:b showRadix:false
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3541
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3542
    "
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3543
     10 printOn:Transcript base:3
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3544
     31 printOn:Transcript base:3
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3545
     -20 printOn:Transcript base:16
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3546
     -20 printOn:Transcript base:10
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3547
     3000 factorial printOn:Transcript base:10
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3548
    "
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3549
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3550
    "Modified: / 20.1.1998 / 18:05:02 / stefan"
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3551
    "Modified: / 7.9.2001 / 13:52:17 / cg"
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3552
!
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3553
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3554
printOn:aStream base:b showRadix:showRadix
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3555
    "append a string representation of the receiver in the specified numberBase to aStream
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3556
     (if showRadix is true, with initial XXr)
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3557
     The radix argument should be between 2 and 36."
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3558
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4424
diff changeset
  3559
    |base num s divMod mod r r2 r4 nD numN|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3560
4522
29a6625dc7b1 error: vs. error:mayProceed:
Claus Gittinger <cg@exept.de>
parents: 4424
diff changeset
  3561
    base := b.
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3562
    (base isInteger and:[ base between:2 and:36 ]) ifFalse:[
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3563
        ConversionError raiseRequestErrorString:' - invalid base'.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3564
        base := 10.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 52
diff changeset
  3565
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 52
diff changeset
  3566
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3567
    showRadix ifTrue:[
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3568
        base printOn:aStream.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3569
        aStream nextPut:$r.
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3570
    ].
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3571
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3572
    (self = 0) ifTrue:[aStream nextPut:$0. ^ self].
11508
d1ed91142715 prime stuff printing fix.
Claus Gittinger <cg@exept.de>
parents: 11505
diff changeset
  3573
    (self negative) ifTrue:[
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3574
        aStream nextPut:$- .
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3575
        num := self negated.
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3576
    ] ifFalse:[
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3577
        num := self.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3578
    ].
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3579
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3580
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3581
     claus: changed it from a recursive algorithm;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3582
     (it used to trigger stack-overflow exceptions when printing
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3583
      3000 factorial ...)
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3584
    "
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3585
"/    leftPart := num // base.
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3586
"/    (leftPart ~= 0) ifTrue:[
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3587
"/        leftPart printOn:aStream base:base.
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3588
"/        aStream nextPut:(Character digitValue:(num \\ base).
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3589
"/        ^ self
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3590
"/    ].
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3591
"/    aStream nextPut:(Character digitValue:num).
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  3592
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  3593
    "/ 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
  3594
    "/ 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
  3595
    "/ 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
  3596
    "/ 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
  3597
    "/ 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
  3598
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3599
    r2 := base*base.   "/ radix^2
3138
1cd38a2d1924 oops - printString
ca
parents: 3136
diff changeset
  3600
    r4 := r2*r2.             "/ radix^4
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3601
    base <= 10 ifTrue:[
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3602
        r := r4*r2.        "/ radix^6
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3603
        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
  3604
    ] ifFalse:[
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3605
        r := r4*base.    "/ radix^5
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3606
        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
  3607
    ].
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  3608
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3609
    "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
  3610
     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
  3611
     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
  3612
    "
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3613
    s := WriteStream on:(String new:((num highBit // base highBit - 1) + 1)).
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3614
3121
91de0211651c even faster largeInt printString, by doing it in bigger junks (8digits a time)
Claus Gittinger <cg@exept.de>
parents: 3060
diff changeset
  3615
    [num >= r] whileTrue:[
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3616
        "/
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3617
        "/ chop off nD digits.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3618
        "/
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3619
        divMod := num divMod:r.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3620
        num := divMod at:1.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3621
        numN := divMod at:2.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3622
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3623
        "/ process them
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3624
        nD timesRepeat:[
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3625
            divMod := numN divMod:base.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3626
            numN := divMod at:1.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3627
            mod := divMod at:2.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3628
            s nextPut:(Character digitValue:mod).
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3629
        ].
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  3630
    ].
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  3631
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3632
    [num ~= 0] whileTrue:[
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3633
        divMod := num divMod:base.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3634
        num := divMod at:1.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3635
        mod := divMod at:2.
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3636
        s nextPut:(Character digitValue:mod).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3637
    ].
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3638
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3639
    aStream nextPutAll:(s contents reverse).
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3640
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3641
    "
17795
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3642
        3000 factorial printOn:Transcript base:10
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3643
        10 printOn:Transcript base:3
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3644
        31 printOn:Transcript base:3
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3645
        -20  printOn:Transcript base:16
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3646
        -20  printOn:Transcript base:10
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3647
        Time millisecondsToRun:[10000 factorial printString]   7650
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3648
    "
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3649
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3650
    "Modified: / 20-01-1998 / 18:05:02 / stefan"
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3651
    "Created: / 07-09-2001 / 13:51:33 / cg"
569eec7576f1 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17780
diff changeset
  3652
    "Modified: / 02-08-2010 / 12:24:14 / cg"
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3653
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3654
7173
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3655
printOn:aStream base:baseInteger size:sz fill:fillCharacter
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3656
    "print a string representation of the receiver in the specified
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3657
     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
  3658
     its size as specified in sz."
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3659
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3660
    |stream string actualSize|
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3661
17728
bbc5fa73dfab Merged with trunk r10466
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17711
diff changeset
  3662
    stream := WriteStream on:(String new:sz).
7173
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3663
    self printOn:stream base:baseInteger showRadix:false.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3664
    string := stream contents.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3665
    actualSize := string size.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3666
    actualSize < sz ifTrue:[
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  3667
	aStream next:sz-actualSize put:fillCharacter.
7173
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3668
    ].
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3669
    aStream nextPutAll:string.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3670
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3671
    "
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3672
     1024 printOn:Transcript base:16 size:4 fill:$0
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3673
     1024 printOn:Transcript base:2 size:16 fill:$.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3674
     1024 printOn:Transcript base:16 size:8 fill:Character space.
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3675
    "
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3676
!
a1d65d39dbfb *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7155
diff changeset
  3677
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3678
printOn:aStream radix:base
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3679
    "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
  3680
     The receiver is printed in radix base (instead of the default, 10).
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3681
     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
  3682
8897
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
  3683
    <resource: #obsolete>
da8d205a93aa Mark obsolete method as obsolete
Stefan Vogel <sv@exept.de>
parents: 8892
diff changeset
  3684
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3685
    self printOn:aStream base:base
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3686
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3687
    "Modified: / 20.1.1998 / 14:10:45 / stefan"
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3688
    "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
  3689
!
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3690
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3691
printRomanOn:aStream
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3692
    "print the receiver as roman number to the receiver, aStream.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3693
     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
  3694
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3695
    ^ self printRomanOn:aStream naive:false
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3696
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3697
    "
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3698
     1 to:10 do:[:i | i printRomanOn:Transcript. Transcript cr.].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3699
     1999 printRomanOn:Transcript. Transcript cr.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3700
     Date today year printRomanOn:Transcript. Transcript cr.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3701
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3702
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3703
    "test all between 1 and 9999:
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3704
      1 to:9999 do:[:n |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3705
	|romanString|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3706
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3707
	romanString := String streamContents:[:stream | n printRomanOn:stream].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3708
	(Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3709
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3710
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3711
!
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3712
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3713
printRomanOn:aStream naive:naive
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3714
    "print the receiver as roman number to the receiver, aStream.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3715
     The naive argument controls if the conversion is
6682
9a97f4deb836 more on roman numbers
Claus Gittinger <cg@exept.de>
parents: 6673
diff changeset
  3716
     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
  3717
     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
  3718
     The naive version is often used for page numbers in documents."
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3719
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3720
    |restValue spec|
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3721
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3722
    restValue := self.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3723
    restValue > 0 ifFalse:[self error:'negative roman'].
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3724
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3725
    naive ifTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3726
	spec := #(
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3727
		" value string repeat "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3728
		   1000 'M'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3729
		    500 'D'    false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3730
		    100 'C'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3731
		     50 'L'    false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3732
		     10 'X'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3733
		      5 'V'    false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3734
		      1 'I'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3735
		 ).
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3736
    ] ifFalse:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3737
	spec := #(
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3738
		" value string repeat "
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3739
		   1000 'M'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3740
		    900 'CM'   false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3741
		    500 'D'    false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3742
		    400 'CD'   false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3743
		    100 'C'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3744
		     90 'XC'   false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3745
		     50 'L'    false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3746
		     40 'XL'   false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3747
		     10 'X'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3748
		      9 'IX'   false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3749
		      5 'V'    false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3750
		      4 'IV'   false
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3751
		      1 'I'    true
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3752
		 ).
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3753
    ].
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3754
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3755
    spec
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3756
	inGroupsOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3757
	do:[:rValue :rString :repeatFlag |
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3758
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3759
	    [
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3760
		(restValue >= rValue) ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3761
		    aStream nextPutAll:rString.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3762
		    restValue := restValue - rValue.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3763
		].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3764
	    ] doWhile:[ repeatFlag and:[ restValue >= rValue] ].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3765
	].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3766
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3767
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3768
     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
  3769
     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
  3770
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3771
     1999 printRomanOn:Transcript. Transcript cr.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3772
     Date today year printRomanOn:Transcript. Transcript cr.
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3773
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3774
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3775
    "test all between 1 and 9999:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3776
      1 to:9999 do:[:n |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3777
	|romanString|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3778
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3779
	romanString := String streamContents:[:stream | n printRomanOn:stream naive:false].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3780
	(Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6673
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3781
     ]
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3782
    "
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3783
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3784
    "test naive all between 1 and 9999:
34547f06c5c7 roman numbers revisited
Claus Gittinger <cg@exept.de>
parents: 6640
diff changeset
  3785
      1 to:9999 do:[:n |
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3786
	|romanString|
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3787
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3788
	romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3789
	(Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3790
     ]
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3791
    "
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3792
!
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3793
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3794
printStringRadix:base
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3795
    "return a string representation of the receiver in the specified
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3796
     base; does NOT prepend XXr to the string.
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3797
     See also: radixPrintStringRadix:
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3798
               printOn:base:showRadix:"
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3799
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3800
    ^ self printStringRadix:base showRadix:false
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3801
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3802
    "Created: / 19-01-1998 / 17:20:58 / stefan"
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3803
    "Modified: / 20-01-1998 / 14:10:54 / stefan"
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3804
    "Modified: / 23-09-2011 / 13:59:36 / cg"
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3805
!
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3806
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3807
printStringRadix:base showRadix:showRadixBoolean
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3808
    "return a string representation of the receiver in the specified
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3809
     base; does NOT prepend XXr to the string.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3810
     See also: radixPrintStringRadix:
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3811
               printOn:base:showRadix:"
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3812
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3813
    |s|
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3814
7685
535a69a7cd69 String new -> uninitializedNew: / basicNew:
Claus Gittinger <cg@exept.de>
parents: 7551
diff changeset
  3815
    s := WriteStream on:(String basicNew:20).
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3816
    self printOn:s base:base showRadix:showRadixBoolean.
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3817
    ^ s contents
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3818
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3819
    "Created: / 23-09-2011 / 13:59:19 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3820
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3821
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3822
printStringRadix:aRadix size:sz fill:fillCharacter
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3823
    "return a string representation of the receiver in the specified
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3824
     radix. The string is padded on the left with fillCharacter to make
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3825
     its size as specified in sz."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3826
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  3827
    |s actualSize|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3828
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3829
    s := self printStringRadix:aRadix.
2951
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  3830
    actualSize := s size.
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  3831
    actualSize < sz ifTrue:[
256e90eee7f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2816
diff changeset
  3832
	s := ((String new:(sz - actualSize)) atAllPut:fillCharacter) , s
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3833
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3834
    ^ s
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3835
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3836
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3837
     1024 printStringRadix:16 size:4 fill:$0
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3838
     1024 printStringRadix:2 size:16 fill:$.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3839
     1024 printStringRadix:16 size:8 fill:(Character space)
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  3840
    "
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  3841
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  3842
5988
Claus Gittinger <cg@exept.de>
parents: 5882
diff changeset
  3843
radixPrintStringRadix:radix
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3844
    "return a string representation of the receiver in the specified
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3845
     base; prepend XXr to the string"
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3846
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3847
    ^ self printStringRadix:radix showRadix:true
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  3848
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3849
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3850
     31 radixPrintStringRadix:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3851
     31 radixPrintStringRadix:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3852
     31 radixPrintStringRadix:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3853
     31 radixPrintStringRadix:16
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3854
     31 radixPrintStringRadix:36
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3855
    "
3188
301eaf46b9e4 Use #printOn: instead of #printString as base method.
Stefan Vogel <sv@exept.de>
parents: 3162
diff changeset
  3856
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3857
    "Created: / 19-01-1998 / 17:38:00 / stefan"
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3858
    "Modified: / 20-01-1998 / 14:11:03 / stefan"
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3859
    "Modified: / 23-09-2011 / 14:00:02 / cg"
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3860
!
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3861
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3862
romanPrintString
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3863
    "return a roman number representation of the receiver as a string"
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3864
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3865
    ^ String streamContents:[:stream | self printRomanOn:stream].
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3866
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3867
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3868
     1999 romanPrintString.
6635
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3869
     Date today year romanPrintString.
3b5525d83d5d roman numbers
Claus Gittinger <cg@exept.de>
parents: 6534
diff changeset
  3870
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3871
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3872
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3873
!Integer methodsFor:'queries'!
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  3874
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3875
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
  3876
    "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
  3877
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3878
    self subclassResponsibility
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3879
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3880
    "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
  3881
     concrete subclasses."
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  3882
6055
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3883
"/    |num count|
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3884
"/
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3885
"/    num := self.
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3886
"/    count := n.
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3887
"/    [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
  3888
"/        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
  3889
"/        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
  3890
"/    ].
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3891
"/    ^ num \\ 256
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  3892
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  3893
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3894
     16r44332211 digitAt:1
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3895
     16r44332211 digitAt:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3896
     16r44332211 digitAt:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3897
     16r44332211 digitAt:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3898
     16r44332211 digitAt:5
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3899
     16r00332211 digitAt:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3900
     16r00332211 digitAt:5
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  3901
    "
6055
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3902
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3903
    "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
  3904
!
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3905
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3906
digitByteAt:n
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3907
    "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
  3908
     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
  3909
     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
  3910
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3911
    self subclassResponsibility
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3912
e4d5016bad38 no need for #digitAt: here - it ought to be redefined in ALL
Claus Gittinger <cg@exept.de>
parents: 5988
diff changeset
  3913
    "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
  3914
    "Modified: / 26.9.2001 / 21:20:19 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3915
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3916
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3917
digitLength
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3918
    "return the number of bytes needed for the binary representation
2816
62edd11b5e66 commentary
Claus Gittinger <cg@exept.de>
parents: 2794
diff changeset
  3919
     of the receiver.
62edd11b5e66 commentary
Claus Gittinger <cg@exept.de>
parents: 2794
diff changeset
  3920
     This method is redefined in concrete classes - the fallback here is
62edd11b5e66 commentary
Claus Gittinger <cg@exept.de>
parents: 2794
diff changeset
  3921
     never really used."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3922
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3923
    ^ (self log:256) ceiling asInteger
2816
62edd11b5e66 commentary
Claus Gittinger <cg@exept.de>
parents: 2794
diff changeset
  3924
62edd11b5e66 commentary
Claus Gittinger <cg@exept.de>
parents: 2794
diff changeset
  3925
    "Modified: 31.7.1997 / 13:19:06 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3926
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3927
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3928
exponent
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3929
    "return what would be the normalized float's exponent if I were a float.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3930
     This is not for general use - it has been added for dolphin (soap) compatibility.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3931
     This assumes that the mantissa is normalized to
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3932
     0.5 .. 1.0 and the number's value is: mantissa * 2^exp"
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3933
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3934
    ^ self abs highBit
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3935
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3936
    "
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3937
     self assert:( 1.0 exponent = 1 exponent ).
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3938
     self assert:( 2.0 exponent = 2 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3939
     self assert:( 3.0 exponent = 3 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3940
     self assert:( 4.0 exponent = 4 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3941
     self assert:( 12345.0 exponent = 12345 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3942
     self assert:( 0.0 exponent = 0 exponent ).   
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3943
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3944
     self assert:( -1.0 exponent = -1 exponent ).
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3945
     self assert:( -2.0 exponent = -2 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3946
     self assert:( -3.0 exponent = -3 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3947
     self assert:( -4.0 exponent = -4 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3948
     self assert:( -12345.0 exponent = -12345 exponent ).  
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3949
    "
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3950
!
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  3951
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3952
isInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3953
    "return true, if the receiver is some kind of integer number"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3954
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  3955
    ^ true
3036
f2d332547db7 added #isPowerOf2
Claus Gittinger <cg@exept.de>
parents: 2951
diff changeset
  3956
!
f2d332547db7 added #isPowerOf2
Claus Gittinger <cg@exept.de>
parents: 2951
diff changeset
  3957
17900
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  3958
isLiteral
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  3959
    "return true, if the receiver can be used as a literal constant in ST syntax
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  3960
     (i.e. can be used in constant arrays)"
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  3961
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  3962
    ^ true
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  3963
!
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  3964
9134
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3965
isPowerOf:p
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3966
    "return true, if the receiver is a power of p"
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3967
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3968
    p == 2 ifTrue:[ ^ self isPowerOfTwo].
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3969
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3970
    "/ the following is a q&d hack, using existing code.
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3971
    ^ (Integer
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3972
	readFromString:(self printStringRadix:p)
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3973
	radix:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3974
	onError:-1) isPowerOfTwo
9134
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3975
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  3976
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3977
     16r0000000000000000 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3978
     16r0000004000000000 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3979
     16r0000004000000001 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3980
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3981
     16r0000000000000001 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3982
     16r0000000000000002 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3983
     16r0000000000000004 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3984
     16r0000000000000008 isPowerOf:2
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3985
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3986
     16r0000000000000001 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3987
     16r0000000000000002 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3988
     16r0000000000000004 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3989
     16r0000000000000008 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3990
     16r0000000000000010 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3991
     16r0000000000000020 isPowerOf:4
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3992
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3993
     3r0000000000000001 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3994
     3r0000000000000010 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3995
     3r0000000000000100 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3996
     3r0000000000001000 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3997
     3r0000000000001001 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3998
     3r0000000000002000 isPowerOf:3
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  3999
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4000
     10 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4001
     20 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4002
     100 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4003
     110 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4004
     200 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4005
     1000 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4006
     10000 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4007
     100000 isPowerOf:10
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4008
     100001 isPowerOf:10
9134
98d5bfd1cc51 +isPowerOf:
Claus Gittinger <cg@exept.de>
parents: 9126
diff changeset
  4009
 "
17900
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4010
!
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4011
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4012
isPowerOfTwo
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4013
    "return true, if the receiver is a power of 2"
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4014
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4015
    "redefined, because the hacker's algorithm in smallInt is much slower for large numbers"
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4016
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4017
    |maxBytes "{ Class: SmallInteger }"|
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4018
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4019
    maxBytes := self digitLength.
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4020
    (self digitAt:maxBytes) isPowerOfTwo ifFalse:[^ false].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4021
    1 to:maxBytes-1 do:[:byteIndex |
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4022
        (self digitAt:byteIndex) ~~ 0 ifTrue:[^ false].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4023
    ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4024
    ^ true
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4025
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4026
    "
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4027
     10000 factorial isPowerOfTwo  
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4028
     |n| n := 10000 factorial. Time millisecondsToRun:[1000 timesRepeat:[ n isPowerOfTwo]] 
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4029
    "
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4030
    "
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4031
     (2 raisedTo:10000) isPowerOfTwo  
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4032
     |n| n := (2 raisedTo:10000). Time millisecondsToRun:[1000 timesRepeat:[ n isPowerOfTwo]] 
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4033
    "
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4034
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4035
    "Modified: / 20-06-2011 / 12:43:05 / cg"
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4036
!
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4037
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4038
isPrime
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4039
    "return true if I am a prime Number.
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4040
     This is a q&d hack, which may need optimization if heavily used."
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4041
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4042
    |limit firstFewPrimes|
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4043
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4044
    self even ifTrue:[^ self == 2 ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4045
    self == 1 ifTrue:[^ false ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4046
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4047
    self <= (PrimeCache size*2) ifTrue:[
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4048
	^ PrimeCache at:self//2.
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4049
    ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4050
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4051
    limit := self sqrt.
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4052
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4053
    firstFewPrimes := self class primesUpTo2000.
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4054
    firstFewPrimes do:[:p |
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4055
	p > limit ifTrue:[^ true].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4056
	(self \\ p) == 0 ifTrue:[ ^ false ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4057
    ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4058
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4059
    (firstFewPrimes last+2) to:limit by:2 do:[:i |
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4060
	(self \\ i) == 0 ifTrue:[ ^ false ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4061
    ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4062
    ^ true
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4063
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4064
    "
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4065
     Integer primesUpTo:1000
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4066
     (1 to:1000000) count:[:n | n isPrime] 78498
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4067
     Time millisecondsToRun:[ (1 to:1000000) count:[:n | n isPrime]] 1295   w.o firstFewPrimes
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4068
     Time millisecondsToRun:[ (1 to:1000000) count:[:n | n isPrime]] 936    with firstFewPrimes (less tests)
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4069
     Time millisecondsToRun:[ (1 to:1000000) count:[:n | n isPrime]] 343    with primeCache
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4070
    "
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4071
!
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4072
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4073
nextPrime
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4074
    "return the next prime after the receiver"
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4075
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4076
    |num|
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4077
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4078
    num := self + 1.
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4079
    num even ifTrue:[
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4080
	num == 2 ifTrue:[^ num].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4081
	num := num + 1
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4082
    ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4083
    [num isPrime] whileFalse:[
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4084
	num := num + 2
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4085
    ].
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4086
    ^ num
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4087
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4088
    "
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4089
     1 nextPrime
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4090
     22 nextPrime
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4091
     37 nextPrime
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4092
     36 nextPrime
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4093
     3456737 nextPrime
b9614a1cf804 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
  4094
    "
17910
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4095
!
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4096
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4097
parityOdd
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4098
    "return true, if an odd number of bits are set in the receiver, false otherwise.
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4099
     (i.e. true for odd parity)
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4100
     Undefined for negative values (smalltalk does not require the machine to use 2's complement)"
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4101
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4102
    ^ self bitCount odd
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4103
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4104
    "
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4105
     0 parityOdd    
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4106
     1 parityOdd    
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4107
     2 parityOdd    
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4108
     4 parityOdd    
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4109
     5 parityOdd    
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4110
     7 parityOdd    
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4111
     33 parityOdd   
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4112
     6 parityOdd    
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4113
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4114
     1 to:1000000 do:[:n |
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4115
        self assert:(n parityOdd = ((n printStringRadix:2) occurrencesOf:$1) odd).
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4116
     ]
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4117
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4118
     0 to:255 do:[:n |
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4119
        |p|
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4120
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4121
        p := 
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4122
            (((((((((n rightShift: 7) 
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4123
            bitXor: (n rightShift: 6)) 
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4124
                bitXor: (n rightShift: 5))
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4125
                    bitXor: (n rightShift: 4))
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4126
                        bitXor: (n rightShift: 3))
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4127
                            bitXor: (n rightShift: 2))
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4128
                                bitXor: (n rightShift: 1))
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4129
                                    bitXor: n) bitAnd:1) == 1.
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4130
        self assert:(n parityOdd = p).
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4131
     ]
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4132
    "
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4133
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17900
diff changeset
  4134
    "Created: / 09-01-2012 / 17:18:06 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4135
! !
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  4136
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4137
!Integer methodsFor:'special modulu arithmetic'!
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4138
17742
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4139
add_32:anInteger
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4140
    "return a C-semantic 32bit sum of the receiver and the argument. 
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4141
     Both must be either Small- or LargeIntegers.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4142
     Returns a signed 32bit number.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4143
     This (nonstandard) specialized method is provided to allow simulation of
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4144
     modulu operations with C semantics."
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4145
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4146
%{  /* NOCONTEXT */
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4147
    int val1, val2, rslt;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4148
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4149
    if (__isSmallInteger(self)) {
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4150
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4151
    } else {
17742
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4152
        val1 = __longIntVal(self);
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4153
        if (!val1) goto bad;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4154
    }
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4155
    if (__isSmallInteger(anInteger)) {
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4156
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4157
    } else {
17742
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4158
        val2 = __longIntVal(anInteger);
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4159
        if (!val2) goto bad;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4160
    }
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4161
    rslt = val1 + val2;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4162
    RETURN(__MKINT(rslt));
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4163
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4164
  bad: ;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4165
%}.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4166
    self primitiveFailed.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4167
!
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4168
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4169
add_32u:anInteger
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4170
    "return a C-semantic 32bit unsigned sum of the receiver and the argument. 
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4171
     Both must be either Small- or LargeIntegers.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4172
     Returns an unsigned 32bit number.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4173
     This (nonstandard) specialized method is provided to allow simulation of
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4174
     modulu operations with C semantics."
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4175
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4176
%{  /* NOCONTEXT */
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4177
    int val1, val2, rslt;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4178
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4179
    if (__isSmallInteger(self)) {
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4180
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4181
    } else {
17742
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4182
        val1 = __longIntVal(self);
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4183
        if (!val1) goto bad;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4184
    }
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4185
    if (__isSmallInteger(anInteger)) {
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4186
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4187
    } else {
17742
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4188
        val2 = __longIntVal(anInteger);
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4189
        if (!val2) goto bad;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4190
    }
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4191
    rslt = val1 + val2;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4192
    RETURN(__MKUINT((unsigned)rslt));
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4193
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4194
  bad: ;
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4195
%}.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4196
    self primitiveFailed.
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4197
!
3fef0ed4c2d5 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17736
diff changeset
  4198
17864
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4199
mul_32:anInteger
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4200
    "return a C-semantic 32bit product of the receiver and the argument. 
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4201
     Both must be either Small- or LargeIntegers.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4202
     Returns a signed 32bit number.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4203
     This (nonstandard) specialized method is provided to allow simulation of
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4204
     modulu operations with C semantics."
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4205
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4206
%{  /* NOCONTEXT */
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4207
    int val1, val2, rslt;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4208
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4209
    if (__isSmallInteger(self)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4210
        val1 = __intVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4211
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4212
        val1 = __longIntVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4213
        if (!val1) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4214
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4215
    if (__isSmallInteger(anInteger)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4216
        val2 = __intVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4217
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4218
        val2 = __longIntVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4219
        if (!val2) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4220
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4221
    rslt = val1 * val2;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4222
    RETURN(__MKINT(rslt));
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4223
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4224
  bad: ;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4225
%}.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4226
    self primitiveFailed.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4227
!
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4228
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4229
mul_32u:anInteger
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4230
    "return a C-semantic 32bit unsigned product of the receiver and the argument. 
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4231
     Both must be either Small- or LargeIntegers.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4232
     Returns an unsigned 32bit number.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4233
     This (nonstandard) specialized method is provided to allow simulation of
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4234
     modulu operations with C semantics."
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4235
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4236
%{  /* NOCONTEXT */
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4237
    int val1, val2, rslt;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4238
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4239
    if (__isSmallInteger(self)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4240
        val1 = __intVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4241
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4242
        val1 = __longIntVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4243
        if (!val1) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4244
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4245
    if (__isSmallInteger(anInteger)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4246
        val2 = __intVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4247
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4248
        val2 = __longIntVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4249
        if (!val2) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4250
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4251
    rslt = val1 * val2;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4252
    RETURN(__MKUINT((unsigned)rslt));
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4253
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4254
  bad: ;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4255
%}.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4256
    self primitiveFailed.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4257
!
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4258
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4259
sub_32:anInteger
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4260
    "return a C-semantic 32bit difference of the receiver and the argument. 
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4261
     Both must be either Small- or LargeIntegers.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4262
     Returns a signed 32bit number.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4263
     This (nonstandard) specialized method is provided to allow simulation of
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4264
     modulu operations with C semantics."
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4265
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4266
%{  /* NOCONTEXT */
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4267
    int val1, val2, rslt;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4268
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4269
    if (__isSmallInteger(self)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4270
        val1 = __intVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4271
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4272
        val1 = __longIntVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4273
        if (!val1) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4274
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4275
    if (__isSmallInteger(anInteger)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4276
        val2 = __intVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4277
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4278
        val2 = __longIntVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4279
        if (!val2) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4280
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4281
    rslt = val1 - val2;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4282
    RETURN(__MKINT(rslt));
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4283
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4284
  bad: ;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4285
%}.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4286
    self primitiveFailed.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4287
!
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4288
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4289
sub_32u:anInteger
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4290
    "return a C-semantic 32bit unsigned difference of the receiver and the argument. 
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4291
     Both must be either Small- or LargeIntegers.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4292
     Returns an unsigned 32bit number.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4293
     This (nonstandard) specialized method is provided to allow simulation of
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4294
     modulu operations with C semantics."
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4295
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4296
%{  /* NOCONTEXT */
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4297
    int val1, val2, rslt;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4298
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4299
    if (__isSmallInteger(self)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4300
        val1 = __intVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4301
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4302
        val1 = __longIntVal(self);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4303
        if (!val1) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4304
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4305
    if (__isSmallInteger(anInteger)) {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4306
        val2 = __intVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4307
    } else {
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4308
        val2 = __longIntVal(anInteger);
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4309
        if (!val2) goto bad;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4310
    }
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4311
    rslt = val1 - val2;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4312
    RETURN(__MKUINT((unsigned)rslt));
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4313
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4314
  bad: ;
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4315
%}.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4316
    self primitiveFailed.
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4317
! !
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4318
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4319
!Integer methodsFor:'special modulu bit operators'!
e6010e48defb Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
  4320
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4321
bitAnd_32:anInteger
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4322
    "return a C-semantic 32bit locical-and of the receiver and
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4323
     the argument. Both must be either Small- or LargeIntegers.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4324
     Returns a signed 32bit number.
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4325
     This (nonstandard) specialized method is provided to allow simulation of
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4326
     bit operations with C semantics."
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4327
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4328
%{  /* NOCONTEXT */
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4329
    int val1, val2, rslt;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4330
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4331
    if (__isSmallInteger(self)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4332
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4333
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4334
        val1 = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4335
        if (!val1) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4336
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4337
    if (__isSmallInteger(anInteger)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4338
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4339
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4340
        val2 = __longIntVal(anInteger);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4341
        if (!val2) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4342
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4343
    rslt = val1 & val2;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4344
    RETURN(__MKINT(rslt));
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4345
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4346
  bad: ;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4347
%}.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4348
    self primitiveFailed.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4349
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4350
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4351
bitAnd_32u:anInteger
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4352
    "return a C-semantic 32bit locical-and of the receiver and
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4353
     the argument. Both must be either Small- or LargeIntegers.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4354
     Returns an unsigned 32bit number.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4355
     This (nonstandard) specialized method is provided to allow simulation of
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4356
     bit operations with C semantics."
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4357
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4358
%{  /* NOCONTEXT */
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4359
    int val1, val2, rslt;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4360
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4361
    if (__isSmallInteger(self)) {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4362
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4363
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4364
        val1 = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4365
        if (!val1) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4366
    }
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4367
    if (__isSmallInteger(anInteger)) {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4368
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4369
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4370
        val2 = __longIntVal(anInteger);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4371
        if (!val2) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4372
    }
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4373
    rslt = val1 & val2;
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4374
    RETURN(__MKUINT(rslt));
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4375
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4376
  bad: ;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4377
%}.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4378
    self primitiveFailed.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4379
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4380
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4381
bitInvert_32
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4382
    "return a C-semantic 32bit complement of the receiver,
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4383
     which must be either Small- or LargeIntegers.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4384
     Returns a signed 32bit number.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4385
     This (nonstandard) specialized method is provided to allow simulation of
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4386
     bit operations with C semantics."
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4387
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4388
%{  /* NOCONTEXT */
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4389
    int val, rslt;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4390
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4391
    if (__isSmallInteger(self)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4392
        val = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4393
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4394
        val = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4395
        if (!val) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4396
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4397
    rslt = ~val;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4398
    RETURN(__MKINT(rslt));
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4399
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4400
  bad: ;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4401
%}.
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4402
    self primitiveFailed.
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4403
!
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4404
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4405
bitInvert_32u
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4406
    "return a C-semantic 32bit complement of the receiver,
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4407
     which must be either Small- or LargeIntegers.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4408
     Returns an unsigned 32bit number.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4409
     This (nonstandard) specialized method is provided to allow simulation of
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4410
     bit operations with C semantics."
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4411
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4412
%{  /* NOCONTEXT */
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4413
    int val, rslt;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4414
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4415
    if (__isSmallInteger(self)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4416
        val = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4417
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4418
        val = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4419
        if (!val) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4420
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4421
    rslt = ~val;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4422
    RETURN(__MKUINT(rslt));
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4423
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4424
  bad: ;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4425
%}.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4426
    self primitiveFailed.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4427
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4428
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4429
bitOr_32:anInteger
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4430
    "return a C-semantic 32bit locical-or of the receiver and
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4431
     the argument. Both must be either Small- or LargeIntegers.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4432
     Returns a signed 32bit number.
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4433
     This (nonstandard) specialized method is provided to allow simulation of
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4434
     bit operations with C semantics."
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4435
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4436
%{  /* NOCONTEXT */
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4437
    int val1, val2, rslt;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4438
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4439
    if (__isSmallInteger(self)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4440
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4441
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4442
        val1 = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4443
        if (!val1) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4444
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4445
    if (__isSmallInteger(anInteger)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4446
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4447
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4448
        val2 = __longIntVal(anInteger);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4449
        if (!val2) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4450
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4451
    rslt = val1 | val2;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4452
    RETURN(__MKINT(rslt));
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4453
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4454
  bad: ;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4455
%}.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4456
    self primitiveFailed.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4457
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4458
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4459
bitOr_32u:anInteger
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4460
    "return a C-semantic 32bit locical-or of the receiver and
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4461
     the argument. Both must be either Small- or LargeIntegers.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4462
     Returns an unsigned 32bit number.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4463
     This (nonstandard) specialized method is provided to allow simulation of
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4464
     bit operations with C semantics."
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4465
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4466
%{  /* NOCONTEXT */
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4467
    int val1, val2, rslt;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4468
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4469
    if (__isSmallInteger(self)) {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4470
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4471
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4472
        val1 = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4473
        if (!val1) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4474
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4475
    if (__isSmallInteger(anInteger)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4476
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4477
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4478
        val2 = __longIntVal(anInteger);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4479
        if (!val2) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4480
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4481
    rslt = val1 | val2;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4482
    RETURN(__MKUINT(rslt));
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4483
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4484
  bad: ;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4485
%}.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4486
    self primitiveFailed.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4487
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4488
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4489
bitXor_32:anInteger
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4490
    "return a C-semantic 32bit locical-xor of the receiver and
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4491
     the argument. Both must be either Small- or LargeIntegers.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4492
     Returns a signed 32bit number.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4493
     This (nonstandard) specialized method is provided to allow simulation of
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4494
     bit operations with C semantics."
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4495
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4496
%{  /* NOCONTEXT */
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4497
    int val1, val2, rslt;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4498
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4499
    if (__isSmallInteger(self)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4500
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4501
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4502
        val1 = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4503
        if (!val1) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4504
    }
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4505
    if (__isSmallInteger(anInteger)) {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4506
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4507
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4508
        val2 = __longIntVal(anInteger);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4509
        if (!val2) goto bad;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4510
    }
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4511
    rslt = val1 ^ val2;
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4512
    RETURN(__MKINT(rslt));
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4513
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4514
  bad: ;
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4515
%}.
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4516
    self primitiveFailed.
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4517
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4518
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4519
bitXor_32u:anInteger
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4520
    "return a C-semantic 32bit locical-xor of the receiver and
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4521
     the argument. Both must be either Small- or LargeIntegers.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4522
     Returns an unsigned 32bit number.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4523
     This (nonstandard) specialized method is provided to allow simulation of
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4524
     bit operations with C semantics."
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4525
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4526
%{  /* NOCONTEXT */
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4527
    int val1, val2, rslt;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4528
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4529
    if (__isSmallInteger(self)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4530
        val1 = __intVal(self);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4531
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4532
        val1 = __longIntVal(self);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4533
        if (!val1) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4534
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4535
    if (__isSmallInteger(anInteger)) {
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4536
        val2 = __intVal(anInteger);
17747
f978415ba3d3 Merged with trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17742
diff changeset
  4537
    } else {
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4538
        val2 = __longIntVal(anInteger);
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4539
        if (!val2) goto bad;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4540
    }
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4541
    rslt = val1 ^ val2;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4542
    RETURN(__MKUINT(rslt));
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4543
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4544
  bad: ;
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4545
%}.
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4546
    self primitiveFailed.
2458
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4547
! !
4f29a9dd12fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2457
diff changeset
  4548
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  4549
!Integer methodsFor:'tracing'!
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  4550
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4653
diff changeset
  4551
traceInto:aRequestor level:level from:referrer
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  4552
    "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
  4553
4682
4158042a9c8c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4653
diff changeset
  4554
    ^ aRequestor traceInteger:self level:level from:referrer
4653
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  4555
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  4556
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  4557
! !
b3d38149fbde added #hasSharedInstances & tracing support
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
  4558
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4559
!Integer methodsFor:'truncation & rounding'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4560
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4561
ceiling
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4562
    "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
  4563
     For integers, this is the receiver itself."
345
claus
parents: 328
diff changeset
  4564
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4565
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4566
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4567
    "Modified: 18.7.1996 / 12:44:06 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4568
!
345
claus
parents: 328
diff changeset
  4569
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4570
compressed
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4571
    "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
  4572
     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
  4573
     zeros removed. This method is redefined in LargeInteger."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4574
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4575
    ^ self
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4576
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4577
    "Modified: 5.11.1996 / 14:07:41 / cg"
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  4578
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  4579
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4580
floor
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4581
    "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
  4582
     For integers, this is the receiver itself."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4583
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4584
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4585
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4586
    "Modified: 18.7.1996 / 12:44:00 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4587
!
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 159
diff changeset
  4588
1866
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4589
fractionPart
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4590
    "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
  4591
     (i.e. the receiver minus its truncated value)
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4592
     Since integers have no fraction, return 0 here."
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4593
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4594
    ^ 0
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4595
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4596
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4597
     1234.56789 fractionPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4598
     1.2345e6 fractionPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4599
     1000 fractionPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4600
     10000000000000000 fractionPart
1866
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4601
    "
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4602
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4603
    "Modified: 4.11.1996 / 20:27:44 / cg"
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4604
!
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4605
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4606
integerPart
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4607
    "return a number with value from digits before the decimal point.
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4608
     (i.e. the receivers truncated value)
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4609
     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
  4610
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4611
    ^ self
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4612
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4613
    "
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4614
     1234.56789 integerPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4615
     1.2345e6 integerPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4616
     1000 integerPart
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4617
     10000000000000000 integerPart
1866
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4618
    "
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4619
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4620
    "Modified: 4.11.1996 / 20:28:22 / cg"
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4621
!
225afe414934 added fractionPart & integerPart for protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1842
diff changeset
  4622
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4623
normalize
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4624
    "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
  4625
     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
  4626
     zeros removed.
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4627
     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
  4628
     renamed to #compressed for ST-80 compatibility."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4629
9261
275c3c6392ed mark obsolete method
Stefan Vogel <sv@exept.de>
parents: 9141
diff changeset
  4630
    <resource: #obsolete>
275c3c6392ed mark obsolete method
Stefan Vogel <sv@exept.de>
parents: 9141
diff changeset
  4631
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4632
    ^ self compressed
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4633
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1866
diff changeset
  4634
    "Modified: 5.11.1996 / 14:08:24 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4635
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4636
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4637
rounded
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4638
    "return the receiver rounded toward the next Integer -
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4639
     for integers this is the receiver itself."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4640
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4641
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4642
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4643
    "Modified: 18.7.1996 / 12:44:24 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4644
!
69
4564b6328136 *** empty log message ***
claus
parents: 54
diff changeset
  4645
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4646
truncated
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4647
    "return the receiver truncated towards zero as Integer
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4648
     for integers this is the receiver itself."
159
514c749165c3 *** empty log message ***
claus
parents: 132
diff changeset
  4649
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4650
    ^ self
1558
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4651
864bddaf96e8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  4652
    "Modified: 18.7.1996 / 12:44:33 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4653
! !
569
7134eb78cf48 readFrom:onError: can now also read from a string
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  4654
8394
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  4655
!Integer methodsFor:'visiting'!
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  4656
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  4657
acceptVisitor:aVisitor with:aParameter
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  4658
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  4659
    ^ aVisitor visitInteger:self with:aParameter
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  4660
! !
da194de43766 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8335
diff changeset
  4661
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4662
!Integer::ModuloNumber class methodsFor:'documentation'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4663
4803
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4664
copyright
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4665
"
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4666
 COPYRIGHT (c) 1999 by eXept Software AG
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4667
	      All Rights Reserved
4803
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4668
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4669
 This software is furnished under a license and may be used
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4670
 only in accordance with the terms of that license and with the
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4671
 inclusion of the above copyright notice.   This software may not
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4672
 be provided or otherwise made available to, or used by, any
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4673
 other person.  No title to or ownership of the software is
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4674
 hereby transferred.
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4675
"
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4676
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4677
!
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4678
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4679
documentation
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4680
"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4681
    This is a helper class to perform fast computation of the modulus.
4609
6a1819c7a743 comment
Claus Gittinger <cg@exept.de>
parents: 4522
diff changeset
  4682
    (with big numbers, this does make a difference)
4803
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4683
47355eb08e99 comment
Claus Gittinger <cg@exept.de>
parents: 4801
diff changeset
  4684
    WARNING: this does only work with numbers which have no common
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4685
	     divisor (which is true for cryptographic applications).
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4686
	     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
  4687
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4688
    [author:]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4689
	Stefan Vogel
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4690
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4691
    [see also:]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4692
	Integer SmallInteger LargeInsteger
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4693
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4694
    [instance variables:]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4695
	modulus       the modulus
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4696
	reciprocal    reciprocal of the modulus
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4697
	shift         shift count to cut off some bits
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4698
"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4699
!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4700
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4701
examples
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4702
"
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4703
								[exBegin]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4704
	17 asModuloNumber modulusOf:38
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4705
								[exEnd]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4706
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4707
								[exBegin]
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4708
	38 \\ 17
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4709
								[exEnd]
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4710
"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4711
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4712
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4713
!Integer::ModuloNumber class methodsFor:'instance creation'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4714
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4715
modulus:anInteger
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4716
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4717
    ^ self new modulus:anInteger
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4718
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4719
    "Created: / 3.5.1999 / 11:13:15 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4720
    "Modified: / 3.5.1999 / 11:18:37 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4721
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4722
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4723
!Integer::ModuloNumber methodsFor:'accessing'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4724
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4725
modulus
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4726
    "return the modulus"
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4727
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4728
    ^ modulus
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4729
!
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4730
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4731
modulus:n
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4732
    "set the modulus"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4733
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4734
    modulus := n.
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4735
    reciprocal := n integerReciprocal.
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4736
    shift := n highBit negated.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4737
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4738
    "Created: / 3.5.1999 / 10:02:39 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4739
    "Modified: / 3.5.1999 / 14:30:49 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4740
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4741
5238
f7a816a660a3 categories
Claus Gittinger <cg@exept.de>
parents: 5210
diff changeset
  4742
!Integer::ModuloNumber methodsFor:'arithmetic'!
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4743
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4744
modulusOf:aNumber
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4745
    "compute the aNumber modulo myself.
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4746
     The shortcut works only, if aNumber is < modulo * modulo
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4747
     (When doing arithmethic modulo something).
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4748
     Otherwise do it the long way"
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4749
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4750
    |e t cnt|
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4751
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4752
    "throw off low nbits(modulus)"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4753
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4754
    e := (aNumber bitShift:shift).
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4755
    e := e * reciprocal.
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4756
    e := (e bitShift:shift).
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4757
    e := e * modulus.
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4758
    e := aNumber - e.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4759
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4760
    "this subtract is done max 2 times"
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4761
    cnt := 2.
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4762
    [(t := e - modulus) >= 0] whileTrue:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4763
	e := t.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4764
	cnt == 0 ifTrue:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4765
	    "shortcut didn't work, do it the long way"
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4766
	    ^ e \\ modulus.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4767
	].
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4768
	cnt := cnt - 1.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4769
    ].
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4770
    ^ e.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4771
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4772
    "
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4773
     |m|
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4774
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4775
     m := self new modulus:7.
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4776
     m modulusOf:55.
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4777
    "
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4778
4971
aed19001173f Fix ModuloNumber for large numbers.
Stefan Vogel <sv@exept.de>
parents: 4952
diff changeset
  4779
    "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
  4780
     |m|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4781
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4782
     m := self new modulus:7.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4783
     m modulusOf:123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4784
    "
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4785
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4786
    "SLOW (using standard \\ operation):
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4787
     |m|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4788
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4789
     m := 123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4790
     Time millisecondsToRun:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4791
	1000 timesRepeat:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4792
	    874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658 \\ m
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4793
	]
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4794
     ]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4795
    "
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4796
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4797
    "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
  4798
     |m|
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4799
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4800
     m := self new modulus:123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4801
     Time millisecondsToRun:[
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4802
	1000 timesRepeat:[
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4803
	    m modulusOf:874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4804
	]
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4805
     ]
11587
deec7da18100 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11582
diff changeset
  4806
    "
4801
edf02501d5e2 comment about divisor-size vs. dividend-size in ModuloNumber
Claus Gittinger <cg@exept.de>
parents: 4682
diff changeset
  4807
4142
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4808
    "Modified: / 3.5.1999 / 14:30:32 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4809
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4810
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4811
!Integer::ModuloNumber methodsFor:'converting'!
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4812
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4813
asModuloNumber
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4814
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4815
    ^ self
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4816
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4817
    "Created: / 3.5.1999 / 14:48:27 / stefan"
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4818
! !
a881cc4bfaec Make ModuloNumber a private class.
Stefan Vogel <sv@exept.de>
parents: 4141
diff changeset
  4819
1842
b28609c73839 added divMod: for faster largeNumber printString generation.
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
  4820
!Integer class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4821
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  4822
version
17951
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  4823
    ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.265 2012/07/06 16:33:28 stefan Exp $'
17732
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4824
!
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4825
a1892eeca6c0 trunk merged into jv branch
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17728
diff changeset
  4826
version_CVS
17951
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  4827
    ^ '§Header: /cvs/stx/stx/libbasic/Integer.st,v 1.265 2012/07/06 16:33:28 stefan Exp §'
17865
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17864
diff changeset
  4828
!
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17864
diff changeset
  4829
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17864
diff changeset
  4830
version_SVN
17951
fa0e1d7467ea Merged with /CVS
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17938
diff changeset
  4831
    ^ '$Id: Integer.st 10824 2012-07-18 16:55:48Z vranyj1 $'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  4832
! !
6858
13919a7544b6 raisedToInteger pushed up
Claus Gittinger <cg@exept.de>
parents: 6682
diff changeset
  4833
17846
24edc476ac18 Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17845
diff changeset
  4834
Integer initialize!