d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

merge

This commit is contained in:
~d6 2022-09-10 22:09:15 -04:00
parent 0ac1521813 bd6b2641dd
commit 4b9c5d1845
5 changed files with 152 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
femto.tal
View File

@ -27,28 +27,28 @@
( emit macros ) ( emit macros )
( ) ( )
( these save one byte and are easier to read. ) ( these save one byte and are easier to read. )
%emit-! { LIT2 '! 18 DEO } %emit-! { LIT2 "! 18 DEO }
%emit-$ { LIT2 '$ 18 DEO } %emit-$ { LIT2 "$ 18 DEO }
%emit-lpar { LIT2 28 18 DEO } %emit-lpar { LIT2 28 18 DEO }
%emit-rpar { LIT2 29 18 DEO } %emit-rpar { LIT2 29 18 DEO }
%emit-, { LIT2 ', 18 DEO } %emit-, { LIT2 ", 18 DEO }
%emit-0 { LIT2 '0 18 DEO } %emit-0 { LIT2 "0 18 DEO }
%emit-1 { LIT2 '1 18 DEO } %emit-1 { LIT2 "1 18 DEO }
%emit-2 { LIT2 '2 18 DEO } %emit-2 { LIT2 "2 18 DEO }
%emit-3 { LIT2 '3 18 DEO } %emit-3 { LIT2 "3 18 DEO }
%emit-6 { LIT2 '6 18 DEO } %emit-6 { LIT2 "6 18 DEO }
%emit-7 { LIT2 '7 18 DEO } %emit-7 { LIT2 "7 18 DEO }
%emit-: { LIT2 ': 18 DEO } %emit-: { LIT2 ": 18 DEO }
%emit-; { LIT2 '; 18 DEO } %emit-; { LIT2 "; 18 DEO }
%emit-C { LIT2 'C 18 DEO } %emit-C { LIT2 "C 18 DEO }
%emit-H { LIT2 'H 18 DEO } %emit-H { LIT2 "H 18 DEO }
%emit-J { LIT2 'J 18 DEO } %emit-J { LIT2 "J 18 DEO }
%emit-K { LIT2 'K 18 DEO } %emit-K { LIT2 "K 18 DEO }
%emit-[ { LIT2 '[ 18 DEO } %emit-[ { LIT2 "[ 18 DEO }
%emit-] { LIT2 '] 18 DEO } %emit-] { LIT2 "] 18 DEO }
%emit-m { LIT2 'm 18 DEO } %emit-m { LIT2 "m 18 DEO }
%emit-n { LIT2 'n 18 DEO } %emit-n { LIT2 "n 18 DEO }
%emit-~ { LIT2 '~ 18 DEO } %emit-~ { LIT2 "~ 18 DEO }
%quit! { #01 .System/halt DEO BRK } %quit! { #01 .System/halt DEO BRK }
%lmargin { #0006 } %lmargin { #0006 }
@ -198,7 +198,7 @@
.Console/read DEI .state/key STZ .Console/read DEI .state/key STZ
.state/key LDZ .tmp/pos LDZ2 STA .state/key LDZ .tmp/pos LDZ2 STA
.tmp/pos LDZ2 INC2 .tmp/pos STZ2 .tmp/pos LDZ2 INC2 .tmp/pos STZ2
.state/key LDZ LIT 'R EQU ;parse-terminal-size JCN2 .state/key LDZ LIT "R EQU ;parse-terminal-size JCN2
BRK BRK
( parse and store terminal size information ) ( parse and store terminal size information )
@ -207,18 +207,18 @@
@parse-terminal-size ( -> ) @parse-terminal-size ( -> )
#0000 ,&acc STR2 #0000 ,&acc STR2
.tmp/data LDZk #1b NEQ ,&parse-error JCN ( i ) INC .tmp/data LDZk #1b NEQ ,&parse-error JCN ( i ) INC
LDZk LIT '[ NEQ ,&parse-error JCN ( i ) INC LDZk LIT "[ NEQ ,&parse-error JCN ( i ) INC
&loop &loop
LDZk LIT '; EQU ,&parse-col JCN LDZk LIT "; EQU ,&parse-col JCN
LIT2r :&loop ,&read JMP LIT2r :&loop ,&read JMP
&parse-col &parse-col
INC ,&acc LDR2 #0002 SUB2 .term/rows STZ2 INC ,&acc LDR2 #0002 SUB2 .term/rows STZ2
#0000 ,&acc STR2 #0000 ,&acc STR2
&loop2 &loop2
LDZk LIT 'R EQU ,&done JCN LDZk LIT "R EQU ,&done JCN
LIT2r :&loop2 ,&read JMP LIT2r :&loop2 ,&read JMP
&read &read
LDZk LIT '0 SUB #00 SWP LDZk LIT "0 SUB #00 SWP
,&acc LDR2 #000a MUL2 ADD2 ,&acc STR2 ,&acc LDR2 #000a MUL2 ADD2 ,&acc STR2
INC JMP2r INC JMP2r
&done &done
@ -444,8 +444,8 @@
( callback executed in response to the quit prompt. ) ( callback executed in response to the quit prompt. )
@do-quit @do-quit
.tmp/data LDZ LIT 'n EQU ;quit-now JCN2 .tmp/data LDZ LIT "n EQU ;quit-now JCN2
.tmp/data LDZ LIT 'y EQU ;save JCN2 .tmp/data LDZ LIT "y EQU ;save JCN2
#00 .state/quitting STZ #00 .state/quitting STZ
;messages/unknown-input ;tmp/data ;send-message JSR2 ;messages/unknown-input ;tmp/data ;send-message JSR2
BRK BRK
@ -571,10 +571,10 @@
LDAk ,&continue JCN LDAk ,&continue JCN
POP2 STH2r #01 JMP2r POP2 STH2r #01 JMP2r
&continue &continue
LDAk LIT '0 LTH ,&fail JCN LDAk LIT "0 LTH ,&fail JCN
LDAk LIT '9 GTH ,&fail JCN LDAk LIT "9 GTH ,&fail JCN
LIT2r 000a MUL2r LIT2r 000a MUL2r
LDAk LIT '0 SUB #00 SWP STH2 ADD2r LDAk LIT "0 SUB #00 SWP STH2 ADD2r
INC2 ,&loop JMP INC2 ,&loop JMP
&fail &fail
POP2r #00 JMP2r POP2r #00 JMP2r
@ -790,17 +790,17 @@
( TODO: maybe M-% for search&replace ) ( TODO: maybe M-% for search&replace )
@on-key-escaped ( -> ) @on-key-escaped ( -> )
#00 .state/saw-esc STZ #00 .state/saw-esc STZ
.state/key LDZ LIT '< EQU ( M-< ) ;goto-start JCN2 .state/key LDZ LIT "< EQU ( M-< ) ;goto-start JCN2
.state/key LDZ LIT '> EQU ( M-> ) ;goto-end JCN2 .state/key LDZ LIT "> EQU ( M-> ) ;goto-end JCN2
.state/key LDZ LIT 'b EQU ( M-b ) ;back-by-word JCN2 .state/key LDZ LIT "b EQU ( M-b ) ;back-by-word JCN2
.state/key LDZ LIT 'c EQU ( M-c ) ;toggle-color JCN2 .state/key LDZ LIT "c EQU ( M-c ) ;toggle-color JCN2
.state/key LDZ LIT 'f EQU ( M-f ) ;forward-by-word JCN2 .state/key LDZ LIT "f EQU ( M-f ) ;forward-by-word JCN2
.state/key LDZ LIT 'g EQU ( M-g ) ;goto-line JCN2 .state/key LDZ LIT "g EQU ( M-g ) ;goto-line JCN2
.state/key LDZ LIT 's EQU ( M-s ) ;regex-search JCN2 .state/key LDZ LIT "s EQU ( M-s ) ;regex-search JCN2
.state/key LDZ LIT 't EQU ( M-t ) ;toggle-tabs JCN2 .state/key LDZ LIT "t EQU ( M-t ) ;toggle-tabs JCN2
.state/key LDZ LIT 'u EQU ( M-u ) ;undo JCN2 .state/key LDZ LIT "u EQU ( M-u ) ;undo JCN2
.state/key LDZ LIT 'v EQU ( M-v ) ;page-up JCN2 .state/key LDZ LIT "v EQU ( M-v ) ;page-up JCN2
.state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2 .state/key LDZ LIT "[ EQU ( M-[ ) ;xterm JCN2
BRK BRK
( set our input to expect xterm control sequences ) ( set our input to expect xterm control sequences )
@ -821,24 +821,24 @@
( the relevant action. ) ( the relevant action. )
@on-key-vt ( -> ) @on-key-vt ( -> )
.state/saw-vt LDZk STH #00 SWP STZ .state/saw-vt LDZk STH #00 SWP STZ
.state/key LDZ LIT '~ EQU ,&ok JCN .state/key LDZ LIT "~ EQU ,&ok JCN
POPr BRK POPr BRK
&ok &ok
STHr DUP LIT '1 NEQ ,&not-1 JCN STHr DUP LIT "1 NEQ ,&not-1 JCN
( ^[[1~ -> home ) POP ;bol JMP2 ( ^[[1~ -> home ) POP ;bol JMP2
&not-1 DUP LIT '2 NEQ ,&not-2 JCN &not-1 DUP LIT "2 NEQ ,&not-2 JCN
( ^[[2~ -> insert ) POP BRK ( ^[[2~ -> insert ) POP BRK
&not-2 DUP LIT '3 NEQ ,&not-3 JCN &not-2 DUP LIT "3 NEQ ,&not-3 JCN
( ^[[3~ -> delete ) POP ;delete JMP2 ( ^[[3~ -> delete ) POP ;delete JMP2
&not-3 DUP LIT '4 NEQ ,&not-4 JCN &not-3 DUP LIT "4 NEQ ,&not-4 JCN
( ^[[4~ -> end ) POP ;eol JMP2 ( ^[[4~ -> end ) POP ;eol JMP2
&not-4 DUP LIT '5 NEQ ,&not-5 JCN &not-4 DUP LIT "5 NEQ ,&not-5 JCN
( ^[[5~ -> page up ) POP ;page-up JMP2 ( ^[[5~ -> page up ) POP ;page-up JMP2
&not-5 DUP LIT '6 NEQ ,&not-6 JCN &not-5 DUP LIT "6 NEQ ,&not-6 JCN
( ^[[6~ -> page down ) POP ;page-down JMP2 ( ^[[6~ -> page down ) POP ;page-down JMP2
&not-6 DUP LIT '7 NEQ ,&not-7 JCN &not-6 DUP LIT "7 NEQ ,&not-7 JCN
( ^[[7~ -> home ) POP ;bol JMP2 ( ^[[7~ -> home ) POP ;bol JMP2
&not-7 DUP LIT '8 NEQ ,&not-8 JCN &not-7 DUP LIT "8 NEQ ,&not-8 JCN
( ^[[8~ -> end ) POP ;eol JMP2 ( ^[[8~ -> end ) POP ;eol JMP2
&not-8 &not-8
( ??? ) POP BRK ( ??? ) POP BRK
@ -851,14 +851,14 @@
( to continue (or end) the sequence. ) ( to continue (or end) the sequence. )
@on-key-xterm ( -> ) @on-key-xterm ( -> )
#00 .state/saw-xterm STZ #00 .state/saw-xterm STZ
.state/key LDZ LIT 'A EQU ( ^[[A -> up ) ;up JCN2 .state/key LDZ LIT "A EQU ( ^[[A -> up ) ;up JCN2
.state/key LDZ LIT 'B EQU ( ^[[B -> down ) ;down JCN2 .state/key LDZ LIT "B EQU ( ^[[B -> down ) ;down JCN2
.state/key LDZ LIT 'C EQU ( ^[[C -> right ) ;forward JCN2 .state/key LDZ LIT "C EQU ( ^[[C -> right ) ;forward JCN2
.state/key LDZ LIT 'D EQU ( ^[[D -> left ) ;back JCN2 .state/key LDZ LIT "D EQU ( ^[[D -> left ) ;back JCN2
.state/key LDZ LIT 'F EQU ( ^[[F -> end ) ;eol JCN2 .state/key LDZ LIT "F EQU ( ^[[F -> end ) ;eol JCN2
.state/key LDZ LIT 'H EQU ( ^[[H -> home ) ;bol JCN2 .state/key LDZ LIT "H EQU ( ^[[H -> home ) ;bol JCN2
.state/key LDZ LIT '0 LTH ;ignore JCN2 .state/key LDZ LIT "0 LTH ;ignore JCN2
.state/key LDZ LIT '8 GTH ;ignore JCN2 .state/key LDZ LIT "8 GTH ;ignore JCN2
.state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 ) .state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 )
BRK BRK
@ -1158,7 +1158,7 @@
emit-, emit-,
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2 .cursor/row LDZ2 INC2 ;emit-dec2 JSR2
emit-rpar sp emit-[ emit-rpar sp emit-[
LIT 's .config/insert-tabs LDZ ADD emit LIT "s .config/insert-tabs LDZ ADD emit
emit-] sp emit-] sp
;messages/help-msg ;print JSR2 ;messages/help-msg ;print JSR2
;emit-reset JMP2 ;emit-reset JMP2
@ -1303,17 +1303,17 @@
( ANSI control sequence to get the cursor position ) ( ANSI control sequence to get the cursor position )
( ESC [ 6 n ) ( ESC [ 6 n )
@term-get-cursor-position ( -> ) @term-get-cursor-position ( -> )
LIT2 00 'n LIT '6 ,ansi-emit JMP LIT2 00 "n LIT "6 ,ansi-emit JMP
( ANSI control sequence to erase entire screen ) ( ANSI control sequence to erase entire screen )
( ESC [ 2 J ) ( ESC [ 2 J )
@term-erase-all ( -> ) @term-erase-all ( -> )
LIT2 00 'J LIT '2 ,ansi-emit JMP LIT2 00 "J LIT "2 ,ansi-emit JMP
( ANSI control sequence to erase the current line ) ( ANSI control sequence to erase the current line )
( ESC [ 2 K ) ( ESC [ 2 K )
@term-erase-line ( -> ) @term-erase-line ( -> )
LIT2 00 'K LIT '2 ,ansi-emit JMP LIT2 00 "K LIT "2 ,ansi-emit JMP
@ansi-emit ( 00 cn ... c1 c0 -> ) @ansi-emit ( 00 cn ... c1 c0 -> )
LITr 18 ( Console/write ) LITr 18 ( Console/write )
@ -1323,11 +1323,11 @@
( ESC [ 3 1 m ) ( ESC [ 3 1 m )
@emit-red ( -> ) @emit-red ( -> )
LIT2 00 'm LIT2 '1 '3 ,ansi-emit JMP LIT2 00 "m LIT2 "1 "3 ,ansi-emit JMP
( ESC [ 0 m ) ( ESC [ 0 m )
@emit-reset ( -> ) @emit-reset ( -> )
#00 LIT2 'm '0 ,ansi-emit JMP #00 LIT2 "m "0 ,ansi-emit JMP
( ESC [ 1 m $ ESC [ 0 m ) ( ESC [ 1 m $ ESC [ 0 m )
@emit-red-dollar ( -> ) @emit-red-dollar ( -> )
@ -1336,15 +1336,15 @@
( ESC [ 3 $x ; 7 m ) ( ESC [ 3 $x ; 7 m )
( $x is 0-7 ) ( $x is 0-7 )
@emit-color-reverse ( -> ) @emit-color-reverse ( -> )
LIT2 00 'm LIT2 '7 '; .config/color LDZ2 ,ansi-emit JMP LIT2 00 "m LIT2 "7 "; .config/color LDZ2 ,ansi-emit JMP
@emit-color ( -> ) @emit-color ( -> )
LIT2 00 'm .config/color LDZ2 ,ansi-emit JMP LIT2 00 "m .config/color LDZ2 ,ansi-emit JMP
( ESC [ 3 $x ; 1 m ) ( ESC [ 3 $x ; 1 m )
( $x is 0-7 ) ( $x is 0-7 )
@emit-color-bold ( -> ) @emit-color-bold ( -> )
LIT2 00 'm LIT2 '1 '; .config/color LDZ2 ,ansi-emit JMP LIT2 00 "m LIT2 "1 "; .config/color LDZ2 ,ansi-emit JMP
@draw-all ( -> ) @draw-all ( -> )
;term-erase-all JSR2 ;term-erase-all JSR2

35
math32.tal
View File

@ -54,11 +54,6 @@
( - mul32 memory, 12 bytes ) ( - mul32 memory, 12 bytes )
( - _divmod32 memory, 16 bytes ) ( - _divmod32 memory, 16 bytes )
%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 ) ( bitcount: number of bits needed to represent number )
( equivalent to floor[log2[x]] + 1 ) ( equivalent to floor[log2[x]] + 1 )
@ -82,7 +77,7 @@
SWP ;bitcount8 JSR2 ADD ( nhi+nlo ) SWP ;bitcount8 JSR2 ADD ( nhi+nlo )
JMP2r JMP2r
&hi-set &hi-set
SWP POP #08 ADD ( nhi+8 ) NIP #08 ADD ( nhi+8 )
JMP2r JMP2r
@bitcount32 ( x** -> n^ ) @bitcount32 ( x** -> n^ )
@ -90,9 +85,9 @@
;bitcount16 JSR2 ( xlo* nhi ) ;bitcount16 JSR2 ( xlo* nhi )
DUP #00 NEQ ( xlo* nhi nhi!=0 ) DUP #00 NEQ ( xlo* nhi nhi!=0 )
,&hi-set JCN ( xlo* nhi ) ,&hi-set JCN ( xlo* nhi )
TOR ;bitcount16 JSR2 ADD JMP2r ( nhi+nlo ) ROT ROT ;bitcount16 JSR2 ADD JMP2r ( nhi+nlo )
&hi-set &hi-set
TOR POP2 #10 ADD ( nhi+16 ) ROT ROT POP2 #10 ADD ( nhi+16 )
JMP2r JMP2r
( equality ) ( equality )
@ -113,7 +108,7 @@
( x != 0 ) ( x != 0 )
@non-zero32 ( x** -> bool^ ) @non-zero32 ( x** -> bool^ )
ORA2 #0000 NEQ2 JMP2r ORA2 ORA JMP2r
( comparisons ) ( comparisons )
@ -165,7 +160,7 @@
( ~x ) ( ~x )
@complement32 ( x** -> ~x** ) @complement32 ( x** -> ~x** )
COMPLEMENT32 JMP2r SWP2 #ffff EOR2 SWP2 #ffff EOR2 JMP2r
( temporary registers ) ( temporary registers )
( shared by most operations, except mul32 and div32 ) ( shared by most operations, except mul32 and div32 )
@ -198,7 +193,7 @@
STHkr SFT ;m32/z3 STA ( write z3 ) STHkr SFT ;m32/z3 STA ( write z3 )
#00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 ) #00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 )
#00 STHr SFT2 #00 ;m32/z2 LDA ORA2 ( compute z1,z2 ) #00 STHr SFT2 #00 ;m32/z2 LDA ORA2 ( compute z1,z2 )
#00 TOR ;m32/z3 LDA #00 ROT ROT ;m32/z3 LDA
JMP2r JMP2r
( shift right by 16-23 bits ) ( shift right by 16-23 bits )
@ -239,7 +234,7 @@
#00 SWP STHkr SFT2 ;m32/z1 STA2 ( store z1,z2 ) #00 SWP STHkr SFT2 ;m32/z1 STA2 ( store z1,z2 )
#00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 ) #00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 )
STHr SFT ;m32/z0 LDA ORA ( calculate z0 ) STHr SFT ;m32/z0 LDA ORA ( calculate z0 )
SWP POP ( x0 unused ) NIP ( x0 unused )
;m32/z1 LDA2 #00 ;m32/z1 LDA2 #00
JMP2r JMP2r
@ -256,7 +251,7 @@
@lshift32-3 ( x** n^ -> x<<n ) @lshift32-3 ( x** n^ -> x<<n )
#18 SUB #40 SFT ( x0 x1 x2 x3 r=[n-24]<<4 ) #18 SUB #40 SFT ( x0 x1 x2 x3 r=[n-24]<<4 )
SFT ( x0 x1 x2 x3<<r ) SFT ( x0 x1 x2 x3<<r )
SWP2 POP2 SWP POP #0000 #00 NIP2 NIP #0000 #00
JMP2r JMP2r
( arithmetic ) ( arithmetic )
@ -265,7 +260,7 @@
@add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* ) @add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* )
;m32/y2 STA2 ;m32/y0 STA2 ( save ylo, yhi ) ;m32/y2 STA2 ;m32/y0 STA2 ( save ylo, yhi )
;m32/x2 STA2 ;m32/x0 STA2 ( save xlo, xhi ) ;m32/x2 STA2 ;m32/x0 STA2 ( save xlo, xhi )
#0000 #0000 ;m32/z0 STA2 ;m32/z2 STA2 ( reset zhi, zlo ) #0000 DUP2 ;m32/z0 STA2 ;m32/z2 STA2 ( reset zhi, zlo )
( x3 + y3 => z2z3 ) ( x3 + y3 => z2z3 )
#00 ;m32/x3 LDA #00 ;m32/y3 LDA ADD2 ;m32/z2 STA2 #00 ;m32/x3 LDA #00 ;m32/y3 LDA ADD2 ;m32/z2 STA2
@ -288,9 +283,9 @@
( -x ) ( -x )
@negate32 ( x** -> -x** ) @negate32 ( x** -> -x** )
COMPLEMENT32 ;complement32 JSR2 ( ~x** )
INC2 ( ~xhi -xlo ) INC2 ( ~xhi -xlo )
DUP2 #0000 NEQ2 ( ~xhi -xlo non-zero? ) DUP2 ORA ( ~xhi -xlo non-zero? )
,&done JCN ( xlo non-zero => don't inc hi ) ,&done JCN ( xlo non-zero => don't inc hi )
SWP2 INC2 SWP2 ( -xhi -xlo ) SWP2 INC2 SWP2 ( -xhi -xlo )
&done &done
@ -380,7 +375,7 @@
#00 DUP2 ( shift 0 shift 0 ) #00 DUP2 ( shift 0 shift 0 )
( 1<<shift -> cur ) ( 1<<shift -> cur )
#0000 #0001 ROT2 POP #0000 INC2k ROT2 POP
;lshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2 ;lshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2
( div<<shift -> div ) ( div<<shift -> div )
@ -412,10 +407,10 @@
( greatest common divisor - euclidean algorithm ) ( greatest common divisor - euclidean algorithm )
@gcd32 ( x** y** -> z** ) @gcd32 ( x** y** -> z** )
&loop ( x y ) &loop ( x y )
DUP4 ( x y y ) OVR2 OVR2 ( x y y )
;is-zero32 JSR2 ( x y y=0? ) ;is-zero32 JSR2 ( x y y=0? )
,&done JCN ( x y ) ,&done JCN ( x y )
DUP4 ( x y y ) OVR2 OVR2 ( x y y )
STH2 STH2 ( x y [y] ) STH2 STH2 ( x y [y] )
;mod32 JSR2 ( r=x%y [y] ) ;mod32 JSR2 ( r=x%y [y] )
STH2r ( rhi rlo yhi [ylo] ) STH2r ( rhi rlo yhi [ylo] )
@ -426,5 +421,5 @@
ROT2 ( yhi ylo rhi rlo ) ROT2 ( yhi ylo rhi rlo )
,&loop JMP ,&loop JMP
&done &done
POP4 ( x ) POP2 POP2 ( x )
JMP2r JMP2r

62
regex.tal
View File

@ -98,7 +98,7 @@
( using error! will print the given message before causing ) ( using error! will print the given message before causing )
( the interpreter to halt. ) ( the interpreter to halt. )
@error!! ( msg* -> ) @error!! ( msg* -> )
LIT '! emit! space LIT "! emit! space
&loop LDAk #00 EQU ,&done JCN &loop LDAk #00 EQU ,&done JCN
LDAk emit! INC2 ,&loop JMP LDAk emit! INC2 ,&loop JMP
&done POP2 newline #ff0e DEO #010f DEO BRK &done POP2 newline #ff0e DEO #010f DEO BRK
@ -334,15 +334,15 @@
( is pos currently pointing to a star? ) ( is pos currently pointing to a star? )
@peek-to-star ( -> is-star^ ) @peek-to-star ( -> is-star^ )
;pos LDA2 LDA LIT '* EQU JMP2r ;pos LDA2 LDA LIT "* EQU JMP2r
( is pos currently pointing to a plus? ) ( is pos currently pointing to a plus? )
@peek-to-plus ( -> is-plus^ ) @peek-to-plus ( -> is-plus^ )
;pos LDA2 LDA LIT '+ EQU JMP2r ;pos LDA2 LDA LIT "+ EQU JMP2r
( is pos currently pointing to a qmark? ) ( is pos currently pointing to a qmark? )
@peek-to-qmark ( -> is-qmark^ ) @peek-to-qmark ( -> is-qmark^ )
;pos LDA2 LDA LIT '? EQU JMP2r ;pos LDA2 LDA LIT "? EQU JMP2r
( just increment pos ) ( just increment pos )
@skip @skip
@ -390,18 +390,18 @@
@compile-region-loop @compile-region-loop
;read JSR2 ;read JSR2
DUP #00 EQU ;c-done JCN2 DUP #00 EQU ;c-done JCN2
DUP LIT '| EQU ;c-or JCN2 DUP LIT "| EQU ;c-or JCN2
DUP LIT '. EQU ;c-dot JCN2 DUP LIT ". EQU ;c-dot JCN2
DUP LIT '^ EQU ;c-caret JCN2 DUP LIT "^ EQU ;c-caret JCN2
DUP LIT '$ EQU ;c-dollar JCN2 DUP LIT "$ EQU ;c-dollar JCN2
DUP LIT '( EQU ;c-lpar JCN2 DUP LIT "( EQU ;c-lpar JCN2
DUP LIT ') EQU ;c-rpar JCN2 DUP LIT ") EQU ;c-rpar JCN2
DUP LIT '[ EQU ;c-lbrk JCN2 DUP LIT "[ EQU ;c-lbrk JCN2
DUP LIT '] EQU ;c-rbrk JCN2 DUP LIT "] EQU ;c-rbrk JCN2
DUP LIT '\ EQU ;c-esc JCN2 DUP LIT "\ EQU ;c-esc JCN2
DUP LIT '* EQU ;c-star JCN2 DUP LIT "* EQU ;c-star JCN2
DUP LIT '+ EQU ;c-plus JCN2 DUP LIT "+ EQU ;c-plus JCN2
DUP LIT '? EQU ;c-qmark JCN2 DUP LIT "? EQU ;c-qmark JCN2
;c-char JMP2 ;c-char JMP2
( either finalize the given r0/r1 or else wrap it in ) ( either finalize the given r0/r1 or else wrap it in )
@ -473,22 +473,22 @@
( doesn't currently handle "special" escapes such as \n ) ( doesn't currently handle "special" escapes such as \n )
@c-lbrk ( c^ -> r2* ) @c-lbrk ( c^ -> r2* )
POP LITr 00 ;pos LDA2 ( pos [0] ) POP LITr 00 ;pos LDA2 ( pos [0] )
LDAk LIT '^ NEQ ,&normal JCN INCr INC2 ( pos [negated?^] ) LDAk LIT "^ NEQ ,&normal JCN INCr INC2 ( pos [negated?^] )
&normal &normal
#0a STHr ADD ( src* type^ ) #0a STHr ADD ( src* type^ )
;arena-pos LDA2 STH2k ( src* type^ dst* [dst*] ) ;arena-pos LDA2 STH2k ( src* type^ dst* [dst*] )
STA LIT2r 0004 ADD2r ( src* [dst+4] ) STA LIT2r 0004 ADD2r ( src* [dst+4] )
&left-parse ( src* [dst*] ) &left-parse ( src* [dst*] )
LDAk LIT '] EQU ,&done JCN LDAk LIT "] EQU ,&done JCN
LDAk LIT '- EQU ,&error JCN LDAk LIT "- EQU ,&error JCN
LDAk LIT '\ NEQ ,&left JCN INC2 LDAk LIT "\ NEQ ,&left JCN INC2
&left &left
LDAk STH2kr STA INC2r LDAk STH2kr STA INC2r
DUP2 INC2 LDA LIT '- NEQ ,&pre-right JCN INC2 INC2 DUP2 INC2 LDA LIT "- NEQ ,&pre-right JCN INC2 INC2
LDAk LIT '] EQU ,&error JCN LDAk LIT "] EQU ,&error JCN
LDAk LIT '- EQU ,&error JCN LDAk LIT "- EQU ,&error JCN
&pre-right &pre-right
LDAk LIT '\ NEQ ,&right JCN INC2 LDAk LIT "\ NEQ ,&right JCN INC2
&right &right
LDAk STH2kr STA INC2 INC2r ,&left-parse JMP LDAk STH2kr STA INC2 INC2r ,&left-parse JMP
&done ( src* [dst*] ) &done ( src* [dst*] )
@ -537,13 +537,13 @@
( otherwise, allocates a literal of the next character. ) ( otherwise, allocates a literal of the next character. )
@c-esc ( c^ -> r2* ) @c-esc ( c^ -> r2* )
POP ;read JSR2 POP ;read JSR2
DUP LIT 'a EQU ,&bel JCN DUP LIT "a EQU ,&bel JCN
DUP LIT 'b EQU ,&bs JCN DUP LIT "b EQU ,&bs JCN
DUP LIT 't EQU ,&tab JCN DUP LIT "t EQU ,&tab JCN
DUP LIT 'n EQU ,&nl JCN DUP LIT "n EQU ,&nl JCN
DUP LIT 'v EQU ,&vtab JCN DUP LIT "v EQU ,&vtab JCN
DUP LIT 'f EQU ,&ff JCN DUP LIT "f EQU ,&ff JCN
DUP LIT 'r EQU ,&cr JCN DUP LIT "r EQU ,&cr JCN
&default ;c-char JMP2 &default ;c-char JMP2
&bel POP #07 ,&default JMP &bel POP #07 ,&default JMP
&bs POP #08 ,&default JMP &bs POP #08 ,&default JMP

19
test-math32.py
View File

@ -5,6 +5,7 @@ from os import environ
from random import randint from random import randint
from subprocess import Popen, PIPE, run from subprocess import Popen, PIPE, run
u1 = {'sz': 1, 'fmt': b'%02x'}
u3 = {'sz': 1 << 3, 'fmt': b'%02x'} u3 = {'sz': 1 << 3, 'fmt': b'%02x'}
u5 = {'sz': 1 << 5, 'fmt': b'%02x'} u5 = {'sz': 1 << 5, 'fmt': b'%02x'}
u8 = {'sz': 1 << 8, 'fmt': b'%02x'} u8 = {'sz': 1 << 8, 'fmt': b'%02x'}
@ -28,6 +29,8 @@ def testcase(p, sym, args, out, f):
expected = fmt(out, z) expected = fmt(out, z)
if got == expected: if got == expected:
return None return None
elif out == u1 and bool(got) == bool(expected):
return None
else: else:
res = {'got': got, 'expected': expected} res = {'got': got, 'expected': expected}
for name, _, x in vals: for name, _, x in vals:
@ -76,14 +79,14 @@ def main():
test(p, trials, b'^', [('x', u32), ('y', u32)], u32, lambda x, y: x ^ y) test(p, trials, b'^', [('x', u32), ('y', u32)], u32, lambda x, y: x ^ y)
test(p, trials, b'~', [('x', u32)], u32, lambda x: ~x) test(p, trials, b'~', [('x', u32)], u32, lambda x: ~x)
test(p, trials, b'N', [('x', u32)], u32, lambda x: -x) test(p, trials, b'N', [('x', u32)], u32, lambda x: -x)
test(p, trials, b'=', [('x', u32), ('y', u32)], u8, lambda x, y: int(x == y)) test(p, trials, b'=', [('x', u32), ('y', u32)], u1, lambda x, y: int(x == y))
test(p, trials, b'!', [('x', u32), ('y', u32)], u8, lambda x, y: int(x != y)) test(p, trials, b'!', [('x', u32), ('y', u32)], u1, lambda x, y: int(x != y))
test(p, trials, b'0', [('x', u32)], u8, lambda x: int(x == 0)) test(p, trials, b'0', [('x', u32)], u1, lambda x: int(x == 0))
test(p, trials, b'Z', [('x', u32)], u8, lambda x: int(x != 0)) test(p, trials, b'Z', [('x', u32)], u1, lambda x: int(x != 0))
test(p, trials, b'<', [('x', u32), ('y', u32)], u8, lambda x, y: int(x < y)) test(p, trials, b'<', [('x', u32), ('y', u32)], u1, lambda x, y: int(x < y))
test(p, trials, b'>', [('x', u32), ('y', u32)], u8, lambda x, y: int(x > y)) test(p, trials, b'>', [('x', u32), ('y', u32)], u1, lambda x, y: int(x > y))
test(p, trials, b'{', [('x', u32), ('y', u32)], u8, lambda x, y: int(x <= y)) test(p, trials, b'{', [('x', u32), ('y', u32)], u1, lambda x, y: int(x <= y))
test(p, trials, b'}', [('x', u32), ('y', u32)], u8, lambda x, y: int(x >= y)) test(p, trials, b'}', [('x', u32), ('y', u32)], u1, lambda x, y: int(x >= y))
p.stdin.close() p.stdin.close()
p.stdout.close() p.stdout.close()
p.kill() p.kill()

48
test-math32.tal
View File

@ -46,29 +46,29 @@ JMP2r
;pos LDA2k INC2 SWP2 STA2 BRK ;pos LDA2k INC2 SWP2 STA2 BRK
&exec &exec
POP ( ) POP ( )
;buf LDA LIT '+ EQU ;test-add32 JCN2 ;buf LDA LIT "+ EQU ;test-add32 JCN2
;buf LDA LIT '* EQU ;test-mul32 JCN2 ;buf LDA LIT "* EQU ;test-mul32 JCN2
;buf LDA LIT '- EQU ;test-sub32 JCN2 ;buf LDA LIT "- EQU ;test-sub32 JCN2
;buf LDA LIT '/ EQU ;test-div32 JCN2 ;buf LDA LIT "/ EQU ;test-div32 JCN2
;buf LDA LIT '% EQU ;test-mod32 JCN2 ;buf LDA LIT "% EQU ;test-mod32 JCN2
;buf LDA LIT 'G EQU ;test-gcd32 JCN2 ;buf LDA LIT "G EQU ;test-gcd32 JCN2
;buf LDA LIT 'L EQU ;test-lshift32 JCN2 ;buf LDA LIT "L EQU ;test-lshift32 JCN2
;buf LDA LIT 'R EQU ;test-rshift32 JCN2 ;buf LDA LIT "R EQU ;test-rshift32 JCN2
;buf LDA LIT 'B EQU ;test-bitcount32 JCN2 ;buf LDA LIT "B EQU ;test-bitcount32 JCN2
;buf LDA LIT '& EQU ;test-and32 JCN2 ;buf LDA LIT "& EQU ;test-and32 JCN2
;buf LDA LIT '| EQU ;test-or32 JCN2 ;buf LDA LIT "| EQU ;test-or32 JCN2
;buf LDA LIT '^ EQU ;test-xor32 JCN2 ;buf LDA LIT "^ EQU ;test-xor32 JCN2
;buf LDA LIT '~ EQU ;test-complement32 JCN2 ;buf LDA LIT "~ EQU ;test-complement32 JCN2
;buf LDA LIT 'N EQU ;test-negate32 JCN2 ;buf LDA LIT "N EQU ;test-negate32 JCN2
;buf LDA LIT '= EQU ;test-eq32 JCN2 ;buf LDA LIT "= EQU ;test-eq32 JCN2
;buf LDA LIT '! EQU ;test-ne32 JCN2 ;buf LDA LIT "! EQU ;test-ne32 JCN2
;buf LDA LIT '0 EQU ;test-is-zero32 JCN2 ;buf LDA LIT "0 EQU ;test-is-zero32 JCN2
;buf LDA LIT 'Z EQU ;test-non-zero32 JCN2 ;buf LDA LIT "Z EQU ;test-non-zero32 JCN2
;buf LDA LIT '< EQU ;test-lt32 JCN2 ;buf LDA LIT "< EQU ;test-lt32 JCN2
;buf LDA LIT '> EQU ;test-gt32 JCN2 ;buf LDA LIT "> EQU ;test-gt32 JCN2
;buf LDA LIT '{ EQU ;test-lteq32 JCN2 ;buf LDA LIT "{ EQU ;test-lteq32 JCN2
;buf LDA LIT '} EQU ;test-gteq32 JCN2 ;buf LDA LIT "} EQU ;test-gteq32 JCN2
LIT '? EMIT NEWLINE RESET-POS BRK LIT "? EMIT NEWLINE RESET-POS BRK
@read-byte ( addr* -> x^ ) @read-byte ( addr* -> x^ )
LDA2 ;parse-byte JSR2 LDA2 ;parse-byte JSR2
@ -107,7 +107,7 @@ JMP2r
;buf #0002 ADD2 ;read-long JSR2 ;buf #0002 ADD2 ;read-long JSR2
ROT2 ROT2
;buf #000b ADD2 ;read-byte JSR2 ;buf #000b ADD2 ;read-byte JSR2
TOR JSR2 ;emit/long JSR2 ROT ROT JSR2 ;emit/long JSR2
NEWLINE RESET-POS BRK NEWLINE RESET-POS BRK
( format: ". xxxxxxxx yyyyyyyy" -> "zz" ) ( format: ". xxxxxxxx yyyyyyyy" -> "zz" )