This commit is contained in:
~d6 2023-04-29 18:25:08 -07:00
parent 4781d9251b
commit 7fd7623677
4 changed files with 193 additions and 79 deletions

View File

@ -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,7 +218,54 @@
!&loop ( rem-yi yi {shifti div+shifti} )
&done
POP2 POP2 ( {shiftk div} )
POP2r STH2r JMP2r ( 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 )

View File

@ -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,10 +74,10 @@
( [x0, x1] * (-y) -> [x1y, x0y] )
( [x0, x1] * 0 -> [0, 0] )
@iv-scalar-mul ( x** y* -> xy** )
STH2k #0000 GTH2 ?&positive ( x0* x1* [y*] )
SWP2 &positive ( a* b* [y*] )
STH2kr x16-mul SWP2 ( by* a* [y*] )
STH2r x16-mul SWP2 JMP2r ( ay* by* )
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* )
( [x0, x1] * [y0, y1] -> [min[x0y0, x0y1], max[x1y0, x1y1]] )
@iv-mul ( x** y** -> xy** )
@ -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

163
term.tal
View File

@ -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 )
#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,46 +1018,46 @@
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^ )
&loop ( i^ )
.tint LDZ #20 DUP2 ( i^ cell* cell* )
cur-addr STA2 ( i^ cell* ; addr<-cell )
draw-cell ( i^ )
clear-cursor
forward ( i^ )
INC DUP ?&loop ( i+1^ )
POP BRK ( )
cur-addr STA2 ( i^ cell* ; addr<-cell )
draw-cell ( i^ )
clear-cursor ( i^ )
forward ( i^ )
INC DUP ?&loop ( i+1^ )
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