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* ) @x16-negate ( x* -> -x* )
#0000 SWP2 SUB2 JMP2r #0000 SWP2 SUB2 JMP2r
@x16-mul ( x* y* -> xy* ) ( @x16-mul ( x* y* -> xy* )
DUP #00 EQU ?&rhs-whole DUP #00 EQU ?&rhs-whole
SWP2 DUP #00 EQU ?&rhs-whole SWP2 DUP #00 EQU ?&rhs-whole
,&y3 STR ,&y1 STR ,&x3 STR ,&x1 STR ,&y3 STR ,&y1 STR ,&x3 STR ,&x1 STR
@ -200,9 +200,9 @@
LIT2 &x0 00 &x1 00 ,&y2 LDR2 MUL2 ADD2 LIT2 &x0 00 &x1 00 ,&y2 LDR2 MUL2 ADD2
,&x2 LDR2 LIT2 &y0 00 &y1 00 MUL2 ADD2 ,&x2 LDR2 LIT2 &y0 00 &y1 00 MUL2 ADD2
,&x0 LDR2 ,&y0 LDR2 MUL2 #80 SFT2 ADD2 JMP2r ,&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} ) DIV2k STH2k ( x y x/y {x/y} )
LITr 80 SFT2r ( x y x/y {div=(x/y)<<8 ) LITr 80 SFT2r ( x y x/y {div=(x/y)<<8 )
OVR2 STH2 ( x y x/y {y div} ) OVR2 STH2 ( x y x/y {y div} )
@ -218,7 +218,54 @@
!&loop ( rem-yi yi {shifti div+shifti} ) !&loop ( rem-yi yi {shifti div+shifti} )
&done &done
POP2 POP2 ( {shiftk div} ) 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* ) @x16-quotient ( x* y* -> x//y* )
DIV2 #80 SFT2 JMP2r DIV2 #80 SFT2 JMP2r
@ -290,6 +337,9 @@
x16-pi/2 ADD2 ( fall-thru ) x16-pi/2 ADD2 ( fall-thru )
@x16-sin ( x* -> sin[x]* ) @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] ) x16-pi*2 STH2 ( x [2pi] )
DUP2 STH2kr x16-quotient ( x x/2pi [2pi] ) DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
STH2r x16-mul SUB2 ( x' ; 0 <= x' < 2pi ) STH2r x16-mul SUB2 ( x' ; 0 <= x' < 2pi )

View File

@ -21,6 +21,15 @@
@iv-is-point ( x** -> bool^ ) @iv-is-point ( x** -> bool^ )
EQU2 JMP2r 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]] ) ( [x0, x1] | [y0, y1] -> [min[x0,y0], max[x1,y1]] )
@iv-union ( x** y** -> x|y** ) @iv-union ( x** y** -> x|y** )
ROT2 x16-max STH2 ROT2 x16-max STH2
@ -42,10 +51,14 @@
@iv-abs ( x** -> |x|** ) @iv-abs ( x** -> |x|** )
OVR2 OVR2 iv-crosses-zero ?&cross OVR2 OVR2 iv-crosses-zero ?&cross
DUP2 ORA ?&positive DUP2 #8000 LTH2 ?&positive
( negative ) x16-negate SWP2 !x16-negate ( negative ) x16-negate SWP2 !x16-negate
&positive JMP2r &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] ) ( [x0, x1] + [y0, y1] -> [x0+y0, x1+y1] )
@iv-add ( x** y** -> x+y** ) @iv-add ( x** y** -> x+y** )
@ -61,10 +74,10 @@
( [x0, x1] * (-y) -> [x1y, x0y] ) ( [x0, x1] * (-y) -> [x1y, x0y] )
( [x0, x1] * 0 -> [0, 0] ) ( [x0, x1] * 0 -> [0, 0] )
@iv-scalar-mul ( x** y* -> xy** ) @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*] ) SWP2 &positive ( a* b* [y*] )
STH2kr x16-mul SWP2 ( by* a* [y*] ) STH2kr x16-mul SWP2 ( by* a* [y*] )
STH2r x16-mul SWP2 JMP2r ( ay* by* ) STH2r x16-mul SWP2 JMP2r ( ay* by* )
( [x0, x1] * [y0, y1] -> [min[x0y0, x0y1], max[x1y0, x1y1]] ) ( [x0, x1] * [y0, y1] -> [min[x0y0, x0y1], max[x1y0, x1y1]] )
@iv-mul ( x** y** -> xy** ) @iv-mul ( x** y** -> xy** )
@ -75,4 +88,28 @@
iv-scalar-mul STH2r STH2r ( b0* b1* a0* a1* ) iv-scalar-mul STH2r STH2r ( b0* b1* a0* a1* )
!iv-union ( a|b** ) !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 ~fix16.tal

163
term.tal
View File

@ -99,7 +99,6 @@
@saved-x $2 ( saved x coordinate ) @saved-x $2 ( saved x coordinate )
@saved-y $2 ( saved y coordinate ) @saved-y $2 ( saved y coordinate )
@col-bytes $2 ( 2*cols ) @col-bytes $2 ( 2*cols )
@debug $1 ( use debug log? )
@lastmouse-x $2 ( last mouse x ) @lastmouse-x $2 ( last mouse x )
@lastmouse-y $2 ( last mouse y ) @lastmouse-y $2 ( last mouse y )
@lastmouse-st $1 ( last mouse press ) @lastmouse-st $1 ( last mouse press )
@ -120,21 +119,26 @@
@paste $1 ( 01: bracketed paste is on, 00: is off ) @paste $1 ( 01: bracketed paste is on, 00: is off )
( user configuration ) ( user configuration )
@visual-bell $1 @debug $1 ( use debug log? )
@border-pad $2 ( should be 0000 or 0010 ) @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 |0100
( metadata ) ( metadata )
;meta .System/metadata DEO2 ;meta .System/metadata DEO2
;meta/name .System/title 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 #0018 .rows STZ2
#0050 .cols STZ2 #0050 .cols STZ2
( #0010 .border-pad STZ2 )
#0000 .border-pad STZ2
( start cursor at origin - including border ) ( start cursor at origin - including border )
.border-pad LDZ2 .Screen/x DEO2 .border-pad LDZ2 .Screen/x DEO2
.border-pad LDZ2 .Screen/y DEO2 .border-pad LDZ2 .Screen/y DEO2
@ -144,31 +148,38 @@
#07bf .System/g DEO2 #07bf .System/g DEO2
#07bf .System/b DEO2 #07bf .System/b DEO2
( set up interrupts ) load-theme ( optional theme sets colors/dimensions )
;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 to override colors and maybe dimension ) ;on-redraw .Screen/vect DEO2 ( set up screen callback )
load-theme ;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 ) setup-subprocess ( set up experimental subprocess support )
( on other emulators they should be no-ops ) 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 ) ;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 ) @setup-debugging ( -> )
reset-terminal .debug LDZ ?&continue JMP2r &continue
#99 #010e DEO ( put 99 in wst so #010e DEO reliably logs )
( set to 01 to enable debug log )
#00 .debug STZ
.debug LDZ ?&continue BRK &continue
#99 #010e DEO
;debug-log .File1/name DEO2 ;debug-log .File1/name DEO2
#01 .File1/append DEO #01 .File1/append DEO
BRK JMP2r
@draw-banner ( -> )
redraw ;banner-ascii
&loop LDAk DUP ?&ok POP POP2 JMP2r
&ok read INC2 !&loop
@reset-terminal ( -> ) @reset-terminal ( -> )
( set initial cursor ) ( set initial cursor )
@ -194,9 +205,6 @@
( prepare for initial draw ) ( prepare for initial draw )
init-screen init-screen
( user defaults )
#01 .visual-bell STZ
( draw border ) ( draw border )
.border-pad LDZ2 ORA ?draw-border .border-pad LDZ2 ORA ?draw-border
JMP2r JMP2r
@ -310,7 +318,10 @@
&loop ( 04 sprite^ [-count] ) &loop ( 04 sprite^ [-count] )
DEOk INC2r STH2kr ORA ?&loop POP2r JMP2r DEOk INC2r STH2kr ORA ?&loop POP2r JMP2r
@redraw ( -> BRK ) @on-redraw ( -> )
redraw BRK
@redraw ( -> )
.pointer-ttl LDZ #00 EQU ?&pointer-ok ( ) .pointer-ttl LDZ #00 EQU ?&pointer-ok ( )
.pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok .pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok
#01 .dirty STZ ( redraw without pointer ) #01 .dirty STZ ( redraw without pointer )
@ -329,10 +340,10 @@
INC2 GTH2k ?&yloop INC2 GTH2k ?&yloop
POP2 POP2 POP2r POP2 POP2 POP2r
.is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally .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 &pointer draw-pointer
&finally draw-cursor #00 .dirty STZ &finally draw-cursor #00 .dirty STZ
&done BRK &done JMP2r
@flash-bell ( -> ) @flash-bell ( -> )
.flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 ) .flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
@ -983,17 +994,22 @@
POP reset-args ;on-read-osc .Console/vect DEO2 BRK POP reset-args ;on-read-osc .Console/vect DEO2 BRK
@on-read ( -> BRK ) @on-read ( -> BRK )
.Console/r DEI .Console/r DEI read BRK
@read ( c^ -> )
DUP debug-read DUP debug-read
DUP ?&ok POP BRK DUP ?&ok POP JMP2r
&ok &ok
DUP #20 LTH ?read-ctrl DUP #20 LTH ?read-ctrl
DUP #7f EQU ?read-del DUP #7f EQU ?read-del
( fall through to draw )
@draw ( c^ -> )
.tint LDZ SWP DUP2 insert-cell draw-cell .tint LDZ SWP DUP2 insert-cell draw-cell
.cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ .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 #07 EQU ?read-bel
DUP #08 EQU ?read-bs DUP #08 EQU ?read-bs
DUP #09 EQU ?read-tab DUP #09 EQU ?read-tab
@ -1002,46 +1018,46 @@
DUP #0c EQU ?read-lf DUP #0c EQU ?read-lf
DUP #0d EQU ?read-cr DUP #0d EQU ?read-cr
DUP #1b EQU ?read-esc DUP #1b EQU ?read-esc
POP BRK POP JMP2r
@read-bel ( 07 -> BRK ) @read-bel ( 07 -> )
POP .visual-bell LDZ #00 EQU ?&done POP .visual-bell LDZ #00 EQU ?&done
#06 .flash STZ #01 .dirty STZ #06 .flash STZ #01 .dirty STZ
&done BRK &done JMP2r
@read-bs ( 08 -> BRK ) @read-bs ( 08 -> )
POP clear-cursor #0001 back-n BRK POP clear-cursor #0001 !back-n
@read-esc ( 1b -> BRK ) @read-esc ( 1b -> )
POP ;on-read-esc .Console/vect DEO2 BRK POP ;on-read-esc .Console/vect DEO2 JMP2r
@read-del ( 7f -> BRK ) @read-del ( 7f -> )
POP BRK POP JMP2r
@read-tab ( 09 -> BRK ) @read-tab ( 09 -> )
POP POP
.cur-x LDZ2 ( x* ) .cur-x LDZ2 ( x* )
NIP #07 AND #08 SUB ( i=(xlo&7)-8^ ) NIP #07 AND #08 SUB ( i=(xlo&7)-8^ )
&loop ( i^ ) &loop ( i^ )
.tint LDZ #20 DUP2 ( i^ cell* cell* ) .tint LDZ #20 DUP2 ( i^ cell* cell* )
cur-addr STA2 ( i^ cell* ; addr<-cell ) cur-addr STA2 ( i^ cell* ; addr<-cell )
draw-cell ( i^ ) draw-cell ( i^ )
clear-cursor clear-cursor ( i^ )
forward ( i^ ) forward ( i^ )
INC DUP ?&loop ( i+1^ ) INC DUP ?&loop ( i+1^ )
POP BRK ( ) POP JMP2r ( )
@cr ( -> ) @cr ( -> )
clear-cursor #0000 .cur-x STZ2 !draw-cursor clear-cursor #0000 .cur-x STZ2 !draw-cursor
@read-cr ( 0d -> BRK ) @read-cr ( 0d -> )
POP .cur-wrap LDZ ?&skip cr &skip BRK POP .cur-wrap LDZ ?&skip cr &skip JMP2r
@at-max-x ( -> true? ) .cur-x LDZ2 .max-x LDZ2 EQU2 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 @at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
@read-lf ( 0a -> BRK ) @read-lf ( 0a -> )
POP lf BRK POP !lf
@lf ( -> ) @lf ( -> )
.cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r .cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
@ -1083,8 +1099,7 @@
&scrolling !scroll &scrolling !scroll
@insert-cell ( cell* -> ) @insert-cell ( cell* -> )
( DUP #20 EQU ?&space ) ( cell* ) maybe-autowrap ( cell* )
maybe-autowrap ( &space ) ( cell* )
.irm LDZ #00 EQU ?&replace ( cell* ) .irm LDZ #00 EQU ?&replace ( cell* )
cur-addr ( cell* lim* ) cur-addr ( cell* lim* )
eol-addr #0002 SUB2 ( cell* lim* last=eol-2* ) eol-addr #0002 SUB2 ( cell* lim* last=eol-2* )
@ -1238,17 +1253,16 @@
INCr STHkr ?&loop INCr STHkr ?&loop
POPr POP2 POP2 JMP2r 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* -> ) @emit-dec2 ( n* -> )
LITr 00 ( n [0] ) LITr ff00 &read #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&read
&read ( n [k] ) POP2 &write NIP #30 ADD #18 DEO OVRr ADDr STHkr ?&write
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] ) POP2r JMP2r
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
@debug-log "debug_term.log 00 @debug-log "debug_term.log 00
@scratch $40 &pos $2 @scratch $40 &pos $2
@ -1281,6 +1295,19 @@
( device mask ) 41 0d07 ( device mask ) 41 0d07
( 24x24 icon ) 83 =icon-2-bit ( 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 @icon-2-bit
00 00 00 1f 3f 38 32 34 00 00 00 00 00 07 0f 0f 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 00 00 00 ff ff 00 00 00 00 00 00 00 00 ff ff ff