Added libraries for math32
This commit is contained in:
neauoire
parent
3496a38606
commit
1a34fcefa9
|
|
@ -0,0 +1,137 @@
|
|||
( mandelbrot )
|
||||
|
||||
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV }
|
||||
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
|
||||
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
|
||||
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
|
||||
%AUTO-X { #01 .Screen/auto DEO }
|
||||
%NEXT-LINE { #0000 .Screen/x DEO2 .Screen/y DEI2k INC2 ROT DEO2 }
|
||||
|
||||
%XMIN { #de69 } ( -8601 )
|
||||
%XMAX { #0b33 } ( 2867 )
|
||||
%YMIN { #ecc7 } ( -4915 )
|
||||
%YMAX { #1333 } ( 4915 )
|
||||
%MAXI { #20 } ( 32 )
|
||||
%DX { XMAX XMIN -- #004f // } ( (XMAX-XMIN)/79 )
|
||||
%DY { YMAX YMIN -- #0018 // } ( (YMAX-YMIN)/24 )
|
||||
%X { .x LDZ2 } %Y { .y LDZ2 }
|
||||
%X2 { .x2 LDZ2 } %Y2 { .y2 LDZ2 }
|
||||
|
||||
%GTS2 { #8000 ++ SWP2 #8000 ++ << }
|
||||
|
||||
%HALT { #010f DEO }
|
||||
%EMIT { #18 DEO }
|
||||
%PRINT { ;print-str JSR2 #0a EMIT }
|
||||
%DEBUG { ;print-hex/byte JSR2 #0a EMIT }
|
||||
%DEBUG2 { ;print-hex JSR2 #0a EMIT }
|
||||
|
||||
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|
||||
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|
||||
|
||||
|0000 ( zero-page )
|
||||
|
||||
@x $2 @y $2
|
||||
@x2 $2 @y2 $2
|
||||
|
||||
|0100 ( -> )
|
||||
|
||||
( theme )
|
||||
#048c .System/r DEO2
|
||||
#048c .System/g DEO2
|
||||
#048c .System/b DEO2
|
||||
|
||||
#0280 .Screen/width DEO2 ( 640 )
|
||||
#01e0 .Screen/height DEO2 ( 480 )
|
||||
|
||||
#0000 .Screen/x DEO2
|
||||
#0000 .Screen/y DEO2
|
||||
|
||||
AUTO-X
|
||||
;draw-mandel JSR2
|
||||
|
||||
BRK
|
||||
|
||||
@draw-mandel ( -- )
|
||||
|
||||
YMAX YMIN
|
||||
&ver
|
||||
DUP2 ,&y STR2
|
||||
XMAX XMIN
|
||||
&hor
|
||||
DUP2 ,&x STR2
|
||||
#0000 DUP2 DUP2 DUP2 .x STZ2 .y STZ2 .x2 STZ2 .y2 STZ2
|
||||
MAXI #00
|
||||
&loop
|
||||
X Y ;smul2 JSR2 #0b SFT2 [ LIT2 &y $2 ] ++ .y STZ2
|
||||
X2 Y2 -- [ LIT2 &x $2 ] ++ .x STZ2
|
||||
X X ;smul2 JSR2 #0c SFT2 .x2 STZ2
|
||||
Y Y ;smul2 JSR2 #0c SFT2 .y2 STZ2
|
||||
X2 Y2 ++ >> #4000 ,&end JCN
|
||||
INC GTHk ,&loop JCN
|
||||
&end
|
||||
NIP POP #03 .Screen/pixel DEO
|
||||
DX ++ OVR2 OVR2 GTS2 ;&hor JCN2
|
||||
POP2 POP2
|
||||
NEXT-LINE
|
||||
DY ++ OVR2 OVR2 GTS2 ;&ver JCN2
|
||||
POP2 POP2
|
||||
|
||||
JMP2r
|
||||
|
||||
@print-hex ( value* -- )
|
||||
|
||||
SWP ,&byte JSR
|
||||
&byte ( byte -- )
|
||||
STHk #04 SFT ,&parse JSR #18 DEO
|
||||
STHr #0f AND ,&parse JSR #18 DEO
|
||||
JMP2r
|
||||
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r
|
||||
&above #57 ADD JMP2r
|
||||
|
||||
JMP2r
|
||||
|
||||
@smul2 ( a* b* -- c* )
|
||||
|
||||
OVR2 POP #80 AND #07 SFT STH
|
||||
OVR #80 AND #07 SFT STHr ADD #01 AND ,&sign STR
|
||||
#10 SFT2 #01 SFT2
|
||||
SWP2
|
||||
#10 SFT2 #01 SFT2
|
||||
MUL2
|
||||
,&sign LDR ,&flip JCN
|
||||
JMP2r
|
||||
&flip
|
||||
#0000 SWP2 --
|
||||
|
||||
JMP2r
|
||||
&sign $1
|
||||
|
||||
@sprites
|
||||
0000 0000 0000 0000 0000 0000 0000 0000
|
||||
0000 0018 1800 0000 0000 0000 0000 0000
|
||||
0000 183c 3c18 0000 0000 0000 0000 0000
|
||||
0018 3c7e 7e3c 1800 0000 0000 0000 0000
|
||||
183c 7eff ff7e 3c18 0000 0000 0000 0000
|
||||
3c7e ffff ffff 7e3c 0000 0000 0000 0000
|
||||
7eff ffff ffff ff7e 0000 0000 0000 0000
|
||||
ffff ffff ffff ffff 0000 0000 0000 0000
|
||||
ffff ffe7 e7ff ffff 0000 0018 1800 0000
|
||||
ffff e7c3 c3e7 ffff 0000 183c 3c18 0000
|
||||
ffe7 c381 81c3 e7ff 0018 3c7e 7e3c 1800
|
||||
e7c3 8100 0081 c3e7 183c 7eff ff7e 3c18
|
||||
c381 0000 0000 81c3 3c7e ffff ffff 7e3c
|
||||
8100 0000 0000 0081 7eff ffff ffff ff7e
|
||||
0000 0000 0000 0000 ffff ffff ffff ffff
|
||||
0000 0018 1800 0000 ffff ffff ffff ffff
|
||||
0000 183c 3c18 0000 ffff ffff ffff ffff
|
||||
0018 3c7e 7e3c 1800 ffff ffff ffff ffff
|
||||
183c 7eff ff7e 3c18 ffff ffff ffff ffff
|
||||
3c7e ffff ffff 7e3c ffff ffff ffff ffff
|
||||
7eff ffff ffff ff7e ffff ffff ffff ffff
|
||||
ffff ffff ffff ffff ffff ffff ffff ffff
|
||||
ffff ffe7 e7ff ffff ffff ffe7 e7ff ffff
|
||||
ffff e7c3 c3e7 ffff ffff e7c3 c3e7 ffff
|
||||
ffe7 c381 81c3 e7ff ffe7 c381 81c3 e7ff
|
||||
e7c3 8100 0081 c3e7 e7c3 8100 0081 c3e7
|
||||
c381 0000 0000 81c3 c381 0000 0000 81c3
|
||||
8100 0000 0000 0081 8100 0000 0000 0081
|
||||
|
|
@ -0,0 +1,243 @@
|
|||
%BYE { #01 .System/halt DEO BRK }
|
||||
%DEBUG { #ab .System/debug DEO }
|
||||
%IN-RANGE { ROT INCk SWP SUB2 GTH }
|
||||
%MOD { DIVk MUL SUB }
|
||||
%MOD2 { DIV2k MUL2 SUB2 }
|
||||
%NL { #0a .Console/write DEO }
|
||||
%SP { #20 .Console/write DEO }
|
||||
|
||||
@print-string ( string* -- )
|
||||
LDAk ,¬-end JCN
|
||||
POP2 JMP2r
|
||||
¬-end
|
||||
LDAk .Console/write DEO
|
||||
INC2
|
||||
,print-string JMP
|
||||
|
||||
@print-short-decimal ( short* -- )
|
||||
#03e8 DIV2k
|
||||
DUP ,print-byte-decimal/second JSR
|
||||
MUL2 SUB2
|
||||
#0064 DIV2k
|
||||
DUP ,print-byte-decimal/third JSR
|
||||
MUL2 SUB2
|
||||
NIP ,print-byte-decimal/second JMP
|
||||
|
||||
@print-byte-decimal ( byte -- )
|
||||
#64 DIVk DUP #30 ADD .Console/write DEO MUL SUB
|
||||
&second
|
||||
#0a DIVk DUP #30 ADD .Console/write DEO MUL SUB
|
||||
&third
|
||||
#30 ADD .Console/write DEO
|
||||
JMP2r
|
||||
|
||||
@print-32z-hex ( 32-zp -- )
|
||||
#00 SWP
|
||||
,print-32-hex JMP
|
||||
|
||||
@print-64z-hex ( 64-zp -- )
|
||||
#00 SWP
|
||||
( fall through )
|
||||
|
||||
@print-64-hex ( 64-ptr* -- )
|
||||
DUP2 #0004 ADD2 SWP2 ( lo32-ptr* hi32-ptr* )
|
||||
,print-32-hex JSR
|
||||
( fall through )
|
||||
|
||||
@print-32-hex ( 32-ptr* -- )
|
||||
INC2k INC2 SWP2 ( lo-ptr* hi-ptr* )
|
||||
LDA2 ,print-short-hex JSR
|
||||
LDA2 ( fall through )
|
||||
|
||||
@print-short-hex ( short* -- )
|
||||
SWP ,print-byte-hex JSR
|
||||
( fall through )
|
||||
|
||||
@print-byte-hex ( byte -- )
|
||||
DUP #04 SFT ,print-nibble-hex JSR
|
||||
#0f AND ( fall through )
|
||||
|
||||
@print-nibble-hex ( nibble -- )
|
||||
#30 ADD DUP #39 GTH #07 MUL ADD .Console/write DEO
|
||||
JMP2r
|
||||
|
||||
@next-input-byte ( -- number 00
|
||||
OR 01 at end of file )
|
||||
,next-input-short JSR ,&eof JCN
|
||||
NIP #00
|
||||
JMP2r
|
||||
|
||||
&eof
|
||||
#01
|
||||
JMP2r
|
||||
|
||||
@next-input-short ( -- number* 00
|
||||
OR 01 at end of file )
|
||||
LIT2 &ptr :heap
|
||||
LIT2r 0000
|
||||
&ffwd
|
||||
LDAk #3039 IN-RANGE ,&number JCN
|
||||
INC2k SWP2 LDA ,&ffwd JCN
|
||||
( eof )
|
||||
POP2 POP2r
|
||||
;heap ,&ptr STR2
|
||||
#01 JMP2r
|
||||
|
||||
&number
|
||||
LIT2r 000a MUL2r
|
||||
LDAk #30 SUB #00 STH STH ADD2r
|
||||
INC2
|
||||
LDAk #3039 IN-RANGE ,&number JCN
|
||||
|
||||
,&ptr STR2
|
||||
STH2r #00
|
||||
JMP2r
|
||||
|
||||
@add64 ( dest-ptr* src-ptr* -- carry )
|
||||
OVR2 #0004 ADD2 OVR2 #0004 ADD2
|
||||
,add32 JSR
|
||||
( fall through )
|
||||
|
||||
@adc32 ( dest-ptr* src-ptr* carry -- carry )
|
||||
STH
|
||||
OVR2 #0002 ADD2 OVR2 #0002 ADD2
|
||||
STHr ,adc16 JSR
|
||||
,adc16 JMP ( tail call )
|
||||
|
||||
@add64z ( dest-zp src-zp -- carry )
|
||||
OVR #04 ADD OVR #04 ADD
|
||||
,add32z JSR
|
||||
( fall through )
|
||||
|
||||
@adc32z ( dest-zp src-zp carry -- carry )
|
||||
STH
|
||||
OVR #02 ADD OVR #02 ADD
|
||||
STHr ,adc16z JSR
|
||||
,adc16z JMP ( tail call )
|
||||
|
||||
@add32z-short ( dest-zp src* -- carry )
|
||||
#00 SWP SWP2 ROT
|
||||
( fall through )
|
||||
|
||||
@add32-short ( dest-ptr* src* -- carry )
|
||||
,&short STR2
|
||||
;&src ,add32 JMP ( tail call )
|
||||
|
||||
&src 0000 &short 0000
|
||||
|
||||
@add32 ( dest-ptr* src-ptr* -- carry )
|
||||
OVR2 #0002 ADD2 OVR2 #0002 ADD2
|
||||
,add16 JSR
|
||||
( fall through )
|
||||
|
||||
@adc16 ( dest-ptr* src-ptr* carry -- carry )
|
||||
#00 EQU ,add16 JCN
|
||||
OVR2 ;&one ,add16 JSR STH
|
||||
,add16 JSR
|
||||
STHr ORA
|
||||
JMP2r
|
||||
|
||||
&one 0001
|
||||
|
||||
@add16 ( dest-ptr* src-ptr* -- carry )
|
||||
OVR2 LDA2 DUP2 ROT2 LDA2 ( dest-ptr* dest* dest* src* )
|
||||
ADD2 GTH2k STH NIP2 ( dest-ptr* sum* / carry )
|
||||
SWP2 STA2 STHr ( carry )
|
||||
JMP2r
|
||||
|
||||
@add32z ( dest-zp src-zp -- carry )
|
||||
OVR #02 ADD OVR #02 ADD
|
||||
,add16z JSR
|
||||
( fall through )
|
||||
|
||||
@adc16z ( dest-zp src-zp carry -- carry )
|
||||
#00 EQU ,add16z JCN
|
||||
OVR #00 SWP ;adc16/one ,add16 JSR STH
|
||||
,add16z JSR
|
||||
STHr ORA
|
||||
JMP2r
|
||||
|
||||
@add16z ( dest-zp src-zp -- carry )
|
||||
OVR LDZ2 ROT LDZ2 OVR2 ( dest-zp dest* src* dest* )
|
||||
ADD2 GTH2k STH NIP2 ( dest-zp sum* / carry )
|
||||
ROT STZ2 STHr ( carry )
|
||||
JMP2r
|
||||
|
||||
@gth64 ( left-ptr* right-ptr* -- 01 if left > right
|
||||
OR 00 otherwise )
|
||||
OVR2 OVR2 ,gth32 JSR ,&greater JCN
|
||||
OVR2 OVR2 SWP2 ,gth32 JSR ,&less JCN
|
||||
#0004 ADD2 SWP2 #0004 ADD2 SWP2 ,gth32 JMP ( tail call )
|
||||
|
||||
&greater POP2 POP2 #01 JMP2r
|
||||
&less POP2 POP2 #00 JMP2r
|
||||
|
||||
@gth32z ( left-zp* right-zp* -- 01 if left > right
|
||||
OR 00 otherwise )
|
||||
#00 ROT ROT #00 SWP
|
||||
( fall through )
|
||||
|
||||
@gth32 ( left-ptr* right-ptr* -- 01 if left > right
|
||||
OR 00 otherwise )
|
||||
OVR2 LDA2 OVR2 LDA2 ( left-ptr* right-ptr* left* right* )
|
||||
EQU2k ,&lo JCN
|
||||
GTH2 NIP2 NIP NIP
|
||||
JMP2r
|
||||
|
||||
&lo
|
||||
POP2 POP2
|
||||
INC2 INC2 LDA2 SWP2 INC2 INC2 LDA2 ( right-lo* left-lo* )
|
||||
LTH2
|
||||
JMP2r
|
||||
|
||||
@add32z-short-short-mul ( dest-zp a* b* -- carry )
|
||||
STH2 STH2 #00 SWP STH2r STH2r
|
||||
( fall through )
|
||||
|
||||
@add32-short-short-mul ( dest-ptr* a* b* -- carry )
|
||||
LITr 00 STH LITr 00 STH ( dest-ptr* a* / blo* bhi* )
|
||||
#00 ROT ROT #00 SWP ( dest-ptr* ahi* alo* / blo* bhi* )
|
||||
STH2kr OVR2 MUL2 ,&alo-bhi STR2
|
||||
OVR2 STH2r MUL2 ,&ahi-bhi STR2 ( dest-ptr ahi* alo* / blo* )
|
||||
STH2kr MUL2 ,&alo-blo STR2 ( dest-ptr* ahi* / blo* )
|
||||
STH2r MUL2 ,&ahi-blo STR2 ( dest-ptr* )
|
||||
DUP2 ;&sum1 ;add32 JSR2 STH
|
||||
DUP2 ;&sum2 ;add32 JSR2 STH
|
||||
;&sum3 ;add32 JSR2
|
||||
STH2r ORA ORA
|
||||
JMP2r
|
||||
|
||||
&sum1 &ahi-bhi 0000 &alo-blo 0000
|
||||
&sum2 00 &ahi-blo 0000 00
|
||||
&sum3 00 &alo-bhi 0000 00
|
||||
|
||||
@zero64 ( ptr* -- )
|
||||
#08 ,zero JMP ( tail call )
|
||||
|
||||
@zero32z ( zp -- )
|
||||
#00 SWP
|
||||
( fall through )
|
||||
|
||||
@zero32 ( ptr* -- )
|
||||
#04
|
||||
( fall through )
|
||||
|
||||
@zero ( ptr* len -- )
|
||||
#00 SWP ADD2k NIP2 SWP2
|
||||
&loop
|
||||
DUP2 #00 ROT ROT STA
|
||||
INC2
|
||||
GTH2k ,&loop JCN
|
||||
POP2 POP2
|
||||
JMP2r
|
||||
|
||||
@is-nonzero64 ( ptr* -- flag )
|
||||
DUP2 ,is-nonzero32 JSR STH
|
||||
#0004 ADD2 ,is-nonzero32 JSR STHr ORA
|
||||
JMP2r
|
||||
|
||||
@is-nonzero32 ( ptr* -- flag )
|
||||
LDA2k ORA STH
|
||||
INC2 INC2 LDA2 ORA STHr ORA
|
||||
JMP2r
|
||||
|
||||
|
|
@ -0,0 +1,435 @@
|
|||
( math32.tal )
|
||||
( )
|
||||
( This library supports arithmetic on 32-bit unsigned integers, )
|
||||
( also known as long values. )
|
||||
( )
|
||||
( 32-bit long values are represented by two 16-bit short values: )
|
||||
( )
|
||||
( decimal hexadecimal uxn literals )
|
||||
( 0 0x00000000 #0000 #0000 )
|
||||
( 1 0x00000001 #0000 #0001 )
|
||||
( 4660 0x00001234 #0000 #1234 )
|
||||
( 65535 0x0000ffff #0000 #ffff )
|
||||
( 65536 0x00010000 #0001 #0000 )
|
||||
( 16777215 0x00ffffff #00ff #ffff )
|
||||
( 4294967295 0xffffffff #ffff #ffff )
|
||||
( )
|
||||
( The most significant 16-bit, the "high bits", are stored first. )
|
||||
( We document long values as x** -- equivalent to xhi* xlo*. )
|
||||
( )
|
||||
( Operations supported: )
|
||||
( )
|
||||
( NAME STACK EFFECT DEFINITION )
|
||||
( add32 x** y** -> z** x + y )
|
||||
( sub32 x** y** -> z** x - y )
|
||||
( mul16 x* y* -> z** x * y )
|
||||
( mul32 x** y** -> z** x * y )
|
||||
( div32 x** y** -> q** x / y )
|
||||
( mod32 x** y** -> r** x % y )
|
||||
( divmod32 x** y** -> q** r** x / y, x % y )
|
||||
( gcd32 x** y** -> z** gcd(x, y) )
|
||||
( negate32 x** -> z** -x )
|
||||
( lshift32 x** n^ -> z** x<<n )
|
||||
( rshift32 x** n^ -> z** x>>n )
|
||||
( and32 x** y** -> z** x & y )
|
||||
( or32 x** y** -> z** x | y )
|
||||
( xor32 x** y** -> z** x ^ y )
|
||||
( complement32 x** -> z** ~x )
|
||||
( eq32 x** y** -> bool^ x == y )
|
||||
( ne32 x** y** -> bool^ x != y )
|
||||
( is-zero32 x** -> bool^ x == 0 )
|
||||
( non-zero32 x** -> bool^ x != 0 )
|
||||
( lt32 x** y** -> bool^ x < y )
|
||||
( gt32 x** y** -> bool^ x > y )
|
||||
( lteq32 x** y** -> bool^ x <= y )
|
||||
( gteq32 x** y** -> bool^ x >= y )
|
||||
( bitcount8 x^ -> bool^ floor(log2(x))+1 )
|
||||
( bitcount16 x* -> bool^ floor(log2(x))+1 )
|
||||
( bitcount32 x** -> bool^ floor(log2(x))+1 )
|
||||
( )
|
||||
( In addition to the code this file uses 44 bytes of registers )
|
||||
( to store temporary state: )
|
||||
( )
|
||||
( - shared memory, 16 bytes )
|
||||
( - mul32 memory, 12 bytes )
|
||||
( - _divmod32 memory, 16 bytes )
|
||||
|
||||
%DEBUG { #ff #0e DEO }
|
||||
%RTN { JMP2r }
|
||||
%TOR { ROT ROT } ( a b c -> c a b )
|
||||
%COMPLEMENT32 { SWP2 #ffff EOR2 SWP2 #ffff EOR2 }
|
||||
%DUP4 { OVR2 OVR2 }
|
||||
%POP4 { POP2 POP2 }
|
||||
|
||||
( bitcount: number of bits needed to represent number )
|
||||
( equivalent to floor[log2[x]] + 1 )
|
||||
|
||||
@bitcount8 ( x^ -> n^ )
|
||||
#00 SWP ( n x )
|
||||
&loop
|
||||
DUP #00 EQU ( n x x=0 )
|
||||
,&done JCN ( n x )
|
||||
#01 SFT ( n x>>1 )
|
||||
SWP INC SWP ( n+1 x>>1 )
|
||||
,&loop JMP
|
||||
&done
|
||||
POP ( n )
|
||||
RTN
|
||||
|
||||
@bitcount16 ( x* -> n^ )
|
||||
SWP ( xlo xhi )
|
||||
;bitcount8 JSR2 ( xlo nhi )
|
||||
DUP #00 NEQ ( xlo nhi nhi!=0 )
|
||||
,&hi-set JCN ( xlo nhi )
|
||||
SWP ;bitcount8 JSR2 ADD ( nhi+nlo )
|
||||
RTN
|
||||
&hi-set
|
||||
SWP POP #08 ADD ( nhi+8 )
|
||||
RTN
|
||||
|
||||
@bitcount32 ( x** -> n^ )
|
||||
SWP2 ( xlo* xhi* )
|
||||
;bitcount16 JSR2 ( xlo* nhi )
|
||||
DUP #00 NEQ ( xlo* nhi nhi!=0 )
|
||||
,&hi-set JCN ( xlo* nhi )
|
||||
TOR ;bitcount16 JSR2 ADD RTN ( nhi+nlo )
|
||||
&hi-set
|
||||
TOR POP2 #10 ADD ( nhi+16 )
|
||||
RTN
|
||||
|
||||
( equality )
|
||||
|
||||
( x == y )
|
||||
@eq32 ( xhi* xlo* yhi* ylo* -> bool^ )
|
||||
ROT2 EQU2 STH
|
||||
EQU2 STHr AND RTN
|
||||
|
||||
( x != y )
|
||||
@ne32 ( xhi* xlo* yhi* ylo* -> bool^ )
|
||||
ROT2 NEQ2 STH
|
||||
NEQ2 STHr ORA RTN
|
||||
|
||||
( x == 0 )
|
||||
@is-zero32 ( x** -> bool^ )
|
||||
ORA2 #0000 EQU2 RTN
|
||||
|
||||
( x != 0 )
|
||||
@non-zero32 ( x** -> bool^ )
|
||||
ORA2 #0000 NEQ2 RTN
|
||||
|
||||
( comparisons )
|
||||
|
||||
( x < y )
|
||||
@lt32 ( x** y** -> bool^ )
|
||||
ROT2 SWP2 ( xhi yhi xlo ylo )
|
||||
LTH2 ,<-lo JCN ( xhi yhi )
|
||||
LTH2 RTN
|
||||
<-lo
|
||||
GTH2 #00 EQU RTN
|
||||
|
||||
( x <= y )
|
||||
@lteq32 ( x** y** -> bool^ )
|
||||
ROT2 SWP2 ( xhi yhi xlo ylo )
|
||||
GTH2 ,>-lo JCN ( xhi yhi )
|
||||
GTH2 #00 EQU RTN
|
||||
>-lo
|
||||
LTH2 RTN
|
||||
|
||||
( x > y )
|
||||
@gt32 ( x** y** -> bool^ )
|
||||
ROT2 SWP2 ( xhi yhi xlo ylo )
|
||||
GTH2 ,>-lo JCN ( xhi yhi )
|
||||
GTH2 RTN
|
||||
>-lo
|
||||
LTH2 #00 EQU RTN
|
||||
|
||||
( x > y )
|
||||
@gteq32 ( x** y** -> bool^ )
|
||||
ROT2 SWP2 ( xhi yhi xlo ylo )
|
||||
LTH2 ,<-lo JCN ( xhi yhi )
|
||||
LTH2 #00 EQU RTN
|
||||
<-lo
|
||||
GTH2 RTN
|
||||
|
||||
( bitwise operations )
|
||||
|
||||
( x & y )
|
||||
@and32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
|
||||
ROT2 AND2 STH2 AND2 STH2r RTN
|
||||
|
||||
( x | y )
|
||||
@or32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
|
||||
ROT2 ORA2 STH2 ORA2 STH2r RTN
|
||||
|
||||
( x ^ y )
|
||||
@xor32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
|
||||
ROT2 EOR2 STH2 EOR2 STH2r RTN
|
||||
|
||||
( ~x )
|
||||
@complement32 ( x** -> ~x** )
|
||||
COMPLEMENT32 RTN
|
||||
|
||||
( temporary registers )
|
||||
( shared by most operations, except mul32 and div32 )
|
||||
[ @x0 $1 @x1 $1 @x2 $1 @x3 $1
|
||||
@y0 $1 @y1 $1 @y2 $1 @y3 $1
|
||||
@z0 $1 @z1 $1 @z2 $1 @z3 $1
|
||||
@w0 $1 @w1 $1 @w2 $2 ]
|
||||
|
||||
( bit shifting )
|
||||
|
||||
( x >> n )
|
||||
@rshift32 ( x** n^ -> x<<n )
|
||||
DUP #08 LTH ;rshift32-0 JCN2 ( x n )
|
||||
DUP #10 LTH ;rshift32-1 JCN2 ( x n )
|
||||
DUP #18 LTH ;rshift32-2 JCN2 ( x n )
|
||||
;rshift32-3 JMP2 ( x n )
|
||||
RTN
|
||||
|
||||
( shift right by 0-7 bits )
|
||||
@rshift32-0 ( x** n^ -> x<<n )
|
||||
STHk SFT ;z3 STA ( write z3 )
|
||||
#00 STHkr SFT2 #00 ;z3 LDA ORA2 ;z2 STA2 ( write z2,z3 )
|
||||
#00 STHkr SFT2 #00 ;z2 LDA ORA2 ;z1 STA2 ( write z1,z2 )
|
||||
#00 STHr SFT2 #00 ;z1 LDA ORA2 ( compute z0,z1 )
|
||||
;z2 LDA2
|
||||
RTN
|
||||
|
||||
( shift right by 8-15 bits )
|
||||
@rshift32-1 ( x** n^ -> x<<n )
|
||||
#08 SUB STH POP
|
||||
STHkr SFT ;z3 STA ( write z3 )
|
||||
#00 STHkr SFT2 #00 ;z3 LDA ORA2 ;z2 STA2 ( write z2,z3 )
|
||||
#00 STHr SFT2 #00 ;z2 LDA ORA2 ( compute z1,z2 )
|
||||
#00 TOR ;z3 LDA
|
||||
RTN
|
||||
|
||||
( shift right by 16-23 bits )
|
||||
@rshift32-2 ( x** n^ -> x<<n )
|
||||
#10 SUB STH POP2
|
||||
STHkr SFT ;z3 STA ( write z3 )
|
||||
#00 STHr SFT2 #00 ;z3 LDA ORA2 ( compute z2,z3 )
|
||||
#0000 SWP2
|
||||
RTN
|
||||
|
||||
( shift right by 16-23 bits )
|
||||
@rshift32-3 ( x** n^ -> x<<n )
|
||||
#18 SUB STH POP2 POP ( x0 )
|
||||
#00 SWP #0000 SWP2 ( 00 00 00 x0 )
|
||||
STHr SFT
|
||||
RTN
|
||||
|
||||
( x << n )
|
||||
@lshift32 ( x** n^ -> x<<n )
|
||||
DUP #08 LTH ;lshift32-0 JCN2 ( x n )
|
||||
DUP #10 LTH ;lshift32-1 JCN2 ( x n )
|
||||
DUP #18 LTH ;lshift32-2 JCN2 ( x n )
|
||||
;lshift32-3 JMP2 ( x n )
|
||||
RTN
|
||||
|
||||
( shift left by 0-7 bits )
|
||||
@lshift32-0 ( x** n^ -> x<<n )
|
||||
#40 SFT STH ( stash n<<4 )
|
||||
#00 SWP STHkr SFT2 ;z2 STA2 ( store z2,z3 )
|
||||
#00 SWP STHkr SFT2 #00 ;z2 LDA ORA2 ;z1 STA2 ( store z1,z2 )
|
||||
#00 SWP STHkr SFT2 #00 ;z1 LDA ORA2 ;z0 STA2 ( store z0,z1 )
|
||||
STHr SFT ;z0 LDA ORA ( calculate z0 )
|
||||
;z1 LDA ;z2 LDA2
|
||||
RTN
|
||||
|
||||
( shift left by 8-15 bits )
|
||||
@lshift32-1 ( x** n^ -> x<<n )
|
||||
#08 SUB #40 SFT STH ( stash [n-8]<<4 )
|
||||
#00 SWP STHkr SFT2 ;z1 STA2 ( store z1,z2 )
|
||||
#00 SWP STHkr SFT2 #00 ;z1 LDA ORA2 ;z0 STA2 ( store z0,z1 )
|
||||
STHr SFT ;z0 LDA ORA ( calculate z0 )
|
||||
SWP POP ( x0 unused )
|
||||
;z1 LDA2 #00
|
||||
RTN
|
||||
|
||||
( shift left by 16-23 bits )
|
||||
@lshift32-2 ( x** n^ -> x<<n )
|
||||
#10 SUB #40 SFT STH ( stash [n-16]<<4 )
|
||||
#00 SWP STHkr SFT2 ;z0 STA2 ( store z0,z1 )
|
||||
STHr SFT ;z0 LDA ORA ( calculate z0 )
|
||||
STH POP2 STHr
|
||||
;z1 LDA #0000
|
||||
RTN
|
||||
|
||||
( shift left by 24-31 bits )
|
||||
@lshift32-3 ( x** n^ -> x<<n )
|
||||
#18 SUB #40 SFT ( x0 x1 x2 x3 r=[n-24]<<4 )
|
||||
SFT ( x0 x1 x2 x3<<r )
|
||||
SWP2 POP2 SWP POP #0000 #00
|
||||
RTN
|
||||
|
||||
( arithmetic )
|
||||
|
||||
( x + y )
|
||||
@add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* )
|
||||
;y2 STA2 ;y0 STA2 ( save ylo, yhi )
|
||||
;x2 STA2 ;x0 STA2 ( save xlo, xhi )
|
||||
#0000 #0000 ;z0 STA2 ;z2 STA2 ( reset zhi, zlo )
|
||||
|
||||
( x3 + y3 => z2z3 )
|
||||
#00 ;x3 LDA #00 ;y3 LDA ADD2 ;z2 STA2
|
||||
|
||||
( x2 + y2 + z2 => z1z2 )
|
||||
#00 ;x2 LDA ;z1 LDA2 ADD2 ;z1 STA2
|
||||
#00 ;y2 LDA ;z1 LDA2 ADD2 ;z1 STA2
|
||||
|
||||
( x1 + y1 + z1 => z0z1 )
|
||||
#00 ;x1 LDA ;z0 LDA2 ADD2 ;z0 STA2
|
||||
#00 ;y1 LDA ;z0 LDA2 ADD2 ;z0 STA2
|
||||
|
||||
( x0 + y0 + z0 => z0 )
|
||||
;x0 LDA ;z0 LDA ADD ;z0 STA
|
||||
;y0 LDA ;z0 LDA ADD ;z0 STA
|
||||
|
||||
( load zhi,zlo )
|
||||
;z0 LDA2 ;z2 LDA2
|
||||
RTN
|
||||
|
||||
( -x )
|
||||
@negate32 ( x** -> -x** )
|
||||
COMPLEMENT32
|
||||
INC2 ( ~xhi -xlo )
|
||||
DUP2 #0000 NEQ2 ( ~xhi -xlo non-zero? )
|
||||
,&done JCN ( xlo non-zero => don't inc hi )
|
||||
SWP2 INC2 SWP2 ( -xhi -xlo )
|
||||
&done
|
||||
RTN
|
||||
|
||||
( x - y )
|
||||
@sub32 ( x** y** -> z** )
|
||||
;negate32 JSR2 ;add32 JSR2 RTN
|
||||
|
||||
( 16-bit multiplication )
|
||||
@mul16 ( x* y* -> z** )
|
||||
;y1 STA ;y0 STA ( save ylo, yhi )
|
||||
;x1 STA ;x0 STA ( save xlo, xhi )
|
||||
#0000 #00 ;z1 STA2 ;z3 STA ( reset z1,z2,z3 )
|
||||
#0000 #00 ;w0 STA2 ;w2 STA ( reset w0,w1,w2 )
|
||||
|
||||
( x1 * y1 => z1z2 )
|
||||
#00 ;x1 LDA #00 ;y1 LDA MUL2 ;z2 STA2
|
||||
|
||||
( x0 * y1 => z0z1 )
|
||||
#00 ;x0 LDA #00 ;y1 LDA MUL2 ;z1 LDA2 ADD2 ;z1 STA2
|
||||
|
||||
( x1 * y0 => w1w2 )
|
||||
#00 ;x1 LDA #00 ;y0 LDA MUL2 ;w1 STA2
|
||||
|
||||
( x0 * y0 => w0w1 )
|
||||
#00 ;x0 LDA #00 ;y0 LDA MUL2 ;w0 LDA2 ADD2 ;w0 STA2
|
||||
|
||||
( add z and a<<8 )
|
||||
#00 ;z1 LDA2 ;z3 LDA
|
||||
;w0 LDA2 ;w2 LDA #00
|
||||
;add32 JSR2
|
||||
RTN
|
||||
|
||||
( x * y )
|
||||
@mul32 ( x** y** -> z** )
|
||||
,&y1 STR2 ,&y0 STR2 ( save ylo, yhi )
|
||||
,&x1 STR2 ,&x0 STR2 ( save xlo, xhi )
|
||||
,&y1 LDR2 ,&x1 LDR2 ;mul16 JSR2 ( [x1*y1] )
|
||||
,&z1 STR2 ,&z0 STR2 ( sum = x1*y1, save zlo, zhi )
|
||||
,&y1 LDR2 ,&x0 LDR2 MUL2 ( [x0*y1]<<16 )
|
||||
,&y0 LDR2 ,&x1 LDR2 MUL2 ( [x1*y0]<<16 )
|
||||
( [x0*y0]<<32 will completely overflow )
|
||||
ADD2 ,&z0 LDR2 ADD2 ( sum += x0*y1<<16 + x1*y0<<16 )
|
||||
,&z1 LDR2
|
||||
RTN
|
||||
[ &x0 $2 &x1 $2
|
||||
&y0 $2 &y1 $2
|
||||
&z0 $2 &z1 $2 ]
|
||||
|
||||
@div32 ( x** y** -> q** )
|
||||
;_divmod32 JSR2
|
||||
;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2
|
||||
RTN
|
||||
|
||||
@mod32 ( x** y** -> r** )
|
||||
;_divmod32 JSR2
|
||||
;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2
|
||||
RTN
|
||||
|
||||
@divmod32 ( x** y** -> q** r** )
|
||||
;_divmod32 JSR2
|
||||
;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2
|
||||
;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2
|
||||
RTN
|
||||
|
||||
( calculate and store x / y and x % y )
|
||||
@_divmod32 ( x** y** -> )
|
||||
( store y and x for repeated use )
|
||||
,&div1 STR2 ,&div0 STR2 ( y -> div )
|
||||
,&rem1 STR2 ,&rem0 STR2 ( x -> rem )
|
||||
|
||||
( if x < y then the answer is 0 )
|
||||
,&rem0 LDR2 ,&rem1 LDR2
|
||||
,&div0 LDR2 ,&div1 LDR2
|
||||
;lt32 JSR2 ,&is-zero JCN ,¬-zero JMP
|
||||
&is-zero
|
||||
#0000 ,&quo0 STR2 #0000 ,&quo1 STR2 RTN
|
||||
|
||||
( x >= y so the answer is >= 1 )
|
||||
¬-zero
|
||||
#0000 ,&quo0 STR2 #0000 ,&quo1 STR2 ( 0 -> quo )
|
||||
|
||||
( bitcount[x] - bitcount[y] determines the largest multiple of y to try )
|
||||
,&rem0 LDR2 ,&rem1 LDR2 ;bitcount32 JSR2 ( rbits^ )
|
||||
,&div0 LDR2 ,&div1 LDR2 ;bitcount32 JSR2 ( rbits^ dbits^ )
|
||||
SUB ( shift=rbits-dits )
|
||||
#00 DUP2 ( shift 0 shift 0 )
|
||||
|
||||
( 1<<shift -> cur )
|
||||
#0000 #0001 ROT2 POP
|
||||
;lshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2
|
||||
|
||||
( div<<shift -> div )
|
||||
,&div0 LDR2 ,&div1 LDR2 ROT2 POP
|
||||
;lshift32 JSR2 ,&div1 STR2 ,&div0 STR2
|
||||
|
||||
,&loop JMP
|
||||
|
||||
[ &div0 $2 &div1 $2
|
||||
&rem0 $2 &rem1 $2
|
||||
&quo0 $2 &quo1 $2
|
||||
&cur0 $2 &cur1 $2 ]
|
||||
|
||||
&loop
|
||||
( if rem >= the current divisor, we can subtract it and add to quotient )
|
||||
,&rem0 LDR2 ,&rem1 LDR2 ,&div0 LDR2 ,&div1 LDR2 ;lt32 JSR2 ( is rem < div? )
|
||||
,&rem-lt JCN ( if rem < div skip this iteration )
|
||||
|
||||
( since rem >= div, we have found a multiple of y that divides x )
|
||||
,&rem0 LDR2 ,&rem1 LDR2 ,&div0 LDR2 ,&div1 LDR2 ;sub32 JSR2 ,&rem1 STR2 ,&rem0 STR2 ( rem -= div )
|
||||
,&quo0 LDR2 ,&quo1 LDR2 ,&cur0 LDR2 ,&cur1 LDR2 ;add32 JSR2 ,&quo1 STR2 ,&quo0 STR2 ( quo += cur )
|
||||
|
||||
&rem-lt
|
||||
,&div0 LDR2 ,&div1 LDR2 #01 ;rshift32 JSR2 ,&div1 STR2 ,&div0 STR2 ( div >>= 1 )
|
||||
,&cur0 LDR2 ,&cur1 LDR2 #01 ;rshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2 ( cur >>= 1 )
|
||||
,&cur0 LDR2 ,&cur1 LDR2 ;non-zero32 JSR2 ,&loop JCN ( if cur>0, loop. else we're done )
|
||||
RTN
|
||||
|
||||
( greatest common divisor - euclidean algorithm )
|
||||
@gcd32 ( x** y** -> z** )
|
||||
&loop ( x y )
|
||||
DUP4 ( x y y )
|
||||
;is-zero32 JSR2 ( x y y=0? )
|
||||
,&done JCN ( x y )
|
||||
DUP4 ( x y y )
|
||||
STH2 STH2 ( x y [y] )
|
||||
;mod32 JSR2 ( r=x%y [y] )
|
||||
STH2r ( rhi rlo yhi [ylo] )
|
||||
ROT2 ( rlo yhi rhi [ylo] )
|
||||
ROT2 ( yhi rhi rlo [ylo] )
|
||||
STH2r ( yhi rhi rlo ylo )
|
||||
ROT2 ( yhi rlo ylo rhi )
|
||||
ROT2 ( yhi ylo rhi rlo )
|
||||
,&loop JMP
|
||||
&done
|
||||
POP4 ( x )
|
||||
RTN
|
||||
Binary file not shown.
Loading…
Reference in New Issue