wip
This commit is contained in:
parent
4781d9251b
commit
7fd7623677
56
fix16.tal
56
fix16.tal
|
|
@ -192,7 +192,7 @@
|
|||
@x16-negate ( x* -> -x* )
|
||||
#0000 SWP2 SUB2 JMP2r
|
||||
|
||||
@x16-mul ( x* y* -> xy* )
|
||||
( @x16-mul ( x* y* -> xy* )
|
||||
DUP #00 EQU ?&rhs-whole
|
||||
SWP2 DUP #00 EQU ?&rhs-whole
|
||||
,&y3 STR ,&y1 STR ,&x3 STR ,&x1 STR
|
||||
|
|
@ -200,9 +200,9 @@
|
|||
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
|
||||
&rhs-whole #08 SFT2 MUL2 JMP2r )
|
||||
|
||||
@x16-div ( x* y* -> x/y* )
|
||||
( @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} )
|
||||
|
|
@ -218,8 +218,55 @@
|
|||
!&loop ( rem-yi yi {shifti div+shifti} )
|
||||
&done
|
||||
POP2 POP2 ( {shiftk div} )
|
||||
POP2r STH2r JMP2r ( div ) )
|
||||
|
||||
@x16-mul ( x* y* -- xy* )
|
||||
;x16-mul-unsigned !x16-signed-op
|
||||
|
||||
@x16-mul-unsigned ( x* y* -- xy* )
|
||||
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
|
||||
LIT2 &a1 00 &al 00 LIT2 &b1 00 &bl 00 MUL2 #08 SFT2
|
||||
LIT2 &a2 00 &ah 00 ,&b1 LDR2 MUL2 ADD2
|
||||
,&a1 LDR2 LIT2 &b2 00 &bh 00 MUL2 ADD2
|
||||
,&a2 LDR2 ,&b2 LDR2 MUL2 #80 SFT2 ADD2
|
||||
JMP2r
|
||||
|
||||
@x16-mul-unsigned-rhs-whole ( x0_x1* y0_00* -- xy* )
|
||||
#08 SFT2 MUL2
|
||||
JMP2r
|
||||
|
||||
@x16-div ( x* y* -- x/y* )
|
||||
;x16-div-unsigned !x16-signed-op
|
||||
|
||||
@x16-div-unsigned ( 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 DUP2 #0000 EQU2 ?&done
|
||||
#01 SFT2 LITr 01 SFT2r ( rem yi [shifti div] )
|
||||
LTH2k ,&loop JCN ( 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-signed-op ( x* y* f* -- f(x,y)* )
|
||||
STH2 LIT2r 0001
|
||||
DUP2 #8000 LTH2 ?&ypos x16-negate SWPr
|
||||
&ypos SWP2 DUP2 #8000 LTH2 ?&xpos x16-negate SWPr
|
||||
&xpos SWP2 SWP2r STH2r JSR2
|
||||
STHr ?&xypos x16-negate &xypos POPr
|
||||
JMP2r
|
||||
|
||||
@x16-quotient ( x* y* -> x//y* )
|
||||
DIV2 #80 SFT2 JMP2r
|
||||
|
||||
|
|
@ -290,6 +337,9 @@
|
|||
x16-pi/2 ADD2 ( fall-thru )
|
||||
|
||||
@x16-sin ( x* -> sin[x]* )
|
||||
DUP2 #8000 LTH2 ?&non-negative
|
||||
x16-negate x16-sin/non-negative !x16-negate
|
||||
&non-negative
|
||||
x16-pi*2 STH2 ( x [2pi] )
|
||||
DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
|
||||
STH2r x16-mul SUB2 ( x' ; 0 <= x' < 2pi )
|
||||
|
|
|
|||
43
interval.tal
43
interval.tal
|
|
@ -21,6 +21,15 @@
|
|||
@iv-is-point ( x** -> bool^ )
|
||||
EQU2 JMP2r
|
||||
|
||||
( )
|
||||
@iv-emit ( x** -> )
|
||||
[ LIT "[ #18 DEO ]
|
||||
SWP2 x16-emit
|
||||
[ LIT ", #18 DEO #20 #18 DEO ]
|
||||
x16-emit
|
||||
[ LIT "] #18 DEO ]
|
||||
JMP2r
|
||||
|
||||
( [x0, x1] | [y0, y1] -> [min[x0,y0], max[x1,y1]] )
|
||||
@iv-union ( x** y** -> x|y** )
|
||||
ROT2 x16-max STH2
|
||||
|
|
@ -42,10 +51,14 @@
|
|||
|
||||
@iv-abs ( x** -> |x|** )
|
||||
OVR2 OVR2 iv-crosses-zero ?&cross
|
||||
DUP2 ORA ?&positive
|
||||
DUP2 #8000 LTH2 ?&positive
|
||||
( negative ) x16-negate SWP2 !x16-negate
|
||||
&positive JMP2r
|
||||
&cross SWP2 x16-negate x16-max #0000 SWP2 JMP2r
|
||||
&cross POP x16-negate #0000 SWP2 JMP2r
|
||||
|
||||
@iv-scalar-add ( x** y* -> x+y** )
|
||||
STH2k x16-add SWP2
|
||||
STH2r x16-add SWP2 JMP2r
|
||||
|
||||
( [x0, x1] + [y0, y1] -> [x0+y0, x1+y1] )
|
||||
@iv-add ( x** y** -> x+y** )
|
||||
|
|
@ -61,7 +74,7 @@
|
|||
( [x0, x1] * (-y) -> [x1y, x0y] )
|
||||
( [x0, x1] * 0 -> [0, 0] )
|
||||
@iv-scalar-mul ( x** y* -> xy** )
|
||||
STH2k #0000 GTH2 ?&positive ( x0* x1* [y*] )
|
||||
STH2k #0000 x16-gt ?&positive ( x0* x1* [y*] )
|
||||
SWP2 &positive ( a* b* [y*] )
|
||||
STH2kr x16-mul SWP2 ( by* a* [y*] )
|
||||
STH2r x16-mul SWP2 JMP2r ( ay* by* )
|
||||
|
|
@ -75,4 +88,28 @@
|
|||
iv-scalar-mul STH2r STH2r ( b0* b1* a0* a1* )
|
||||
!iv-union ( a|b** )
|
||||
|
||||
@iv-square ( x** -> xx** )
|
||||
iv-abs OVR2 OVR2 !iv-mul
|
||||
|
||||
@iv-pow ( x** k^ -> x^k** )
|
||||
DUP #00 EQU ?&one
|
||||
DUP #01 EQU ?&id
|
||||
DUP #02 EQU ?&square
|
||||
DUP #01 AND ?&odd
|
||||
#01 SFT iv-pow OVR2 OVR2 !iv-mul
|
||||
&one POP POP2 POP2 #0100 DUP2 JMP2r
|
||||
&id POP JMP2r
|
||||
&square POP !iv-square
|
||||
&odd #01 SUB STH OVR2 OVR2 STHr iv-pow !iv-mul
|
||||
|
||||
( FIXME: not reliable )
|
||||
@iv-sin ( x** -> sin[x]** )
|
||||
x16-sin SWP2 x16-sin
|
||||
OVR2 OVR2 x16-lt JMP SWP2 JMP2r
|
||||
|
||||
( FIXME: not reliable )
|
||||
@iv-cos ( x** -> sin[x]** )
|
||||
x16-cos SWP2 x16-cos
|
||||
OVR2 OVR2 x16-lt JMP SWP2 JMP2r
|
||||
|
||||
~fix16.tal
|
||||
|
|
|
|||
153
term.tal
153
term.tal
|
|
@ -99,7 +99,6 @@
|
|||
@saved-x $2 ( saved x coordinate )
|
||||
@saved-y $2 ( saved y coordinate )
|
||||
@col-bytes $2 ( 2*cols )
|
||||
@debug $1 ( use debug log? )
|
||||
@lastmouse-x $2 ( last mouse x )
|
||||
@lastmouse-y $2 ( last mouse y )
|
||||
@lastmouse-st $1 ( last mouse press )
|
||||
|
|
@ -120,21 +119,26 @@
|
|||
@paste $1 ( 01: bracketed paste is on, 00: is off )
|
||||
|
||||
( user configuration )
|
||||
@visual-bell $1
|
||||
@border-pad $2 ( should be 0000 or 0010 )
|
||||
@debug $1 ( use debug log? )
|
||||
@show-banner $1 ( show banner on startup? )
|
||||
@visual-bell $1 ( flash visual bell? otherwise do nothing )
|
||||
@border-pad $2 ( use border? should be 0000 or 0010 )
|
||||
|
||||
|0100
|
||||
( metadata )
|
||||
;meta .System/metadata DEO2
|
||||
;meta/name .System/title DEO2
|
||||
|
||||
( 80 cols x 24 rows )
|
||||
( user configuration defaults )
|
||||
#01 .debug STZ
|
||||
#01 .show-banner STZ
|
||||
#0010 .border-pad STZ2
|
||||
#01 .visual-bell STZ
|
||||
|
||||
( 80 cols x 24 rows by default )
|
||||
#0018 .rows STZ2
|
||||
#0050 .cols STZ2
|
||||
|
||||
( #0010 .border-pad STZ2 )
|
||||
#0000 .border-pad STZ2
|
||||
|
||||
( start cursor at origin - including border )
|
||||
.border-pad LDZ2 .Screen/x DEO2
|
||||
.border-pad LDZ2 .Screen/y DEO2
|
||||
|
|
@ -144,31 +148,38 @@
|
|||
#07bf .System/g DEO2
|
||||
#07bf .System/b DEO2
|
||||
|
||||
( set up interrupts )
|
||||
;redraw .Screen/vect DEO2 ( set up screen )
|
||||
;on-key .Controller/vect DEO2 ( set up keyboard )
|
||||
;on-mouse .Mouse/vect DEO2 ( set up mouse )
|
||||
;on-read .Console/vect DEO2 ( set up stdin )
|
||||
load-theme ( optional theme sets colors/dimensions )
|
||||
|
||||
( load theme to override colors and maybe dimension )
|
||||
load-theme
|
||||
;on-redraw .Screen/vect DEO2 ( set up screen callback )
|
||||
;on-key .Controller/vect DEO2 ( set up keyboard callback )
|
||||
;on-mouse .Mouse/vect DEO2 ( set up mouse callback )
|
||||
;on-read .Console/vect DEO2 ( set up stdin callback )
|
||||
|
||||
( these only work with a patched uxnemu )
|
||||
( on other emulators they should be no-ops )
|
||||
setup-subprocess ( set up experimental subprocess support )
|
||||
reset-terminal ( initialize terminal state and settings )
|
||||
setup-debugging ( set up debugging if requested )
|
||||
draw-banner ( draw banner if requested )
|
||||
|
||||
BRK
|
||||
|
||||
( these only work with a patched uxnemu )
|
||||
( on other emulators they should be no-ops )
|
||||
@setup-subprocess ( -> )
|
||||
;shell .Console/exec DEO2 ( set up bash subprocess )
|
||||
#80 .Console/mode DEO ( start bash subprocess )
|
||||
JMP2r
|
||||
|
||||
( initialize terminal state and settings )
|
||||
reset-terminal
|
||||
|
||||
( set to 01 to enable debug log )
|
||||
#00 .debug STZ
|
||||
|
||||
.debug LDZ ?&continue BRK &continue
|
||||
#99 #010e DEO
|
||||
@setup-debugging ( -> )
|
||||
.debug LDZ ?&continue JMP2r &continue
|
||||
#99 #010e DEO ( put 99 in wst so #010e DEO reliably logs )
|
||||
;debug-log .File1/name DEO2
|
||||
#01 .File1/append DEO
|
||||
BRK
|
||||
JMP2r
|
||||
|
||||
@draw-banner ( -> )
|
||||
redraw ;banner-ascii
|
||||
&loop LDAk DUP ?&ok POP POP2 JMP2r
|
||||
&ok read INC2 !&loop
|
||||
|
||||
@reset-terminal ( -> )
|
||||
( set initial cursor )
|
||||
|
|
@ -194,9 +205,6 @@
|
|||
( prepare for initial draw )
|
||||
init-screen
|
||||
|
||||
( user defaults )
|
||||
#01 .visual-bell STZ
|
||||
|
||||
( draw border )
|
||||
.border-pad LDZ2 ORA ?draw-border
|
||||
JMP2r
|
||||
|
|
@ -310,7 +318,10 @@
|
|||
&loop ( 04 sprite^ [-count] )
|
||||
DEOk INC2r STH2kr ORA ?&loop POP2r JMP2r
|
||||
|
||||
@redraw ( -> BRK )
|
||||
@on-redraw ( -> )
|
||||
redraw BRK
|
||||
|
||||
@redraw ( -> )
|
||||
.pointer-ttl LDZ #00 EQU ?&pointer-ok ( )
|
||||
.pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok
|
||||
#01 .dirty STZ ( redraw without pointer )
|
||||
|
|
@ -329,10 +340,10 @@
|
|||
INC2 GTH2k ?&yloop
|
||||
POP2 POP2 POP2r
|
||||
.is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally
|
||||
&flashing .flash LDZ #00 EQU ?&pointer flash-bell draw-cursor BRK
|
||||
&flashing .flash LDZ #00 EQU ?&pointer flash-bell !draw-cursor
|
||||
&pointer draw-pointer
|
||||
&finally draw-cursor #00 .dirty STZ
|
||||
&done BRK
|
||||
&done JMP2r
|
||||
|
||||
@flash-bell ( -> )
|
||||
.flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
|
||||
|
|
@ -983,17 +994,22 @@
|
|||
POP reset-args ;on-read-osc .Console/vect DEO2 BRK
|
||||
|
||||
@on-read ( -> BRK )
|
||||
.Console/r DEI
|
||||
.Console/r DEI read BRK
|
||||
|
||||
@read ( c^ -> )
|
||||
DUP debug-read
|
||||
DUP ?&ok POP BRK
|
||||
DUP ?&ok POP JMP2r
|
||||
&ok
|
||||
DUP #20 LTH ?read-ctrl
|
||||
DUP #7f EQU ?read-del
|
||||
( fall through to draw )
|
||||
|
||||
@draw ( c^ -> )
|
||||
.tint LDZ SWP DUP2 insert-cell draw-cell
|
||||
.cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ
|
||||
clear-cursor forward BRK
|
||||
clear-cursor !forward
|
||||
|
||||
@read-ctrl ( c^ -> BRK )
|
||||
@read-ctrl ( c^ -> )
|
||||
DUP #07 EQU ?read-bel
|
||||
DUP #08 EQU ?read-bs
|
||||
DUP #09 EQU ?read-tab
|
||||
|
|
@ -1002,23 +1018,23 @@
|
|||
DUP #0c EQU ?read-lf
|
||||
DUP #0d EQU ?read-cr
|
||||
DUP #1b EQU ?read-esc
|
||||
POP BRK
|
||||
POP JMP2r
|
||||
|
||||
@read-bel ( 07 -> BRK )
|
||||
@read-bel ( 07 -> )
|
||||
POP .visual-bell LDZ #00 EQU ?&done
|
||||
#06 .flash STZ #01 .dirty STZ
|
||||
&done BRK
|
||||
&done JMP2r
|
||||
|
||||
@read-bs ( 08 -> BRK )
|
||||
POP clear-cursor #0001 back-n BRK
|
||||
@read-bs ( 08 -> )
|
||||
POP clear-cursor #0001 !back-n
|
||||
|
||||
@read-esc ( 1b -> BRK )
|
||||
POP ;on-read-esc .Console/vect DEO2 BRK
|
||||
@read-esc ( 1b -> )
|
||||
POP ;on-read-esc .Console/vect DEO2 JMP2r
|
||||
|
||||
@read-del ( 7f -> BRK )
|
||||
POP BRK
|
||||
@read-del ( 7f -> )
|
||||
POP JMP2r
|
||||
|
||||
@read-tab ( 09 -> BRK )
|
||||
@read-tab ( 09 -> )
|
||||
POP
|
||||
.cur-x LDZ2 ( x* )
|
||||
NIP #07 AND #08 SUB ( i=(xlo&7)-8^ )
|
||||
|
|
@ -1026,22 +1042,22 @@
|
|||
.tint LDZ #20 DUP2 ( i^ cell* cell* )
|
||||
cur-addr STA2 ( i^ cell* ; addr<-cell )
|
||||
draw-cell ( i^ )
|
||||
clear-cursor
|
||||
clear-cursor ( i^ )
|
||||
forward ( i^ )
|
||||
INC DUP ?&loop ( i+1^ )
|
||||
POP BRK ( )
|
||||
POP JMP2r ( )
|
||||
|
||||
@cr ( -> )
|
||||
clear-cursor #0000 .cur-x STZ2 !draw-cursor
|
||||
|
||||
@read-cr ( 0d -> BRK )
|
||||
POP .cur-wrap LDZ ?&skip cr &skip BRK
|
||||
@read-cr ( 0d -> )
|
||||
POP .cur-wrap LDZ ?&skip cr &skip JMP2r
|
||||
|
||||
@at-max-x ( -> true? ) .cur-x LDZ2 .max-x LDZ2 EQU2 JMP2r
|
||||
@at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
|
||||
|
||||
@read-lf ( 0a -> BRK )
|
||||
POP lf BRK
|
||||
@read-lf ( 0a -> )
|
||||
POP !lf
|
||||
|
||||
@lf ( -> )
|
||||
.cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
|
||||
|
|
@ -1083,8 +1099,7 @@
|
|||
&scrolling !scroll
|
||||
|
||||
@insert-cell ( cell* -> )
|
||||
( DUP #20 EQU ?&space ) ( cell* )
|
||||
maybe-autowrap ( &space ) ( cell* )
|
||||
maybe-autowrap ( cell* )
|
||||
.irm LDZ #00 EQU ?&replace ( cell* )
|
||||
cur-addr ( cell* lim* )
|
||||
eol-addr #0002 SUB2 ( cell* lim* last=eol-2* )
|
||||
|
|
@ -1238,17 +1253,16 @@
|
|||
INCr STHkr ?&loop
|
||||
POPr POP2 POP2 JMP2r
|
||||
|
||||
( emit a short as a decimal )
|
||||
( emit a signed short as a decimal )
|
||||
@emit-sdec2 ( n* -> )
|
||||
DUP2k #1f SFT2 EQUk ?&s LIT2 "- 18 DEO
|
||||
&s MUL2 SUB2 ( fall-through to emit-dec2 )
|
||||
|
||||
( emit an unsigned short as a decimal )
|
||||
@emit-dec2 ( n* -> )
|
||||
LITr 00 ( n [0] )
|
||||
&read ( n [k] )
|
||||
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
|
||||
ORAk ?&read
|
||||
POP2 ( top element was 0000 )
|
||||
&write ( n0 n1 ... nk [k+1] )
|
||||
NIP #30 ADD .Console/w DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )
|
||||
STHkr ?&write
|
||||
POPr JMP2r
|
||||
LITr ff00 &read #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&read
|
||||
POP2 &write NIP #30 ADD #18 DEO OVRr ADDr STHkr ?&write
|
||||
POP2r JMP2r
|
||||
|
||||
@debug-log "debug_term.log 00
|
||||
@scratch $40 &pos $2
|
||||
|
|
@ -1281,6 +1295,19 @@
|
|||
( device mask ) 41 0d07
|
||||
( 24x24 icon ) 83 =icon-2-bit
|
||||
|
||||
@banner-ascii
|
||||
0d 0a
|
||||
20 20 c9 cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd bb 0d 0a
|
||||
20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
|
||||
20 20 ba 20 20 "d "e "t "e "r "m 20 20 "v "1 "0 20 20 ba 0d 0a
|
||||
20 20 ba 20 20 20 20 "b "y 20 "d "_ "m 20 20 20 20 20 ba 0d 0a
|
||||
20 20 ba 20 20 "1 "8 20 "m "a "r 20 "2 "0 "2 "3 20 20 ba 0d 0a
|
||||
20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
|
||||
20 20 c8 cd cd cb cd cd cd cd cd cd cd cd cd cb cd cd bc 0d 0a
|
||||
20 20 c9 cb cb ce cb cb cb cb cb cb cb cb cb ce cb cb bb 0d 0a
|
||||
20 20 c8 ca ca ca ca ca ca ca ca ca ca ca ca ca ca ca bc 0d 0a
|
||||
0d 0a 00
|
||||
|
||||
@icon-2-bit
|
||||
00 00 00 1f 3f 38 32 34 00 00 00 00 00 07 0f 0f
|
||||
00 00 00 ff ff 00 00 00 00 00 00 00 00 ff ff ff
|
||||
|
|
|
|||
Loading…
Reference in New Issue