diff --git a/math32.tal b/math32.tal index cd66002..d69f81a 100644 --- a/math32.tal +++ b/math32.tal @@ -10,6 +10,7 @@ %SPACE { #20 EMIT } %NEWLINE { #0a EMIT } +%TOR { ROT ROT } %TOR2 { ROT2 ROT2 } %POP4 { POP2 POP2 } @@ -19,6 +20,30 @@ |0100 ( run a bunch of test cases ) + + #1000 #03 ;divmod16-by-8 JSR2 ;emit-short-byte JSR2 NEWLINE + NEWLINE + + #1124 #1244 #01 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #02 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #08 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #0f ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #10 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #13 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #17 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #18 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #1124 #1244 #19 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #0000 #0001 #1f ;left-shift JSR2 ;emit-long JSR2 NEWLINE + #0000 #0001 #20 ;left-shift JSR2 ;emit-long JSR2 NEWLINE + NEWLINE + + #0000 #0000 ;bitcount32 JSR2 ;emit-byte JSR2 NEWLINE + #0000 #0100 ;bitcount32 JSR2 ;emit-byte JSR2 NEWLINE + #0001 #0000 ;bitcount32 JSR2 ;emit-byte JSR2 NEWLINE + #0010 #0000 ;bitcount32 JSR2 ;emit-byte JSR2 NEWLINE + #1000 #0000 ;bitcount32 JSR2 ;emit-byte JSR2 NEWLINE + #f000 #0000 ;bitcount32 JSR2 ;emit-byte JSR2 NEWLINE + NEWLINE #ffff #ffff #2a ;mul16 ;emit-short ;test16 JSR2 #0001 #ffff #2a ;mul16 ;emit-short ;test16 JSR2 @@ -95,18 +120,59 @@ RTN &xhi $2 &xlo $2 &yhi $2 &ylo $2 +@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 + @eq32 ( xhi* xlo* yhi* ylo* -> bool^ ) ROT2 EQU2 ,&maybe JCN POP4 #00 RTN &maybe EQU2 RTN +@eq-zero32 ( x** -> bool^ ) + ORA2 #0000 EQU2 +RTN + @ne32 ( xhi* xlo* yhi* ylo* -> bool^ ) ROT2 EQU2 ,&maybe JCN POP4 #01 RTN &maybe NEQ2 RTN +@ne-zero32 ( x** -> bool^ ) + ORA2 #0000 NEQ2 +RTN + @and32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* ) ROT2 AND2 TOR2 AND2 SWP2 RTN @@ -138,6 +204,72 @@ RTN SWP2 POP2 #0000 RTN +@left-shift ( x** n^ -> x< x< r ) + SWP SWP2 SWP ( x3 x2 x1 x0 ) + + ,&r LDR SFT ,&z0 STR ( x3 x2 x1 ) + + #00 SWP ,&r LDR SFT2 ( x3 x2 00x1< x< r ) + SWP SWP2 SWP POP ( x3 x2 x1 ) + + ,&r LDR SFT ,&z0 STR ( x3 x2 ) + + #00 SWP ,&r LDR SFT2 ( x3 00x2< x< r ) + SWP2 POP2 SWP ( x3 x2 ) + + ,&r LDR SFT ,&z0 STR ( x3 ) + + #00 SWP ,&r LDR SFT2 ( x3< x< zhi* zlo* ) ,&y2 STR2 ,&y0 STR2 ( save ylo, yhi ) ,&x2 STR2 ,&x0 STR2 ( save xlo, xhi ) @@ -214,6 +346,38 @@ RTN [ &y0 $2 &y1 $2 ] [ &z0 $2 &z1 $2 ] +@divmod32-by-32 ( x** y** -> q** r** ) + ,&div1 STR2 ,&div0 STR2 ( y -> div ) + ,&rem1 STR2 ,&rem0 STR2 ( x -> rem ) + #0000 #0000 ,&quo1 STR2 ,&quo0 ( 0 -> quo ) + ,&rem0 LDR2 ,&rem1 LDR2 ;bitcount32 JSR2 ( rembits^ ) + ,&div1 LDR2 ,&div0 LDR2 ;bitcount32 JSR2 ( rembits^ divbits^ ) + SUBk ,&shift STR ( rembits divbits ) + ,&div0 LDR2 ,&div1 LDR2 + + +RTN +[ &div0 $2 &div1 $2 + &rem0 $2 &rem1 $2 + &quo0 $2 &quo1 $2 + &shift $1 ] + +@divmod16-by-8 ( x* y^ -> q* r^ ) + DUP ,&y STR + ROT SWP ( x1 x0 y ) + DIVk ( x1 x0 y q0 ) + DUP ,&q0 STR ( x1 x0 y q0 ) + MUL SUB ( x1 r=x0-y*q0 ) + SWP #00 ,&y LDR ( r x1 00 y ) + DIV2k ( rx1 00y q1 ) + DUP2 ROT2 MUL2 ( rx1 q1 y*q1 ) + ROT2 SWP2 SUB2 ( q1 rr=rx1-y*q1 ) + SWP POP ( q1 rrlo ) + ROT POP ( q1lo rrlo ) + ,&q0 LDR TOR +RTN +[ &y $1 &q0 $1 ] + @emit-long ( hi* lo* -> ) SWP2 ( lo* hi* ) ;emit-short JSR2 @@ -222,6 +386,13 @@ RTN %EMIT-BYTE { DUP #04 SFT DIGIT #0f AND DIGIT } +@emit-short-byte ( x* y^ - > ) + TOR ( y^ x* ) + ;emit-short JSR2 + SPACE + ;emit-byte JSR2 +RTN + @emit-short ( x* -> ) SWP ( lo^ hi^ ) EMIT-BYTE EMIT-BYTE