graph debugging

This commit is contained in:
~d6 2023-05-09 09:06:43 -04:00
parent 4f1afb1cb8
commit 8946619b1a
2 changed files with 29 additions and 50 deletions

View File

@ -174,6 +174,9 @@
@x16-gt ( x* y* -> x<y^ ) x16-cmp #01 EQU JMP2r @x16-gt ( x* y* -> x<y^ ) x16-cmp #01 EQU JMP2r
@x16-gteq ( x* y* -> x<y^ ) x16-cmp [ #ff NEQ ] JMP2r @x16-gteq ( x* y* -> x<y^ ) x16-cmp [ #ff NEQ ] JMP2r
@unsigned-min ( x* y* -> min* )
LTH2k JMP SWP2 POP2 JMP2r
@x16-min ( x* y* -> min[x, y]* ) @x16-min ( x* y* -> min[x, y]* )
OVR2 OVR2 x16-lt JMP SWP2 POP2 JMP2r OVR2 OVR2 x16-lt JMP SWP2 POP2 JMP2r
@ -192,50 +195,24 @@
@x16-negate ( x* -> -x* ) @x16-negate ( x* -> -x* )
#0000 SWP2 SUB2 JMP2r #0000 SWP2 SUB2 JMP2r
( @x16-mul ( x* y* -> xy* )
DUP #00 EQU ?&rhs-whole
SWP2 DUP #00 EQU ?&rhs-whole
,&y3 STR ,&y1 STR ,&x3 STR ,&x1 STR
LIT2 &x2 00 &x3 00 LIT2 &y2 00 &y3 00 MUL2 #08 SFT2
LIT2 &x0 00 &x1 00 ,&y2 LDR2 MUL2 ADD2
,&x2 LDR2 LIT2 &y0 00 &y1 00 MUL2 ADD2
,&x0 LDR2 ,&y0 LDR2 MUL2 #80 SFT2 ADD2 JMP2r
&rhs-whole #08 SFT2 MUL2 JMP2r )
( @x16-div ( x* y* -> x/y* )
DIV2k STH2k ( x y x/y {x/y} )
LITr 80 SFT2r ( x y x/y {div=(x/y)<<8 )
OVR2 STH2 ( x y x/y {y div} )
MUL2 SUB2 ( x%y {y div} )
STH2r LIT2r 0100 ( x%y y {0100 div} )
( we know x%y < y, so start right-shifting y )
&loop
ORAk #00 EQU ?&done
#01 SFT2 LITr 01 SFT2r ( rem yi {shifti div} )
LTH2k ?&loop ( rem yi {shifti div} )
SWP2 OVR2 SUB2 SWP2 ( rem-yi yi {shifti div} )
DUP2r ROT2r ADD2r SWP2r ( rem-yi yi {shifti div+shifti} )
!&loop ( rem-yi yi {shifti div+shifti} )
&done
POP2 POP2 ( {shiftk div} )
POP2r STH2r JMP2r ( div ) )
@x16-mul ( x* y* -- xy* ) @x16-mul ( x* y* -- xy* )
;x16-mul-unsigned !x16-signed-op ;x16-mul-unsigned !x16-signed-op
@x16-mul-unsigned ( x* y* -- xy* ) @x16-mul-unsigned ( x* y* -- xy* )
DUP #00 EQU ?x16-mul-unsigned-rhs-whole DUP #00 EQU ?x16-mul-unsigned-rhs-whole
SWP2 DUP #00 EQU ?x16-mul-unsigned-rhs-whole SWP2 DUP #00 EQU ?x16-mul-unsigned-rhs-whole
,&al STR ,&ah STR ,&bl STR ,&bh STR ,&y0 STR2 ,&x0 STR2
LIT2 &a1 00 &al 00 LIT2 &b1 00 &bl 00 MUL2 #08 SFT2 #00 ,&x0 LDR #00 ,&y0 LDR MUL2 ( acc* )
LIT2 &a2 00 &ah 00 ,&b1 LDR2 MUL2 ADD2 OVR ?&overflow SWP ( acc* )
,&a1 LDR2 LIT2 &b2 00 &bh 00 MUL2 ADD2 #00 ,&x1 LDR #00 ,&y0 LDR MUL2 ADD2 ( acc* )
,&a2 LDR2 ,&b2 LDR2 MUL2 #80 SFT2 ADD2 #00 ,&x0 LDR #00 ,&y1 LDR MUL2 ADD2 ( acc* )
JMP2r #00 ,&x1 LDR #00 ,&y1 LDR MUL2 #08 SFT2 ADD2 ( acc* )
DUP2 #7fff GTH2 ?&overflow
JMP2r [ &x0 $1 &x1 $1 &y0 $1 &y1 $1 ]
&overflow POP2 #7fff JMP2r
@x16-mul-unsigned-rhs-whole ( x0_x1* y0_00* -- xy* ) @x16-mul-unsigned-rhs-whole ( x0_x1* y0_00* -- xy* )
#08 SFT2 MUL2 #08 SFT2 MUL2 #7fff !unsigned-min
JMP2r
@x16-div ( x* y* -- x/y* ) @x16-div ( x* y* -- x/y* )
;x16-div-unsigned !x16-signed-op ;x16-div-unsigned !x16-signed-op
@ -259,7 +236,7 @@
POP2 POP2 ( [shiftk div] ) POP2 POP2 ( [shiftk div] )
POP2r STH2r JMP2r ( div ) POP2r STH2r JMP2r ( div )
@x16-signed-op ( x* y* f* -- f(x,y)* ) @x16-signed-op ( x* y* f* -> f(x,y)* )
STH2 LIT2r 0001 STH2 LIT2r 0001
DUP2 #8000 LTH2 ?&ypos x16-negate SWPr DUP2 #8000 LTH2 ?&ypos x16-negate SWPr
&ypos SWP2 DUP2 #8000 LTH2 ?&xpos x16-negate SWPr &ypos SWP2 DUP2 #8000 LTH2 ?&xpos x16-negate SWPr

View File

@ -50,9 +50,18 @@
@y1 $2 ( upper bound of y ) @y1 $2 ( upper bound of y )
|0100 |0100
( default settings: -4.0 to +4.0 )
( #fc00 DUP2 .xmin STZ2 .ymin STZ2
#0400 DUP2 .xmax STZ2 .ymax STZ2 )
#0800
DUP2 .xmax STZ2 DUP2 .ymax STZ2
#0000 SWP2 SUB2
DUP2 .xmin STZ2 .ymin STZ2
( screen size ) ( screen size )
#0200 .width STZ2 #0200 x-range min .width STZ2
#0200 .height STZ2 #0200 y-range min .height STZ2
( colors ) ( colors )
#0f0f .System/r DEO2 #0f0f .System/r DEO2
@ -63,15 +72,6 @@
.width LDZ2 .Screen/w DEO2 .width LDZ2 .Screen/w DEO2
.height LDZ2 .Screen/h DEO2 .height LDZ2 .Screen/h DEO2
( default settings: -4.0 to +4.0 )
( #fc00 DUP2 .xmin STZ2 .ymin STZ2
#0400 DUP2 .xmax STZ2 .ymax STZ2 )
#0400
DUP2 .xmax STZ2 DUP2 .ymax STZ2
#0000 SWP2 SUB2
DUP2 .xmin STZ2 .ymin STZ2
( TODO: we probably want separate epsilons for x and y ) ( TODO: we probably want separate epsilons for x and y )
( TODO: validate that (xmax-xmin)*eps = width exactly ) ( TODO: validate that (xmax-xmin)*eps = width exactly )
x-range .width LDZ2 DIV2 .epsilon STZ2 x-range .width LDZ2 DIV2 .epsilon STZ2
@ -89,6 +89,8 @@
( graph the equation ) ( graph the equation )
draw BRK draw BRK
@min ( x* y* -> min* ) LTH2k JMP SWP2 POP2 JMP2r
@x-range ( -> x-range* ) .xmax LDZ2 .xmin LDZ2 SUB2 JMP2r @x-range ( -> x-range* ) .xmax LDZ2 .xmin LDZ2 SUB2 JMP2r
@y-range ( -> y-range* ) .ymax LDZ2 .ymin LDZ2 SUB2 JMP2r @y-range ( -> y-range* ) .ymax LDZ2 .ymin LDZ2 SUB2 JMP2r
@ -147,8 +149,8 @@
OVR2 OVR2 evaluate ?&hit ( x* y* [s*] ) OVR2 OVR2 evaluate ?&hit ( x* y* [s*] )
POP2 POP2 POP2r JMP2r ( ; miss ) POP2 POP2 POP2r JMP2r ( ; miss )
&hit ( x* y* [s*] ) &hit ( x* y* [s*] )
STH2kr #0001 EQU2 ?&term ( x* y* [s*] ) ( STH2kr #0001 EQU2 ?&term ( x* y* [s*] ) )
( STH2kr .epsilon LDZ2 LTH2 ?&term ( x* y* [s*] ) ) STH2kr .epsilon LDZ2 LTH2 ?&term ( x* y* [s*] )
LITr 01 SFT2r ( x* y* [h=s/2*] ) LITr 01 SFT2r ( x* y* [h=s/2*] )
OVR2 OVR2 ( x* y* x* y* h* [h*] ) OVR2 OVR2 ( x* y* x* y* h* [h*] )
STH2kr draw ( x* y* [h*] ; south west ) STH2kr draw ( x* y* [h*] ; south west )