diff --git a/projects/library/binary-tree.tal b/projects/library/binary-tree.tal deleted file mode 100644 index f15629e..0000000 --- a/projects/library/binary-tree.tal +++ /dev/null @@ -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 - diff --git a/projects/library/check-rom.tal b/projects/library/check-rom.tal deleted file mode 100644 index 141cf8f..0000000 --- a/projects/library/check-rom.tal +++ /dev/null @@ -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 - diff --git a/projects/library/load-rom.tal b/projects/library/load-rom.tal deleted file mode 100644 index b345ac9..0000000 --- a/projects/library/load-rom.tal +++ /dev/null @@ -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 - diff --git a/projects/library/math32.tal b/projects/library/math32.tal deleted file mode 100644 index 4107697..0000000 --- a/projects/library/math32.tal +++ /dev/null @@ -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< 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< x< x< x< x< x< x< x< x< x< 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< cur ) - #0000 #0001 ROT2 POP - ;lshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2 - - ( div< 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 diff --git a/projects/library/string.tal b/projects/library/string.tal deleted file mode 100644 index 5678725..0000000 --- a/projects/library/string.tal +++ /dev/null @@ -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 -