very very wip

This commit is contained in:
~d6 2022-12-05 14:03:44 -05:00
parent d40db315db
commit ba4b9c02e3
1 changed files with 88 additions and 31 deletions

119
hoax.tal
View File

@ -105,22 +105,89 @@
|0000 |0000
@objects $2 @objects $2
( 00 start )
( 01 symbol )
( 02 string )
( 03 escape )
( 04 comment )
@state $1
@stack $2
@buffer [ &pos $1 &input $40 ] ( max symbol size 64 )
|0100 |0100
;init-hoax JSR2 ;init-hoax JSR2
;on-char #10 DEO2 #00 .state STZ
;on-key #10 DEO2
;reset-input JSR2
;demo JSR2 ;demo JSR2
( DEBUG EXIT ) ( DEBUG EXIT )
BRK BRK
@on-char ( -> ) @reset-input ( -> )
#12 DEI #0a EQU ,&newline JCN #0000 #0000 ;cons JSR2 ( pair$ )
.stack STZ2 ( ; stack<-pair )
JMP2r
@complete-with ( v$ -> )
.stack LDZ2 ( v$ stack$ )
STH2k SWP2 ;car! JSR2 ( [stack] ; car(stack)<-v )
#0000 STH2r ;cons JSR2 ( cell$ )
.stack STZ2 ( stack<- )
@start-list ( -> )
#0000 .stack LDZ2 ( 0000 stack$ )
;cons JSR2 ( pair$ )
DUP2 .stack STZ2 ( pair$ ; stack<-pair )
.stack/pos LDZ ( a^ )
STHk LDZ2 ( base$ [a^] )
#0000 #0000 ;cons JSR2 ( base$ cell$ [a^] )
STH2k ;car! JSR2 ( base$ [a^ cell$] )
POP2 STH2r ( cell$ [a^] )
INCr INCr STHkr ( cell$ a+2^ [a+2^] )
STZ2 STHr .stack/pos STZ ( ; pos<-a+2 )
JMP2r
@end-list ( -> )
;stack/pos LDA2k LDA2 ( pos* elem$ )
STH2 #0004 SUB2 ( pos-4* [elem$] )
@on-key-start ( -> )
#12 DEI
DUP #09 EQU ,&skip JCN ( tab )
DUP #0a EQU ,&skip JCN ( nl )
DUP #0d EQU ,&skip JCN ( cr )
DUP #20 EQU ,&skip JCN ( sp )
DUP #20 LTH ,&control JCN ( control chars )
DUP #7e GTH ,&control JCN ( delete + 8bit )
DUP #28 EQU ,start-list JCN ( lpar )
DUP #29 EQU ,&rpar JCN ( rpar )
,&printable JMP
&rpar
&skip POP BRK
&control POP BRK ( todo )
&printable
@on-key ( -> )
.state LDZ #00 EQU ,on-key-start JCN
.state LDZ #01 EQU ,on-key-symbol JCN
.state LDZ #02 EQU ,on-key-string JCN
.state LDZ #03 EQU ,on-key-escape JCN
.state LDZ #04 EQU ,on-key-comment JCN
#0000 DIV
( #12 DEI #0a EQU ,&newline JCN
#12 DEI ;buffer/pos LDA2 STAk ( c pos ; addr<-c ) #12 DEI ;buffer/pos LDA2 STAk ( c pos ; addr<-c )
INC2 ;buffer/pos STA2 POP BRK ( ) INC2 ;buffer/pos STA2 POP BRK ( )
&newline &newline
#00 ;buffer/pos LDA2 STA ( ; addr<-00 ) #00 ;buffer/pos LDA2 STA ( ; addr<-00 )
;buffer/input DUP2 ;buffer/pos STA2 ;buffer/input DUP2 ;buffer/pos STA2
;echo JSR2 "read: 20 00 ;print JSR2 #0a18 DEO ;echo JSR2 "read: 20 00 ;print JSR2 #0a18 DEO
BRK BRK )
@demo @demo
null ;null? JSR2 D null ;null? JSR2 D
@ -175,14 +242,12 @@
EXIT EXIT
&ok &ok
( allocate 8192 5-byte object slots ) ( allocate 8192 5-byte object slots )
#2000 #0005 ;init-arena JSR2 ;objects STA2 #2000 #0005 ;init-arena JSR2 .objects STZ2
( set up buffers ) ( set up buffers )
;buffer/input ;buffer/pos STA2 ;buffer/input ;buffer/pos STA2
JMP2r JMP2r
@buffer [ &pos $2 &input $80 ]
@error ( -> ) @error ( -> )
#0000 DIV ( TODO ) #0000 DIV ( TODO )
@ -296,19 +361,19 @@
&small #8000 ORA2 JMP2r &small #8000 ORA2 JMP2r
@addr-to-obj ( addr* -> obj$ ) @addr-to-obj ( addr* -> obj$ )
;objects SUB2 #0005 DIV2 JMP2r .objects LDZ2 SUB2 #0005 DIV2 JMP2r
@obj-to-addr ( obj$ -> addr* ) @obj-to-addr ( obj$ -> addr* )
#0005 MUL2 ;objects ADD2 JMP2r #0005 MUL2 .objects LDZ2 ADD2 JMP2r
@make ( tag^ -> addr* ) @make ( tag^ -> addr* )
;objects LDA2 ( tag^ arena* ) .objects LDZ2 ( tag^ arena* )
;alloc JSR2 ( tag^ addr* ) ;alloc JSR2 ( tag^ addr* )
STH2k STA ( [addr*] ) STH2k STA ( [addr*] )
STH2r JMP2r ( addr* ) STH2r JMP2r ( addr* )
@make-obj ( tag^ ohi$ olo$ -> object$ ) @make-obj ( tag^ ohi$ olo$ -> object$ )
;objects LDA2 ( tag^ ohi$ olo$ arena* ) .objects LDZ2 ( tag^ ohi$ olo$ arena* )
;alloc JSR2 ( tag^ ohi$ olo$ addr* ) ;alloc JSR2 ( tag^ ohi$ olo$ addr* )
STH2k #0003 ADD2 STA2 ( tag^ ohi$ [addr*] ; addr+3<-olo ) STH2k #0003 ADD2 STA2 ( tag^ ohi$ [addr*] ; addr+3<-olo )
STH2kr INC2 STA2 ( tag^ [addr*] ; addr+1<-ohi ) STH2kr INC2 STA2 ( tag^ [addr*] ; addr+1<-ohi )
@ -371,30 +436,22 @@
&error ( [ptr$] ) &error ( [ptr$] )
POP2r ;error JMP2 ( ) POP2r ;error JMP2 ( )
@last ( lst$ -> lst1$ ) @car! ( pair$ x$ -> pair$ )
DUP2 ;cdr JSR2 ( lst$ cdr$ ) STH2 ;assert-cons JSR2 ( pair$ [x$] )
ORAk ,&non-empty JCN ( lst$ cdr$ ) DUP2 ;obj-to-addr JSR2 ( pair$ addr* [x$] )
POP2 JMP2r ( lst$ ) INC2 ( pair$ addr+1 [x$] )
&non-empty ( lst$ cdr$ ) STH2r SWP2 STA2 JMP2r ( pair$ ; addr+1<-x )
NIP2 ;last JMP2 ( res$ )
@car! ( lst$ x$ -> ) @cdr! ( pair$ x$ -> )
STH2 ;assert-cons JSR2 ( lst$ [x$] ) STH2 ;assert-cons JSR2 ( lst$ [x$] )
;obj-to-addr JSR2 ( addr* [x$] ) DUP2 ;obj-to-addr JSR2 ( addr* [x$] )
INC2 ( addr+1 [x$] )
STH2r SWP2 STA2 ( ; addr+3<-x )
@cdr! ( lst$ x$ -> )
STH2 ;assert-cons JSR2 ( lst$ [x$] )
;obj-to-addr JSR2 ( addr* [x$] )
#0003 ADD2 ( addr+3 [x$] ) #0003 ADD2 ( addr+3 [x$] )
STH2r SWP2 STA2 ( ; addr+3<-x ) STH2r SWP2 STA2 JMP2r ( ; addr+3<-x )
@append! ( lst$ x$ -> ) @find ( list$ x$ -> rest$ )
#0000 ;cons JSR2 ;extend! JMP2 STH2 ( list$ [x$] )
&loop ( list$ [x$] )
@extend! ( lst$ tail$ -> ) ;read-object
SWP2 ;last JSR2 SWP2 ;cdr! JMP2
|1004 ( ;arenas needs to be a multiple of 5 ) |1004 ( ;arenas needs to be a multiple of 5 )
~alloc.tal ~alloc.tal