merged
This commit is contained in:
commit
0acfb26e48
69
hoax.tal
69
hoax.tal
|
@ -271,7 +271,7 @@
|
|||
|
||||
@demo
|
||||
null ;null? JSR2 D
|
||||
null ;list? JSR2 D
|
||||
null ;cons? JSR2 D
|
||||
null ;number? JSR2 D
|
||||
null D
|
||||
#0000 ;u16-to-num JSR2 D
|
||||
|
@ -478,7 +478,7 @@
|
|||
@builtins
|
||||
|
||||
@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
|
||||
@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
|
||||
|
@ -487,6 +487,17 @@
|
|||
@bool? ( r$ -> bool$ ) ;get-type JSR2 #50 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$ )
|
||||
LIT2r 0000 ( lst$ [0] )
|
||||
&loop ( xs$ [n*] )
|
||||
|
@ -502,19 +513,19 @@
|
|||
#00 STH2r STH2r ( 00 h$ t$ )
|
||||
;make-obj JMP2 ( cons$ )
|
||||
|
||||
@car ( lst$ -> h$ )
|
||||
@car ( pair$ -> h$ )
|
||||
;read-object JSR2 ( tag^ ohi$ olo$ )
|
||||
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$ )
|
||||
NIP2 STH2 ( tag^ [olo$] )
|
||||
&shared ( tag^ [olo$] )
|
||||
#f0 AND ,&error JCN ( [ptr$] ; tag should be 0 )
|
||||
STH2r JMP2r ( ptr$ )
|
||||
&error ( [ptr$] )
|
||||
POP2r ;error JMP2 ( )
|
||||
,car/shared JMP ( tag^ [olo$] )
|
||||
|
||||
@car! ( pair$ x$ -> pair$ )
|
||||
STH2 ;assert-cons JSR2 ( pair$ [x$] )
|
||||
|
@ -522,16 +533,40 @@
|
|||
INC2 ( pair$ addr+1 [x$] )
|
||||
STH2r SWP2 STA2 JMP2r ( pair$ ; addr+1<-x )
|
||||
|
||||
@cdr! ( pair$ x$ -> )
|
||||
STH2 ;assert-cons JSR2 ( lst$ [x$] )
|
||||
DUP2 ;obj-to-addr JSR2 ( addr* [x$] )
|
||||
#0003 ADD2 ( addr+3 [x$] )
|
||||
STH2r SWP2 STA2 JMP2r ( ; addr+3<-x )
|
||||
@cdr! ( pair$ x$ -> pair$ )
|
||||
STH2 ;assert-cons JSR2 ( pair$ [x$] )
|
||||
DUP2 ;obj-to-addr JSR2 ( pair$ addr* [x$] )
|
||||
#0003 ADD2 ( pair$ addr+3 [x$] )
|
||||
STH2r SWP2 STA2 JMP2r ( pair$ ; addr+3<-x )
|
||||
|
||||
@find ( list$ x$ -> rest$ )
|
||||
@get ( list$ key$ -> result$ )
|
||||
STH2 ( list$ [x$] )
|
||||
&loop ( list$ [x$] )
|
||||
;read-object
|
||||
DUP2 ;read-object JSR2 ( list$ tag^ ohi$ ohlo$ [x$] )
|
||||
,¬-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$ )
|
||||
¬-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$] )
|
||||
,¬-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$ )
|
||||
¬-obj ( list$ ohi$ olo$ )
|
||||
POP2 POP2 POP2 POP2r ( )
|
||||
#0000 JMP2r ( 0000 )
|
||||
|
||||
|
||||
|1004 ( ;arenas needs to be a multiple of 5 )
|
||||
~alloc.tal
|
||||
|
|
Loading…
Reference in New Issue