diff --git a/hoax.tal b/hoax.tal index 868c4c9..0e942a1 100644 --- a/hoax.tal +++ b/hoax.tal @@ -105,22 +105,89 @@ |0000 @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 ;init-hoax JSR2 - ;on-char #10 DEO2 + #00 .state STZ + ;on-key #10 DEO2 + ;reset-input JSR2 ;demo JSR2 ( DEBUG EXIT ) BRK -@on-char ( -> ) - #12 DEI #0a EQU ,&newline JCN +@reset-input ( -> ) + #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 ) INC2 ;buffer/pos STA2 POP BRK ( ) &newline #00 ;buffer/pos LDA2 STA ( ; addr<-00 ) ;buffer/input DUP2 ;buffer/pos STA2 ;echo JSR2 "read: 20 00 ;print JSR2 #0a18 DEO - BRK + BRK ) @demo null ;null? JSR2 D @@ -175,14 +242,12 @@ EXIT &ok ( allocate 8192 5-byte object slots ) - #2000 #0005 ;init-arena JSR2 ;objects STA2 + #2000 #0005 ;init-arena JSR2 .objects STZ2 ( set up buffers ) ;buffer/input ;buffer/pos STA2 JMP2r -@buffer [ &pos $2 &input $80 ] - @error ( -> ) #0000 DIV ( TODO ) @@ -296,19 +361,19 @@ &small #8000 ORA2 JMP2r @addr-to-obj ( addr* -> obj$ ) - ;objects SUB2 #0005 DIV2 JMP2r + .objects LDZ2 SUB2 #0005 DIV2 JMP2r @obj-to-addr ( obj$ -> addr* ) - #0005 MUL2 ;objects ADD2 JMP2r + #0005 MUL2 .objects LDZ2 ADD2 JMP2r @make ( tag^ -> addr* ) - ;objects LDA2 ( tag^ arena* ) + .objects LDZ2 ( tag^ arena* ) ;alloc JSR2 ( tag^ addr* ) STH2k STA ( [addr*] ) STH2r JMP2r ( addr* ) @make-obj ( tag^ ohi$ olo$ -> object$ ) - ;objects LDA2 ( tag^ ohi$ olo$ arena* ) + .objects LDZ2 ( tag^ ohi$ olo$ arena* ) ;alloc JSR2 ( tag^ ohi$ olo$ addr* ) STH2k #0003 ADD2 STA2 ( tag^ ohi$ [addr*] ; addr+3<-olo ) STH2kr INC2 STA2 ( tag^ [addr*] ; addr+1<-ohi ) @@ -371,30 +436,22 @@ &error ( [ptr$] ) POP2r ;error JMP2 ( ) -@last ( lst$ -> lst1$ ) - DUP2 ;cdr JSR2 ( lst$ cdr$ ) - ORAk ,&non-empty JCN ( lst$ cdr$ ) - POP2 JMP2r ( lst$ ) - &non-empty ( lst$ cdr$ ) - NIP2 ;last JMP2 ( res$ ) +@car! ( pair$ x$ -> pair$ ) + STH2 ;assert-cons JSR2 ( pair$ [x$] ) + DUP2 ;obj-to-addr JSR2 ( pair$ addr* [x$] ) + INC2 ( pair$ addr+1 [x$] ) + STH2r SWP2 STA2 JMP2r ( pair$ ; addr+1<-x ) -@car! ( lst$ x$ -> ) +@cdr! ( pair$ x$ -> ) STH2 ;assert-cons JSR2 ( lst$ [x$] ) - ;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$] ) + DUP2 ;obj-to-addr JSR2 ( addr* [x$] ) #0003 ADD2 ( addr+3 [x$] ) - STH2r SWP2 STA2 ( ; addr+3<-x ) + STH2r SWP2 STA2 JMP2r ( ; addr+3<-x ) -@append! ( lst$ x$ -> ) - #0000 ;cons JSR2 ;extend! JMP2 - -@extend! ( lst$ tail$ -> ) - SWP2 ;last JSR2 SWP2 ;cdr! JMP2 +@find ( list$ x$ -> rest$ ) + STH2 ( list$ [x$] ) + &loop ( list$ [x$] ) + ;read-object |1004 ( ;arenas needs to be a multiple of 5 ) ~alloc.tal