update character literals

This commit is contained in:
~d6 2022-09-10 13:30:15 -04:00
parent c976fdbb0d
commit 0f61f352bb
2 changed files with 98 additions and 98 deletions

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

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