update character literals
This commit is contained in:
parent
c976fdbb0d
commit
0f61f352bb
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
|
||||
|
|
|
|||
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue