mirror of https://git.sr.ht/~rabbits/uxn
Devine Lu Linvega
7 months ago
5 changed files with 0 additions and 609 deletions
@ -1,56 +0,0 @@
|
||||
( |
||||
|
||||
binary tree node layout: |
||||
|
||||
+--+--+ |
||||
| ' | incoming-ptr* |
||||
+--+--+ key: null optional |
||||
v left right terminated binary |
||||
| ptr ptr string data |
||||
\ +--+--+--+--+---------+--+----- - - |
||||
---> | ' | ' | U x n .00| |
||||
+--+--+--+--+---------+--+----- - - |
||||
|
||||
All of the pointers (ptr) are shorts that have the value of the memory |
||||
location of the next node, or 0000 to mean that pointer is empty. The very |
||||
simplest tree is one where the incoming-ptr* is empty: |
||||
|
||||
+--+--+ |
||||
|00'00| incoming-ptr* |
||||
+--+--+ |
||||
|
||||
traverse-tree does two jobs at once, depending on whether the search-key is |
||||
found: |
||||
|
||||
* if the search-key exists in the tree, return a pointer to the binary data |
||||
that follows that node's key string; |
||||
|
||||
* if the search-key is not present in the key, return the incoming-ptr* that |
||||
should be written when adding this node yourself. |
||||
|
||||
) |
||||
|
||||
@traverse-tree ( incoming-ptr* search-key* -- binary-ptr* 00 if key found |
||||
OR node-incoming-ptr* 01 if key not found ) |
||||
STH2 |
||||
&loop ( incoming-ptr* / search-key* ) |
||||
LDA2k ORA ,&valid-node JCN |
||||
POP2r #01 JMP2r |
||||
|
||||
&valid-node ( incoming-ptr* / search-key* ) |
||||
LDA2 ( node* / search-key* ) |
||||
DUP2 #0004 ADD2 ( node* node-key* / search-key* ) |
||||
STH2kr ( node* node-key* search-key* / search-key* ) |
||||
,strcmp JSR ( node* node-end* search-end* order nomatch / search-key* ) |
||||
,&nomatch JCN ( node* node-end* search-end* order / search-key* ) |
||||
POP POP2 ( node* node-end* / search-key* ) |
||||
INC2 NIP2 ( binary-ptr* / search-key* ) |
||||
POP2r #00 ( binary-ptr* 00 ) |
||||
JMP2r |
||||
|
||||
&nomatch ( node* node-end* search-end* order / search-key* ) |
||||
#80 AND #06 SFT #00 SWP STH2 ( node* node-end* search-end* / search-key* node-offset^ ) |
||||
POP2 POP2 ( node* / search-key* node-offset^ ) |
||||
STH2r ADD2 ( incoming-ptr* / search-key* ) |
||||
,&loop JMP |
||||
|
||||
@ -1,15 +0,0 @@
|
||||
@check-rom ( filename* -- 00 if the file doesn't exist or not a valid ROM |
||||
OR 01 if the ROM seems to be valid ) |
||||
.File/name DEO2 |
||||
#0001 .File/length DEO2 |
||||
;&first-char .File/read DEO2 |
||||
|
||||
( did the file read okay? ) |
||||
.File/success DEI2 ORA |
||||
|
||||
( is the first character a LIT, LIT2, LITk or LIT2k? ) |
||||
LIT &first-char $1 #9f AND #80 EQU |
||||
|
||||
AND |
||||
JMP2r |
||||
|
||||
@ -1,82 +0,0 @@
|
||||
@load-rom ( filename* -- ) |
||||
( |
||||
Attempts to load the ROM from filename* and executes it. If the file exists |
||||
and has non-zero length, this function does not return, because the new ROM |
||||
is executing in its place. |
||||
|
||||
The screen and both stacks are cleared and all the device vectors are |
||||
written to zero as a convenience. All other device bytes are left |
||||
untouched, so they could introduce a device state to the next ROM that |
||||
it's not expecting. |
||||
) |
||||
|
||||
.File/name DEO2 |
||||
|
||||
( clear wst ) |
||||
#ab |
||||
&wst-loop |
||||
POP |
||||
.System/wst STH DEIr STHr ,&wst-loop JCN |
||||
|
||||
( clear rst ) |
||||
LITr ab |
||||
&rst-loop |
||||
POPr |
||||
.System/rst DEI ,&rst-loop JCN |
||||
|
||||
( clear screen ) |
||||
#0000 DUP2 .Screen/x DEO2 .Screen/y DEO2 |
||||
#80 .Screen/pixel DEO |
||||
#c0 .Screen/pixel DEO |
||||
|
||||
( reset device vectors ) |
||||
LIT2r 0000 #00 |
||||
&device-vector-loop |
||||
DUP2r STHk DEO2r |
||||
#10 ADD |
||||
DUP ,&device-vector-loop JCN |
||||
POP POP2r |
||||
|
||||
( copy the zero-page-loader into f0-ff ) |
||||
;&zero-page-loader LITr f0 |
||||
©-loop |
||||
LDAk STHkr STZ |
||||
INC2 INCr |
||||
STHkr ,©-loop JCN |
||||
POP2 ( leave 00 on return stack ) |
||||
|
||||
( prepare the stack for the zero-page-loader ) |
||||
( the more we prepare here in advance, the less we'll have to overwrite ) |
||||
STHkr #00fe ( arguments for STZ2 at ff ) |
||||
STHkr ( argument for JMP at fe (carry on) ) |
||||
DUPk #fcfe ( arguments for STZ2 at fd and JMP (repeat) ) |
||||
OVR2 #fafe ( arguments for STZ2 at fd and JMP (repeat) ) |
||||
OVR2 #f8fe ( arguments for STZ2 at fd and JMP (repeat) ) |
||||
OVR2 #f6fe ( arguments for STZ2 at fd and JMP (repeat) ) |
||||
OVR2 #f401 ( arguments for STZ2 at fd, plus an extra 01 ) |
||||
STHkr ( first argument for ADD2 ) |
||||
.File/success ( argument for DEI2 ) |
||||
#0100 .File/read ( arguments for DEO2 ) |
||||
#ff00 .File/length DEO2 |
||||
#00f0 JMP2 |
||||
|
||||
&zero-page-loader |
||||
( f0 ) DEO2 |
||||
( f1 ) DEI2 |
||||
( f2 ) ADD2 |
||||
( f3 ) &loop DUPr |
||||
( f4 ) STH2k |
||||
( f5 ) STAr |
||||
( f6 ) INC2 |
||||
( f7 ) NEQ2k |
||||
( f8 ) ,&loop |
||||
( f9 ) |
||||
( fa ) JCN |
||||
( fb ) POPr |
||||
( fc ) POP2 |
||||
( fd ) STZ2 ( deletes f4-fd through looping ) |
||||
( fe ) JMP |
||||
( ff ) STZ2 ( deletes fe-ff ) |
||||
|
||||
&tmp $1 |
||||
|
||||
@ -1,428 +0,0 @@
|
||||
( 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 ) |
||||
|
||||
( 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 ) |
||||
JMP2r |
||||
|
||||
@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 ) |
||||
JMP2r |
||||
&hi-set |
||||
SWP POP #08 ADD ( nhi+8 ) |
||||
JMP2r |
||||
|
||||
@bitcount32 ( x** -> n^ ) |
||||
SWP2 ( xlo* xhi* ) |
||||
;bitcount16 JSR2 ( xlo* nhi ) |
||||
DUP #00 NEQ ( xlo* nhi nhi!=0 ) |
||||
,&hi-set JCN ( xlo* nhi ) |
||||
ROT ROT ;bitcount16 JSR2 ADD JMP2r ( nhi+nlo ) |
||||
&hi-set |
||||
ROT ROT POP2 #10 ADD ( nhi+16 ) |
||||
JMP2r |
||||
|
||||
( equality ) |
||||
|
||||
( x == y ) |
||||
@eq32 ( xhi* xlo* yhi* ylo* -> bool^ ) |
||||
ROT2 EQU2 STH |
||||
EQU2 STHr AND JMP2r |
||||
|
||||
( x != y ) |
||||
@ne32 ( xhi* xlo* yhi* ylo* -> bool^ ) |
||||
ROT2 NEQ2 STH |
||||
NEQ2 STHr ORA JMP2r |
||||
|
||||
( x == 0 ) |
||||
@is-zero32 ( x** -> bool^ ) |
||||
ORA2 #0000 EQU2 JMP2r |
||||
|
||||
( x != 0 ) |
||||
@non-zero32 ( x** -> bool^ ) |
||||
ORA2 #0000 NEQ2 JMP2r |
||||
|
||||
( comparisons ) |
||||
|
||||
( x < y ) |
||||
@lt32 ( x** y** -> bool^ ) |
||||
ROT2 SWP2 ( xhi yhi xlo ylo ) |
||||
LTH2 ,<-lo JCN ( xhi yhi ) |
||||
LTH2 JMP2r |
||||
<-lo |
||||
GTH2 #00 EQU JMP2r |
||||
|
||||
( x <= y ) |
||||
@lteq32 ( x** y** -> bool^ ) |
||||
ROT2 SWP2 ( xhi yhi xlo ylo ) |
||||
GTH2 ,>-lo JCN ( xhi yhi ) |
||||
GTH2 #00 EQU JMP2r |
||||
>-lo |
||||
LTH2 JMP2r |
||||
|
||||
( x > y ) |
||||
@gt32 ( x** y** -> bool^ ) |
||||
ROT2 SWP2 ( xhi yhi xlo ylo ) |
||||
GTH2 ,>-lo JCN ( xhi yhi ) |
||||
GTH2 JMP2r |
||||
>-lo |
||||
LTH2 #00 EQU JMP2r |
||||
|
||||
( x > y ) |
||||
@gteq32 ( x** y** -> bool^ ) |
||||
ROT2 SWP2 ( xhi yhi xlo ylo ) |
||||
LTH2 ,<-lo JCN ( xhi yhi ) |
||||
LTH2 #00 EQU JMP2r |
||||
<-lo |
||||
GTH2 JMP2r |
||||
|
||||
( bitwise operations ) |
||||
|
||||
( x & y ) |
||||
@and32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* ) |
||||
ROT2 AND2 STH2 AND2 STH2r JMP2r |
||||
|
||||
( x | y ) |
||||
@or32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* ) |
||||
ROT2 ORA2 STH2 ORA2 STH2r JMP2r |
||||
|
||||
( x ^ y ) |
||||
@xor32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* ) |
||||
ROT2 EOR2 STH2 EOR2 STH2r JMP2r |
||||
|
||||
( ~x ) |
||||
@complement32 ( x** -> ~x** ) |
||||
SWP2 #ffff EOR2 SWP2 #ffff EOR2 JMP2r |
||||
|
||||
( temporary registers ) |
||||
( shared by most operations, except mul32 and div32 ) |
||||
@m32 [ &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 ) |
||||
JMP2r |
||||
|
||||
( shift right by 0-7 bits ) |
||||
@rshift32-0 ( x** n^ -> x<<n ) |
||||
STHk SFT ;m32/z3 STA ( write z3 ) |
||||
#00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 ) |
||||
#00 STHkr SFT2 #00 ;m32/z2 LDA ORA2 ;m32/z1 STA2 ( write z1,z2 ) |
||||
#00 STHr SFT2 #00 ;m32/z1 LDA ORA2 ( compute z0,z1 ) |
||||
;m32/z2 LDA2 |
||||
JMP2r |
||||
|
||||
( shift right by 8-15 bits ) |
||||
@rshift32-1 ( x** n^ -> x<<n ) |
||||
#08 SUB STH POP |
||||
STHkr SFT ;m32/z3 STA ( write z3 ) |
||||
#00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 ) |
||||
#00 STHr SFT2 #00 ;m32/z2 LDA ORA2 ( compute z1,z2 ) |
||||
#00 ROT ROT ;m32/z3 LDA |
||||
JMP2r |
||||
|
||||
( shift right by 16-23 bits ) |
||||
@rshift32-2 ( x** n^ -> x<<n ) |
||||
#10 SUB STH POP2 |
||||
STHkr SFT ;m32/z3 STA ( write z3 ) |
||||
#00 STHr SFT2 #00 ;m32/z3 LDA ORA2 ( compute z2,z3 ) |
||||
#0000 SWP2 |
||||
JMP2r |
||||
|
||||
( 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 |
||||
JMP2r |
||||
|
||||
( 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 ) |
||||
JMP2r |
||||
|
||||
( shift left by 0-7 bits ) |
||||
@lshift32-0 ( x** n^ -> x<<n ) |
||||
#40 SFT STH ( stash n<<4 ) |
||||
#00 SWP STHkr SFT2 ;m32/z2 STA2 ( store z2,z3 ) |
||||
#00 SWP STHkr SFT2 #00 ;m32/z2 LDA ORA2 ;m32/z1 STA2 ( store z1,z2 ) |
||||
#00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 ) |
||||
STHr SFT ;m32/z0 LDA ORA ( calculate z0 ) |
||||
;m32/z1 LDA ;m32/z2 LDA2 |
||||
JMP2r |
||||
|
||||
( 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 ;m32/z1 STA2 ( store z1,z2 ) |
||||
#00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 ) |
||||
STHr SFT ;m32/z0 LDA ORA ( calculate z0 ) |
||||
SWP POP ( x0 unused ) |
||||
;m32/z1 LDA2 #00 |
||||
JMP2r |
||||
|
||||
( 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 ;m32/z0 STA2 ( store z0,z1 ) |
||||
STHr SFT ;m32/z0 LDA ORA ( calculate z0 ) |
||||
STH POP2 STHr |
||||
;m32/z1 LDA #0000 |
||||
JMP2r |
||||
|
||||
( 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 |
||||
JMP2r |
||||
|
||||
( arithmetic ) |
||||
|
||||
( x + y ) |
||||
@add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* ) |
||||
;m32/y2 STA2 ;m32/y0 STA2 ( save ylo, yhi ) |
||||
;m32/x2 STA2 ;m32/x0 STA2 ( save xlo, xhi ) |
||||
#0000 #0000 ;m32/z0 STA2 ;m32/z2 STA2 ( reset zhi, zlo ) |
||||
|
||||
( x3 + y3 => z2z3 ) |
||||
#00 ;m32/x3 LDA #00 ;m32/y3 LDA ADD2 ;m32/z2 STA2 |
||||
|
||||
( x2 + y2 + z2 => z1z2 ) |
||||
#00 ;m32/x2 LDA ;m32/z1 LDA2 ADD2 ;m32/z1 STA2 |
||||
#00 ;m32/y2 LDA ;m32/z1 LDA2 ADD2 ;m32/z1 STA2 |
||||
|
||||
( x1 + y1 + z1 => z0z1 ) |
||||
#00 ;m32/x1 LDA ;m32/z0 LDA2 ADD2 ;m32/z0 STA2 |
||||
#00 ;m32/y1 LDA ;m32/z0 LDA2 ADD2 ;m32/z0 STA2 |
||||
|
||||
( x0 + y0 + z0 => z0 ) |
||||
;m32/x0 LDA ;m32/z0 LDA ADD ;m32/z0 STA |
||||
;m32/y0 LDA ;m32/z0 LDA ADD ;m32/z0 STA |
||||
|
||||
( load zhi,zlo ) |
||||
;m32/z0 LDA2 ;m32/z2 LDA2 |
||||
JMP2r |
||||
|
||||
( -x ) |
||||
@negate32 ( x** -> -x** ) |
||||
;complement32 JSR2 |
||||
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 |
||||
JMP2r |
||||
|
||||
( x - y ) |
||||
@sub32 ( x** y** -> z** ) |
||||
;negate32 JSR2 ;add32 JSR2 JMP2r |
||||
|
||||
( 16-bit multiplication ) |
||||
@mul16 ( x* y* -> z** ) |
||||
;m32/y1 STA ;m32/y0 STA ( save ylo, yhi ) |
||||
;m32/x1 STA ;m32/x0 STA ( save xlo, xhi ) |
||||
#0000 #00 ;m32/z1 STA2 ;m32/z3 STA ( reset z1,z2,z3 ) |
||||
#0000 #00 ;m32/w0 STA2 ;m32/w2 STA ( reset w0,w1,w2 ) |
||||
|
||||
( x1 * y1 => z1z2 ) |
||||
#00 ;m32/x1 LDA #00 ;m32/y1 LDA MUL2 ;m32/z2 STA2 |
||||
|
||||
( x0 * y1 => z0z1 ) |
||||
#00 ;m32/x0 LDA #00 ;m32/y1 LDA MUL2 ;m32/z1 LDA2 ADD2 ;m32/z1 STA2 |
||||
|
||||
( x1 * y0 => w1w2 ) |
||||
#00 ;m32/x1 LDA #00 ;m32/y0 LDA MUL2 ;m32/w1 STA2 |
||||
|
||||
( x0 * y0 => w0w1 ) |
||||
#00 ;m32/x0 LDA #00 ;m32/y0 LDA MUL2 ;m32/w0 LDA2 ADD2 ;m32/w0 STA2 |
||||
|
||||
( add z and a<<8 ) |
||||
#00 ;m32/z1 LDA2 ;m32/z3 LDA |
||||
;m32/w0 LDA2 ;m32/w2 LDA #00 |
||||
;add32 JSR2 |
||||
JMP2r |
||||
|
||||
( 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 |
||||
JMP2r |
||||
[ &x0 $2 &x1 $2 |
||||
&y0 $2 &y1 $2 |
||||
&z0 $2 &z1 $2 ] |
||||
|
||||
@div32 ( x** y** -> q** ) |
||||
;_divmod32 JSR2 |
||||
;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2 |
||||
JMP2r |
||||
|
||||
@mod32 ( x** y** -> r** ) |
||||
;_divmod32 JSR2 |
||||
;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2 |
||||
JMP2r |
||||
|
||||
@divmod32 ( x** y** -> q** r** ) |
||||
;_divmod32 JSR2 |
||||
;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2 |
||||
;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2 |
||||
JMP2r |
||||
|
||||
( 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 JMP2r |
||||
|
||||
( 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 ) |
||||
JMP2r |
||||
|
||||
( greatest common divisor - euclidean algorithm ) |
||||
@gcd32 ( x** y** -> z** ) |
||||
&loop ( x y ) |
||||
OVR2 OVR2 ( x y y ) |
||||
;is-zero32 JSR2 ( x y y=0? ) |
||||
,&done JCN ( x y ) |
||||
OVR2 OVR2 ( 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 |
||||
POP2 POP2 ( x ) |
||||
JMP2r |
||||
@ -1,28 +0,0 @@
|
||||
@strcmp ( a* b* -- a-end* b-end* order nonzero if strings differ |
||||
OR a-end* b-end* 00 00 if strings match ) |
||||
STH2 |
||||
,&entry JMP |
||||
|
||||
&loop ( a* a b / b* ) |
||||
SUB ,&nomatch JCNk ( a* a-b nonzero / b* ) |
||||
POP2 ( a* / b* ) |
||||
INC2 INC2r |
||||
&entry ( a* / b* ) |
||||
LDAk LDAkr STHr ( a* a b / b* ) |
||||
ORAk ,&loop JCN |
||||
|
||||
&nomatch ( a* a-b flag / b* ) |
||||
STH2r SWP2 ( a* b* a-b flag ) |
||||
JMP2r |
||||
|
||||
@strlen ( string-ptr* -- length^ ) |
||||
LIT2r 0000 |
||||
,&entry JMP |
||||
|
||||
&loop |
||||
INC2 INC2r |
||||
&entry |
||||
LDAk ,&loop JCN |
||||
POP2 STH2r |
||||
JMP2r |
||||
|
||||
Loading…
Reference in new issue