merge
This commit is contained in:
commit
4b9c5d1845
134
femto.tal
134
femto.tal
|
@ -27,28 +27,28 @@
|
|||
( emit macros )
|
||||
( )
|
||||
( 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-rpar { LIT2 29 18 DEO }
|
||||
%emit-, { LIT2 ', 18 DEO }
|
||||
%emit-0 { LIT2 '0 18 DEO }
|
||||
%emit-1 { LIT2 '1 18 DEO }
|
||||
%emit-2 { LIT2 '2 18 DEO }
|
||||
%emit-3 { LIT2 '3 18 DEO }
|
||||
%emit-6 { LIT2 '6 18 DEO }
|
||||
%emit-7 { LIT2 '7 18 DEO }
|
||||
%emit-: { LIT2 ': 18 DEO }
|
||||
%emit-; { LIT2 '; 18 DEO }
|
||||
%emit-C { LIT2 'C 18 DEO }
|
||||
%emit-H { LIT2 'H 18 DEO }
|
||||
%emit-J { LIT2 'J 18 DEO }
|
||||
%emit-K { LIT2 'K 18 DEO }
|
||||
%emit-[ { LIT2 '[ 18 DEO }
|
||||
%emit-] { LIT2 '] 18 DEO }
|
||||
%emit-m { LIT2 'm 18 DEO }
|
||||
%emit-n { LIT2 'n 18 DEO }
|
||||
%emit-~ { LIT2 '~ 18 DEO }
|
||||
%emit-, { LIT2 ", 18 DEO }
|
||||
%emit-0 { LIT2 "0 18 DEO }
|
||||
%emit-1 { LIT2 "1 18 DEO }
|
||||
%emit-2 { LIT2 "2 18 DEO }
|
||||
%emit-3 { LIT2 "3 18 DEO }
|
||||
%emit-6 { LIT2 "6 18 DEO }
|
||||
%emit-7 { LIT2 "7 18 DEO }
|
||||
%emit-: { LIT2 ": 18 DEO }
|
||||
%emit-; { LIT2 "; 18 DEO }
|
||||
%emit-C { LIT2 "C 18 DEO }
|
||||
%emit-H { LIT2 "H 18 DEO }
|
||||
%emit-J { LIT2 "J 18 DEO }
|
||||
%emit-K { LIT2 "K 18 DEO }
|
||||
%emit-[ { LIT2 "[ 18 DEO }
|
||||
%emit-] { LIT2 "] 18 DEO }
|
||||
%emit-m { LIT2 "m 18 DEO }
|
||||
%emit-n { LIT2 "n 18 DEO }
|
||||
%emit-~ { LIT2 "~ 18 DEO }
|
||||
|
||||
%quit! { #01 .System/halt DEO BRK }
|
||||
%lmargin { #0006 }
|
||||
|
@ -198,7 +198,7 @@
|
|||
.Console/read DEI .state/key STZ
|
||||
.state/key LDZ .tmp/pos LDZ2 STA
|
||||
.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
|
||||
|
||||
( parse and store terminal size information )
|
||||
|
@ -207,18 +207,18 @@
|
|||
@parse-terminal-size ( -> )
|
||||
#0000 ,&acc STR2
|
||||
.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
|
||||
LDZk LIT '; EQU ,&parse-col JCN
|
||||
LDZk LIT "; EQU ,&parse-col JCN
|
||||
LIT2r :&loop ,&read JMP
|
||||
&parse-col
|
||||
INC ,&acc LDR2 #0002 SUB2 .term/rows STZ2
|
||||
#0000 ,&acc STR2
|
||||
&loop2
|
||||
LDZk LIT 'R EQU ,&done JCN
|
||||
LDZk LIT "R EQU ,&done JCN
|
||||
LIT2r :&loop2 ,&read JMP
|
||||
&read
|
||||
LDZk LIT '0 SUB #00 SWP
|
||||
LDZk LIT "0 SUB #00 SWP
|
||||
,&acc LDR2 #000a MUL2 ADD2 ,&acc STR2
|
||||
INC JMP2r
|
||||
&done
|
||||
|
@ -444,8 +444,8 @@
|
|||
|
||||
( callback executed in response to the quit prompt. )
|
||||
@do-quit
|
||||
.tmp/data LDZ LIT 'n EQU ;quit-now JCN2
|
||||
.tmp/data LDZ LIT 'y EQU ;save JCN2
|
||||
.tmp/data LDZ LIT "n EQU ;quit-now JCN2
|
||||
.tmp/data LDZ LIT "y EQU ;save JCN2
|
||||
#00 .state/quitting STZ
|
||||
;messages/unknown-input ;tmp/data ;send-message JSR2
|
||||
BRK
|
||||
|
@ -571,10 +571,10 @@
|
|||
LDAk ,&continue JCN
|
||||
POP2 STH2r #01 JMP2r
|
||||
&continue
|
||||
LDAk LIT '0 LTH ,&fail JCN
|
||||
LDAk LIT '9 GTH ,&fail JCN
|
||||
LDAk LIT "0 LTH ,&fail JCN
|
||||
LDAk LIT "9 GTH ,&fail JCN
|
||||
LIT2r 000a MUL2r
|
||||
LDAk LIT '0 SUB #00 SWP STH2 ADD2r
|
||||
LDAk LIT "0 SUB #00 SWP STH2 ADD2r
|
||||
INC2 ,&loop JMP
|
||||
&fail
|
||||
POP2r #00 JMP2r
|
||||
|
@ -790,17 +790,17 @@
|
|||
( TODO: maybe M-% for search&replace )
|
||||
@on-key-escaped ( -> )
|
||||
#00 .state/saw-esc STZ
|
||||
.state/key LDZ LIT '< EQU ( M-< ) ;goto-start 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 'c EQU ( M-c ) ;toggle-color 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 's EQU ( M-s ) ;regex-search 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 'v EQU ( M-v ) ;page-up JCN2
|
||||
.state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2
|
||||
.state/key LDZ LIT "< EQU ( M-< ) ;goto-start 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 "c EQU ( M-c ) ;toggle-color 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 "s EQU ( M-s ) ;regex-search 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 "v EQU ( M-v ) ;page-up JCN2
|
||||
.state/key LDZ LIT "[ EQU ( M-[ ) ;xterm JCN2
|
||||
BRK
|
||||
|
||||
( set our input to expect xterm control sequences )
|
||||
|
@ -821,24 +821,24 @@
|
|||
( the relevant action. )
|
||||
@on-key-vt ( -> )
|
||||
.state/saw-vt LDZk STH #00 SWP STZ
|
||||
.state/key LDZ LIT '~ EQU ,&ok JCN
|
||||
.state/key LDZ LIT "~ EQU ,&ok JCN
|
||||
POPr BRK
|
||||
&ok
|
||||
STHr DUP LIT '1 NEQ ,¬-1 JCN
|
||||
STHr DUP LIT "1 NEQ ,¬-1 JCN
|
||||
( ^[[1~ -> home ) POP ;bol JMP2
|
||||
¬-1 DUP LIT '2 NEQ ,¬-2 JCN
|
||||
¬-1 DUP LIT "2 NEQ ,¬-2 JCN
|
||||
( ^[[2~ -> insert ) POP BRK
|
||||
¬-2 DUP LIT '3 NEQ ,¬-3 JCN
|
||||
¬-2 DUP LIT "3 NEQ ,¬-3 JCN
|
||||
( ^[[3~ -> delete ) POP ;delete JMP2
|
||||
¬-3 DUP LIT '4 NEQ ,¬-4 JCN
|
||||
¬-3 DUP LIT "4 NEQ ,¬-4 JCN
|
||||
( ^[[4~ -> end ) POP ;eol JMP2
|
||||
¬-4 DUP LIT '5 NEQ ,¬-5 JCN
|
||||
¬-4 DUP LIT "5 NEQ ,¬-5 JCN
|
||||
( ^[[5~ -> page up ) POP ;page-up JMP2
|
||||
¬-5 DUP LIT '6 NEQ ,¬-6 JCN
|
||||
¬-5 DUP LIT "6 NEQ ,¬-6 JCN
|
||||
( ^[[6~ -> page down ) POP ;page-down JMP2
|
||||
¬-6 DUP LIT '7 NEQ ,¬-7 JCN
|
||||
¬-6 DUP LIT "7 NEQ ,¬-7 JCN
|
||||
( ^[[7~ -> home ) POP ;bol JMP2
|
||||
¬-7 DUP LIT '8 NEQ ,¬-8 JCN
|
||||
¬-7 DUP LIT "8 NEQ ,¬-8 JCN
|
||||
( ^[[8~ -> end ) POP ;eol JMP2
|
||||
¬-8
|
||||
( ??? ) POP BRK
|
||||
|
@ -851,14 +851,14 @@
|
|||
( to continue (or end) the sequence. )
|
||||
@on-key-xterm ( -> )
|
||||
#00 .state/saw-xterm STZ
|
||||
.state/key LDZ LIT 'A EQU ( ^[[A -> up ) ;up 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 'D EQU ( ^[[D -> left ) ;back 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 '0 LTH ;ignore JCN2
|
||||
.state/key LDZ LIT '8 GTH ;ignore 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 "C EQU ( ^[[C -> right ) ;forward 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 "H EQU ( ^[[H -> home ) ;bol JCN2
|
||||
.state/key LDZ LIT "0 LTH ;ignore JCN2
|
||||
.state/key LDZ LIT "8 GTH ;ignore JCN2
|
||||
.state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 )
|
||||
BRK
|
||||
|
||||
|
@ -1158,7 +1158,7 @@
|
|||
emit-,
|
||||
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2
|
||||
emit-rpar sp emit-[
|
||||
LIT 's .config/insert-tabs LDZ ADD emit
|
||||
LIT "s .config/insert-tabs LDZ ADD emit
|
||||
emit-] sp
|
||||
;messages/help-msg ;print JSR2
|
||||
;emit-reset JMP2
|
||||
|
@ -1303,17 +1303,17 @@
|
|||
( ANSI control sequence to get the cursor position )
|
||||
( ESC [ 6 n )
|
||||
@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 )
|
||||
( ESC [ 2 J )
|
||||
@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 )
|
||||
( ESC [ 2 K )
|
||||
@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 -> )
|
||||
LITr 18 ( Console/write )
|
||||
|
@ -1323,11 +1323,11 @@
|
|||
|
||||
( ESC [ 3 1 m )
|
||||
@emit-red ( -> )
|
||||
LIT2 00 'm LIT2 '1 '3 ,ansi-emit JMP
|
||||
LIT2 00 "m LIT2 "1 "3 ,ansi-emit JMP
|
||||
|
||||
( ESC [ 0 m )
|
||||
@emit-reset ( -> )
|
||||
#00 LIT2 'm '0 ,ansi-emit JMP
|
||||
#00 LIT2 "m "0 ,ansi-emit JMP
|
||||
|
||||
( ESC [ 1 m $ ESC [ 0 m )
|
||||
@emit-red-dollar ( -> )
|
||||
|
@ -1336,15 +1336,15 @@
|
|||
( ESC [ 3 $x ; 7 m )
|
||||
( $x is 0-7 )
|
||||
@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 ( -> )
|
||||
LIT2 00 'm .config/color LDZ2 ,ansi-emit JMP
|
||||
LIT2 00 "m .config/color LDZ2 ,ansi-emit JMP
|
||||
|
||||
( ESC [ 3 $x ; 1 m )
|
||||
( $x is 0-7 )
|
||||
@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 ( -> )
|
||||
;term-erase-all JSR2
|
||||
|
|
35
math32.tal
35
math32.tal
|
@ -54,11 +54,6 @@
|
|||
( - mul32 memory, 12 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 )
|
||||
( equivalent to floor[log2[x]] + 1 )
|
||||
|
||||
|
@ -82,7 +77,7 @@
|
|||
SWP ;bitcount8 JSR2 ADD ( nhi+nlo )
|
||||
JMP2r
|
||||
&hi-set
|
||||
SWP POP #08 ADD ( nhi+8 )
|
||||
NIP #08 ADD ( nhi+8 )
|
||||
JMP2r
|
||||
|
||||
@bitcount32 ( x** -> n^ )
|
||||
|
@ -90,9 +85,9 @@
|
|||
;bitcount16 JSR2 ( xlo* nhi )
|
||||
DUP #00 NEQ ( xlo* nhi nhi!=0 )
|
||||
,&hi-set JCN ( xlo* nhi )
|
||||
TOR ;bitcount16 JSR2 ADD JMP2r ( nhi+nlo )
|
||||
ROT ROT ;bitcount16 JSR2 ADD JMP2r ( nhi+nlo )
|
||||
&hi-set
|
||||
TOR POP2 #10 ADD ( nhi+16 )
|
||||
ROT ROT POP2 #10 ADD ( nhi+16 )
|
||||
JMP2r
|
||||
|
||||
( equality )
|
||||
|
@ -113,7 +108,7 @@
|
|||
|
||||
( x != 0 )
|
||||
@non-zero32 ( x** -> bool^ )
|
||||
ORA2 #0000 NEQ2 JMP2r
|
||||
ORA2 ORA JMP2r
|
||||
|
||||
( comparisons )
|
||||
|
||||
|
@ -165,7 +160,7 @@
|
|||
|
||||
( ~x )
|
||||
@complement32 ( x** -> ~x** )
|
||||
COMPLEMENT32 JMP2r
|
||||
SWP2 #ffff EOR2 SWP2 #ffff EOR2 JMP2r
|
||||
|
||||
( temporary registers )
|
||||
( shared by most operations, except mul32 and div32 )
|
||||
|
@ -198,7 +193,7 @@
|
|||
STHkr SFT ;m32/z3 STA ( write 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 TOR ;m32/z3 LDA
|
||||
#00 ROT ROT ;m32/z3 LDA
|
||||
JMP2r
|
||||
|
||||
( shift right by 16-23 bits )
|
||||
|
@ -239,7 +234,7 @@
|
|||
#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 )
|
||||
STHr SFT ;m32/z0 LDA ORA ( calculate z0 )
|
||||
SWP POP ( x0 unused )
|
||||
NIP ( x0 unused )
|
||||
;m32/z1 LDA2 #00
|
||||
JMP2r
|
||||
|
||||
|
@ -256,7 +251,7 @@
|
|||
@lshift32-3 ( x** n^ -> x<<n )
|
||||
#18 SUB #40 SFT ( x0 x1 x2 x3 r=[n-24]<<4 )
|
||||
SFT ( x0 x1 x2 x3<<r )
|
||||
SWP2 POP2 SWP POP #0000 #00
|
||||
NIP2 NIP #0000 #00
|
||||
JMP2r
|
||||
|
||||
( arithmetic )
|
||||
|
@ -265,7 +260,7 @@
|
|||
@add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* )
|
||||
;m32/y2 STA2 ;m32/y0 STA2 ( save ylo, yhi )
|
||||
;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 )
|
||||
#00 ;m32/x3 LDA #00 ;m32/y3 LDA ADD2 ;m32/z2 STA2
|
||||
|
@ -288,9 +283,9 @@
|
|||
|
||||
( -x )
|
||||
@negate32 ( x** -> -x** )
|
||||
COMPLEMENT32
|
||||
;complement32 JSR2 ( ~x** )
|
||||
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 )
|
||||
SWP2 INC2 SWP2 ( -xhi -xlo )
|
||||
&done
|
||||
|
@ -380,7 +375,7 @@
|
|||
#00 DUP2 ( shift 0 shift 0 )
|
||||
|
||||
( 1<<shift -> cur )
|
||||
#0000 #0001 ROT2 POP
|
||||
#0000 INC2k ROT2 POP
|
||||
;lshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2
|
||||
|
||||
( div<<shift -> div )
|
||||
|
@ -412,10 +407,10 @@
|
|||
( greatest common divisor - euclidean algorithm )
|
||||
@gcd32 ( x** y** -> z** )
|
||||
&loop ( x y )
|
||||
DUP4 ( x y y )
|
||||
OVR2 OVR2 ( x y y )
|
||||
;is-zero32 JSR2 ( x y y=0? )
|
||||
,&done JCN ( x y )
|
||||
DUP4 ( x y y )
|
||||
OVR2 OVR2 ( x y y )
|
||||
STH2 STH2 ( x y [y] )
|
||||
;mod32 JSR2 ( r=x%y [y] )
|
||||
STH2r ( rhi rlo yhi [ylo] )
|
||||
|
@ -426,5 +421,5 @@
|
|||
ROT2 ( yhi ylo rhi rlo )
|
||||
,&loop JMP
|
||||
&done
|
||||
POP4 ( x )
|
||||
POP2 POP2 ( x )
|
||||
JMP2r
|
||||
|
|
62
regex.tal
62
regex.tal
|
@ -98,7 +98,7 @@
|
|||
( using error! will print the given message before causing )
|
||||
( the interpreter to halt. )
|
||||
@error!! ( msg* -> )
|
||||
LIT '! emit! space
|
||||
LIT "! emit! space
|
||||
&loop LDAk #00 EQU ,&done JCN
|
||||
LDAk emit! INC2 ,&loop JMP
|
||||
&done POP2 newline #ff0e DEO #010f DEO BRK
|
||||
|
@ -334,15 +334,15 @@
|
|||
|
||||
( is pos currently pointing to a 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? )
|
||||
@peek-to-plus ( -> is-plus^ )
|
||||
;pos LDA2 LDA LIT '+ EQU JMP2r
|
||||
;pos LDA2 LDA LIT "+ EQU JMP2r
|
||||
|
||||
( is pos currently pointing to a qmark? )
|
||||
@peek-to-qmark ( -> is-qmark^ )
|
||||
;pos LDA2 LDA LIT '? EQU JMP2r
|
||||
;pos LDA2 LDA LIT "? EQU JMP2r
|
||||
|
||||
( just increment pos )
|
||||
@skip
|
||||
|
@ -390,18 +390,18 @@
|
|||
@compile-region-loop
|
||||
;read JSR2
|
||||
DUP #00 EQU ;c-done JCN2
|
||||
DUP LIT '| EQU ;c-or JCN2
|
||||
DUP LIT '. EQU ;c-dot JCN2
|
||||
DUP LIT '^ EQU ;c-caret JCN2
|
||||
DUP LIT '$ EQU ;c-dollar JCN2
|
||||
DUP LIT '( EQU ;c-lpar JCN2
|
||||
DUP LIT ') EQU ;c-rpar JCN2
|
||||
DUP LIT '[ EQU ;c-lbrk JCN2
|
||||
DUP LIT '] EQU ;c-rbrk JCN2
|
||||
DUP LIT '\ EQU ;c-esc JCN2
|
||||
DUP LIT '* EQU ;c-star JCN2
|
||||
DUP LIT '+ EQU ;c-plus JCN2
|
||||
DUP LIT '? EQU ;c-qmark JCN2
|
||||
DUP LIT "| EQU ;c-or JCN2
|
||||
DUP LIT ". EQU ;c-dot JCN2
|
||||
DUP LIT "^ EQU ;c-caret JCN2
|
||||
DUP LIT "$ EQU ;c-dollar JCN2
|
||||
DUP LIT "( EQU ;c-lpar JCN2
|
||||
DUP LIT ") EQU ;c-rpar JCN2
|
||||
DUP LIT "[ EQU ;c-lbrk JCN2
|
||||
DUP LIT "] EQU ;c-rbrk JCN2
|
||||
DUP LIT "\ EQU ;c-esc JCN2
|
||||
DUP LIT "* EQU ;c-star JCN2
|
||||
DUP LIT "+ EQU ;c-plus JCN2
|
||||
DUP LIT "? EQU ;c-qmark JCN2
|
||||
;c-char JMP2
|
||||
|
||||
( either finalize the given r0/r1 or else wrap it in )
|
||||
|
@ -473,22 +473,22 @@
|
|||
( doesn't currently handle "special" escapes such as \n )
|
||||
@c-lbrk ( c^ -> r2* )
|
||||
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
|
||||
#0a STHr ADD ( src* type^ )
|
||||
;arena-pos LDA2 STH2k ( src* type^ dst* [dst*] )
|
||||
STA LIT2r 0004 ADD2r ( src* [dst+4] )
|
||||
&left-parse ( src* [dst*] )
|
||||
LDAk LIT '] EQU ,&done JCN
|
||||
LDAk LIT '- EQU ,&error JCN
|
||||
LDAk LIT '\ NEQ ,&left JCN INC2
|
||||
LDAk LIT "] EQU ,&done JCN
|
||||
LDAk LIT "- EQU ,&error JCN
|
||||
LDAk LIT "\ NEQ ,&left JCN INC2
|
||||
&left
|
||||
LDAk STH2kr STA INC2r
|
||||
DUP2 INC2 LDA LIT '- NEQ ,&pre-right JCN INC2 INC2
|
||||
LDAk LIT '] EQU ,&error JCN
|
||||
LDAk LIT '- EQU ,&error JCN
|
||||
DUP2 INC2 LDA LIT "- NEQ ,&pre-right JCN INC2 INC2
|
||||
LDAk LIT "] EQU ,&error JCN
|
||||
LDAk LIT "- EQU ,&error JCN
|
||||
&pre-right
|
||||
LDAk LIT '\ NEQ ,&right JCN INC2
|
||||
LDAk LIT "\ NEQ ,&right JCN INC2
|
||||
&right
|
||||
LDAk STH2kr STA INC2 INC2r ,&left-parse JMP
|
||||
&done ( src* [dst*] )
|
||||
|
@ -537,13 +537,13 @@
|
|||
( otherwise, allocates a literal of the next character. )
|
||||
@c-esc ( c^ -> r2* )
|
||||
POP ;read JSR2
|
||||
DUP LIT 'a EQU ,&bel JCN
|
||||
DUP LIT 'b EQU ,&bs JCN
|
||||
DUP LIT 't EQU ,&tab JCN
|
||||
DUP LIT 'n EQU ,&nl JCN
|
||||
DUP LIT 'v EQU ,&vtab JCN
|
||||
DUP LIT 'f EQU ,&ff JCN
|
||||
DUP LIT 'r EQU ,&cr JCN
|
||||
DUP LIT "a EQU ,&bel JCN
|
||||
DUP LIT "b EQU ,&bs JCN
|
||||
DUP LIT "t EQU ,&tab JCN
|
||||
DUP LIT "n EQU ,&nl JCN
|
||||
DUP LIT "v EQU ,&vtab JCN
|
||||
DUP LIT "f EQU ,&ff JCN
|
||||
DUP LIT "r EQU ,&cr JCN
|
||||
&default ;c-char JMP2
|
||||
&bel POP #07 ,&default JMP
|
||||
&bs POP #08 ,&default JMP
|
||||
|
|
|
@ -5,6 +5,7 @@ from os import environ
|
|||
from random import randint
|
||||
from subprocess import Popen, PIPE, run
|
||||
|
||||
u1 = {'sz': 1, 'fmt': b'%02x'}
|
||||
u3 = {'sz': 1 << 3, 'fmt': b'%02x'}
|
||||
u5 = {'sz': 1 << 5, '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)
|
||||
if got == expected:
|
||||
return None
|
||||
elif out == u1 and bool(got) == bool(expected):
|
||||
return None
|
||||
else:
|
||||
res = {'got': got, 'expected': expected}
|
||||
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)], 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)], u8, lambda x, y: int(x != y))
|
||||
test(p, trials, b'0', [('x', u32)], u8, lambda x: int(x == 0))
|
||||
test(p, trials, b'Z', [('x', u32)], u8, 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)], u8, 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)], 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)], u1, lambda x, y: int(x != y))
|
||||
test(p, trials, b'0', [('x', u32)], u1, 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)], u1, 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)], u1, 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.stdout.close()
|
||||
p.kill()
|
||||
|
|
|
@ -46,29 +46,29 @@ JMP2r
|
|||
;pos LDA2k INC2 SWP2 STA2 BRK
|
||||
&exec
|
||||
POP ( )
|
||||
;buf LDA LIT '+ EQU ;test-add32 JCN2
|
||||
;buf LDA LIT '* EQU ;test-mul32 JCN2
|
||||
;buf LDA LIT '- EQU ;test-sub32 JCN2
|
||||
;buf LDA LIT '/ EQU ;test-div32 JCN2
|
||||
;buf LDA LIT '% EQU ;test-mod32 JCN2
|
||||
;buf LDA LIT 'G EQU ;test-gcd32 JCN2
|
||||
;buf LDA LIT 'L EQU ;test-lshift32 JCN2
|
||||
;buf LDA LIT 'R EQU ;test-rshift32 JCN2
|
||||
;buf LDA LIT 'B EQU ;test-bitcount32 JCN2
|
||||
;buf LDA LIT '& EQU ;test-and32 JCN2
|
||||
;buf LDA LIT '| EQU ;test-or32 JCN2
|
||||
;buf LDA LIT '^ EQU ;test-xor32 JCN2
|
||||
;buf LDA LIT '~ EQU ;test-complement32 JCN2
|
||||
;buf LDA LIT 'N EQU ;test-negate32 JCN2
|
||||
;buf LDA LIT '= EQU ;test-eq32 JCN2
|
||||
;buf LDA LIT '! EQU ;test-ne32 JCN2
|
||||
;buf LDA LIT '0 EQU ;test-is-zero32 JCN2
|
||||
;buf LDA LIT 'Z EQU ;test-non-zero32 JCN2
|
||||
;buf LDA LIT '< EQU ;test-lt32 JCN2
|
||||
;buf LDA LIT '> EQU ;test-gt32 JCN2
|
||||
;buf LDA LIT '{ EQU ;test-lteq32 JCN2
|
||||
;buf LDA LIT '} EQU ;test-gteq32 JCN2
|
||||
LIT '? EMIT NEWLINE RESET-POS BRK
|
||||
;buf LDA LIT "+ EQU ;test-add32 JCN2
|
||||
;buf LDA LIT "* EQU ;test-mul32 JCN2
|
||||
;buf LDA LIT "- EQU ;test-sub32 JCN2
|
||||
;buf LDA LIT "/ EQU ;test-div32 JCN2
|
||||
;buf LDA LIT "% EQU ;test-mod32 JCN2
|
||||
;buf LDA LIT "G EQU ;test-gcd32 JCN2
|
||||
;buf LDA LIT "L EQU ;test-lshift32 JCN2
|
||||
;buf LDA LIT "R EQU ;test-rshift32 JCN2
|
||||
;buf LDA LIT "B EQU ;test-bitcount32 JCN2
|
||||
;buf LDA LIT "& EQU ;test-and32 JCN2
|
||||
;buf LDA LIT "| EQU ;test-or32 JCN2
|
||||
;buf LDA LIT "^ EQU ;test-xor32 JCN2
|
||||
;buf LDA LIT "~ EQU ;test-complement32 JCN2
|
||||
;buf LDA LIT "N EQU ;test-negate32 JCN2
|
||||
;buf LDA LIT "= EQU ;test-eq32 JCN2
|
||||
;buf LDA LIT "! EQU ;test-ne32 JCN2
|
||||
;buf LDA LIT "0 EQU ;test-is-zero32 JCN2
|
||||
;buf LDA LIT "Z EQU ;test-non-zero32 JCN2
|
||||
;buf LDA LIT "< EQU ;test-lt32 JCN2
|
||||
;buf LDA LIT "> EQU ;test-gt32 JCN2
|
||||
;buf LDA LIT "{ EQU ;test-lteq32 JCN2
|
||||
;buf LDA LIT "} EQU ;test-gteq32 JCN2
|
||||
LIT "? EMIT NEWLINE RESET-POS BRK
|
||||
|
||||
@read-byte ( addr* -> x^ )
|
||||
LDA2 ;parse-byte JSR2
|
||||
|
@ -107,7 +107,7 @@ JMP2r
|
|||
;buf #0002 ADD2 ;read-long JSR2
|
||||
ROT2
|
||||
;buf #000b ADD2 ;read-byte JSR2
|
||||
TOR JSR2 ;emit/long JSR2
|
||||
ROT ROT JSR2 ;emit/long JSR2
|
||||
NEWLINE RESET-POS BRK
|
||||
|
||||
( format: ". xxxxxxxx yyyyyyyy" -> "zz" )
|
||||
|
|
Loading…
Reference in New Issue