d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more work

This commit is contained in:
~d6 2022-12-06 12:28:43 -05:00
parent ba4b9c02e3
commit 5d2ecb151b
1 changed files with 54 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
hoax.tal
View File

@ -191,7 +191,7 @@
@demo @demo
null ;null? JSR2 D null ;null? JSR2 D
null ;list? JSR2 D null ;cons? JSR2 D
null ;number? JSR2 D null ;number? JSR2 D
null D null D
#0000 ;u16-to-num JSR2 D #0000 ;u16-to-num JSR2 D
@ -398,7 +398,7 @@
@builtins @builtins
@null? ( r$ -> bool$ ) #0000 EQU2 ;byte-to-bool JMP2 @null? ( r$ -> bool$ ) #0000 EQU2 ;byte-to-bool JMP2
@list? ( r$ -> bool$ ) ;get-type JSR2 #00 EQU ;byte-to-bool JMP2 @cons? ( r$ -> bool$ ) ;get-type JSR2 #00 EQU ;byte-to-bool JMP2
@symbol? ( r$ -> bool$ ) ;get-type JSR2 #10 EQU ;byte-to-bool JMP2 @symbol? ( r$ -> bool$ ) ;get-type JSR2 #10 EQU ;byte-to-bool JMP2
@string? ( r$ -> bool$ ) ;get-type JSR2 #20 EQU ;byte-to-bool JMP2 @string? ( r$ -> bool$ ) ;get-type JSR2 #20 EQU ;byte-to-bool JMP2
@number? ( r$ -> bool$ ) ;get-type JSR2 DUP #30 EQU SWP #40 EQU ORA ;byte-to-bool JMP2 @number? ( r$ -> bool$ ) ;get-type JSR2 DUP #30 EQU SWP #40 EQU ORA ;byte-to-bool JMP2
@ -407,6 +407,17 @@
@bool? ( r$ -> bool$ ) ;get-type JSR2 #50 EQU ;byte-to-bool JMP2 @bool? ( r$ -> bool$ ) ;get-type JSR2 #50 EQU ;byte-to-bool JMP2
@tal? ( r$ -> bool$ ) ;get-type JSR2 #60 EQU ;byte-to-bool JMP2 @tal? ( r$ -> bool$ ) ;get-type JSR2 #60 EQU ;byte-to-bool JMP2
@list? ( r$ -> bool$ )
DUP2 #0000 EQU2 ,&yes JCN ( r$ )
;read-object JSR2 ( tag^ ohi$ olo$ )
STH2 POP2 #f0 AND ( not-list^ [olo$] )
,&no JCN ( [olo$] )
STH2r ,list? JMP ( tail$ )
&yes ( r$ )
POP2 #5fff JMP2r ( t$ )
&no ( [olo$] )
POP2r #5ffe JMP2r ( f$ )
@len ( lst$ -> n$ ) @len ( lst$ -> n$ )
LIT2r 0000 ( lst$ [0] ) LIT2r 0000 ( lst$ [0] )
&loop ( xs$ [n*] ) &loop ( xs$ [n*] )
@ -422,19 +433,19 @@
#00 STH2r STH2r ( 00 h$ t$ ) #00 STH2r STH2r ( 00 h$ t$ )
;make-obj JMP2 ( cons$ ) ;make-obj JMP2 ( cons$ )
@car ( lst$ -> h$ ) @car ( pair$ -> h$ )
;read-object JSR2 ( tag^ ohi$ olo$ ) ;read-object JSR2 ( tag^ ohi$ olo$ )
POP2 STH2 ( tag^ [ohi$] ) POP2 STH2 ( tag^ [ohi$] )
,cdr/shared JMP &shared ( tag^ [ohi$] )
#f0 AND ,&error JCN ( [ohi$] ; tag should be 0 )
STH2r JMP2r ( ohi$ )
&error ( [ohi$] )
POP2r ;error JMP2 ( )
@cdr ( ref$ -> t$ ) @cdr ( pair$ -> t$ )
;read-object JSR2 ( tag^ ohi$ olo$ ) ;read-object JSR2 ( tag^ ohi$ olo$ )
NIP2 STH2 ( tag^ [olo$] ) NIP2 STH2 ( tag^ [olo$] )
&shared ( tag^ [olo$] ) ,car/shared JMP ( tag^ [olo$] )
#f0 AND ,&error JCN ( [ptr$] ; tag should be 0 )
STH2r JMP2r ( ptr$ )
&error ( [ptr$] )
POP2r ;error JMP2 ( )
@car! ( pair$ x$ -> pair$ ) @car! ( pair$ x$ -> pair$ )
STH2 ;assert-cons JSR2 ( pair$ [x$] ) STH2 ;assert-cons JSR2 ( pair$ [x$] )
@ -442,16 +453,40 @@
INC2 ( pair$ addr+1 [x$] ) INC2 ( pair$ addr+1 [x$] )
STH2r SWP2 STA2 JMP2r ( pair$ ; addr+1<-x ) STH2r SWP2 STA2 JMP2r ( pair$ ; addr+1<-x )
@cdr! ( pair$ x$ -> ) @cdr! ( pair$ x$ -> pair$ )
STH2 ;assert-cons JSR2 ( lst$ [x$] ) STH2 ;assert-cons JSR2 ( pair$ [x$] )
DUP2 ;obj-to-addr JSR2 ( addr* [x$] ) DUP2 ;obj-to-addr JSR2 ( pair$ addr* [x$] )
#0003 ADD2 ( addr+3 [x$] ) #0003 ADD2 ( pair$ addr+3 [x$] )
STH2r SWP2 STA2 JMP2r ( ; addr+3<-x ) STH2r SWP2 STA2 JMP2r ( pair$ ; addr+3<-x )
@find ( list$ x$ -> rest$ ) @get ( list$ key$ -> result$ )
STH2 ( list$ [x$] ) STH2 ( list$ [x$] )
&loop ( list$ [x$] ) &loop ( list$ [x$] )
;read-object DUP2 ;read-object JSR2 ( list$ tag^ ohi$ ohlo$ [x$] )
,&not-obj JCN ( list$ ohi$ olo$ [x$] )
SWP2 STH2kr EQU2 ( list$ olo$ found^ [x$] )
,&found JCN ( list$ olo$ [x$] )
NIP2 ,&loop JMP ( olo$ [x$] )
&found ( list$ olo$ [x$] )
POP2r POP2 JMP2r ( list$ )
&not-obj ( list$ ohi$ olo$ )
POP2 POP2 POP2 POP2r ( )
#0000 JMP2r ( 0000 )
@find ( list$ x$ -> result$ )
STH2 ( list$ [x$] )
&loop ( list$ [x$] )
DUP2 ;read-object JSR2 ( list$ tag^ ohi$ ohlo$ [x$] )
,&not-obj JCN ( list$ ohi$ olo$ [x$] )
SWP2 STH2kr EQU2 ( list$ olo$ found^ [x$] )
,&found JCN ( list$ olo$ [x$] )
NIP2 ,&loop JMP ( olo$ [x$] )
&found ( list$ olo$ [x$] )
POP2r POP2 JMP2r ( list$ )
&not-obj ( list$ ohi$ olo$ )
POP2 POP2 POP2 POP2r ( )
#0000 JMP2r ( 0000 )
|1004 ( ;arenas needs to be a multiple of 5 ) |1004 ( ;arenas needs to be a multiple of 5 )
~alloc.tal ~alloc.tal