From fa30d46611a616209b6ce81c7795a7ce352bcc06 Mon Sep 17 00:00:00 2001
From: d6 <d_m@plastic-idolatry.com>
Date: Fri, 24 Dec 2021 16:33:59 -0500
Subject: [PATCH] bit shifting, start on div

---
 math32.tal | 171 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 171 insertions(+)

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<<n )
+    DUP #08 LTH ;left-shift0 JCN2 ( x n )
+    DUP #10 LTH ;left-shift1 JCN2 ( x n )
+    DUP #18 LTH ;left-shift2 JCN2 ( x n )
+    ;left-shift3 JMP2 ( x n )    
+RTN
+[ &z0 $1 &z1 $1 &z2 $1 &z3 $1 ]
+
+( shift left by 0-7 bits )
+@left-shift0 ( x** n^ -> x<<n )
+    #40 SFT ,&r STR ( n<<4 -> r )
+    SWP SWP2 SWP ( x3 x2 x1 x0 )
+
+    ,&r LDR SFT ,&z0 STR ( x3 x2 x1 )
+
+    #00 SWP ,&r LDR SFT2 ( x3 x2 00x1<<r )
+    ,&z0 LDR2 ORA2 ,&z0 STR2 ( x3 x2 )
+
+    #00 SWP ,&r LDR SFT2 ( x3 00x2<<r )
+    ,&z1 LDR2 ORA2 ,&z1 STR2 ( x3 )
+
+    #00 SWP ,&r LDR SFT2 ( 00x3<<r )
+    ,&z2 LDR2 ORA2 ,&z2 STR2 ( )
+
+    ,&z0 LDR2 ,&z2 LDR2
+RTN
+[ &r $1 &z0 $1 &z1 $1 &z2 $1 &z3 $1 ]
+
+( shift left by 8-15 bits )
+@left-shift1 ( x** n^ -> x<<n )
+    #08 SUB #40 SFT ,&r STR ( n<<4 -> r )
+    SWP SWP2 SWP POP ( x3 x2 x1 )
+
+    ,&r LDR SFT ,&z0 STR ( x3 x2 )
+
+    #00 SWP ,&r LDR SFT2 ( x3 00x2<<r )
+    ,&z0 LDR2 ORA2 ,&z0 STR2 ( x3 )
+
+    #00 SWP ,&r LDR SFT2 ( 00x3<<r )
+    ,&z1 LDR2 ORA2 ,&z1 STR2 ( )
+
+    ,&z0 LDR2 ,&z2 LDR #00
+RTN
+[ &r $1 &z0 $1 &z1 $1 &z2 $1 ]
+
+( shift left by 16-23 bits )
+@left-shift2 ( x** n^ -> x<<n )
+    #10 SUB #40 SFT ,&r STR ( n<<4 -> r )
+    SWP2 POP2 SWP ( x3 x2 )
+
+    ,&r LDR SFT ,&z0 STR ( x3 )
+
+    #00 SWP ,&r LDR SFT2 ( x3<<r )
+    ,&z0 LDR2 ORA2 ,&z0 STR2 (  )
+
+    ,&z0 LDR2 #0000
+RTN
+[ &r $1 &z0 $1 &z1 $1 ]
+
+( shift left by 24-31 bits )
+@left-shift3 ( x** n^ -> x<<n )
+    #18 SUB #10 MUL ( x0 x1 x2 x3 r=[n-24]<<4 )
+    SFT ( x0 x1 x2 x3<<r )
+    SWP2 POP2 SWP POP #0000 #00
+RTN
+
 @add32 ( xhi* xlo* yhi* ylo* -> 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