new file mode 100644

@@ -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

new file mode 100644

@@ -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 ,&not-end JCN

+	POP2 JMP2r

+	&not-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

+

new file mode 100644

@@ -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 ,&lt-lo JCN ( xhi yhi )

+    LTH2 RTN

+    &lt-lo

+    GTH2 #00 EQU RTN

+

+( x <= y )

+@lteq32 ( x** y** -> bool^ )

+    ROT2 SWP2 ( xhi yhi xlo ylo )

+    GTH2 ,&gt-lo JCN ( xhi yhi )

+    GTH2 #00 EQU RTN

+    &gt-lo

+    LTH2 RTN

+

+( x > y )

+@gt32 ( x** y** -> bool^ )

+    ROT2 SWP2 ( xhi yhi xlo ylo )

+    GTH2 ,&gt-lo JCN ( xhi yhi )

+    GTH2 RTN

+    &gt-lo

+    LTH2 #00 EQU RTN

+

+( x > y )

+@gteq32 ( x** y** -> bool^ )

+    ROT2 SWP2 ( xhi yhi xlo ylo )

+    LTH2 ,&lt-lo JCN ( xhi yhi )

+    LTH2 #00 EQU RTN

+    &lt-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 ,&not-zero JMP

+    &is-zero

+    #0000 ,&quo0 STR2 #0000 ,&quo1 STR2 RTN

+

+    ( x >= y so the answer is >= 1 )

+    &not-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

new file mode 100644

Binary files /dev/null and b/untitled.chr differ