( hoax.tal                                                           )
(                                                                    )
( ADDRESSES                                                          )
(                                                                    )
( hoax uses 16-bit references. within these two bytes, the top bits  )
( determine the type of reference and the bottom bits determine its  )
( location or value:                                                 )
(                                                                    )
(   BIT PATTERN           RANGE     DESCRIPTION                      )
(   00...... ........   0000-3fff   14-bit object address            )
(   00000000 00000000     (0000)      null (empty list)              )
(   00000000 00000001     (0001)      object in arena slot 1         )
(   00100000 00000000     (2000)      object in arena slot 8192      )
(   010..... ........   4000-5fff   13-bit constant index            )
(   01000000 00000000     (4000)      symbol interned at offset 0    )
(   01010000 00000000     (5000)      symbol interned at offset 4096 )
(   01011111 11111110     (5ffe)      #f                             )
(   01011111 11111111     (5fff)      #t                             )
(   011..... ........   6000-7fff   13-bit uxn builtin address       )
(   01100000 00000000     (6000)      cons                           )
(   01100000 00000001     (6001)      lambda                         )
(   1....... ........   8000-ffff   signed 15-bit number             )
(   10000000 00000000     (8000)           0                         )
(   10000000 00000001     (8001)           1                         )
(   10111111 11111111     (bfff)       16383                         )
(   10100000 00000001     (c000)      -16384                         )
(   11111111 11111111     (ffff)          -1                         )
(                                                                    )
( object references contain an address to additional allocated       )
( memory which includes additional information such as the type.     )
( other references are either literal values (numbers) or else an    )
( index which can be directly interpreted.                           )
(                                                                    )
( OBJECTS                                                            )
(                                                                    )
( objects are 5-byte chunks of memory. each object contains a        )
( 4-bit tag which describes the object's type, a 4-bit flag which    )
( describes details of the type's layout, and 4 bytes of data.       )
(                                                                    )
(   TAG  FLAG BITS  NAME           DATA LAYOUT                       )
(    00      n/a    list           head ptr (bc) + tail ptr (de)     )
(    10    00 - 04  short symbol   length is 0-4 bytes of (bcde)     )
(    10    05 - 0f  long symbol    two bytes (bc) + next ptr (de)    )
(    20    00 - 04  short string   length is 0-4 bytes of (bcde)     )
(    20    05 - 0f  long string    two bytes (bc) + next ptr (de)    )
(    30      00     int            positive four byte (bcde) int     )
(    30      04     int            positive lsb (bc) + next ptr (de) )
(    30      08     int            negative four byte (bcde) int     )
(    30      0c     int            negative lsb (bc) + next ptr (de) )
(    40      n/a    rational       rational number (bc/de)           )

%null { #0000 }
%false { #5ffe }
%true { #5fff }
%zero { #8000 }

|0000
    @objects $2

|0100
    BRK

@init-hoax ( -> )
    #2000 #0005 ;init-arena JSR2 ( allocate 8192 5-byte object slots )
    JMP2r

@buffers
    &x $64 &y $64 &z $64

@error ( -> )

( CONVENTIONS )
( )
( word$   - 2-byte reference )
( object# - 5-byte object )
( )
( errors will clear the stack and jump to ;error )

@read-object ( ref$ -> tag^ ohi* olo* )
    OVR #c0 AND ,&error JCN
        #0005 MUL2 ;objects ADD2 ( addr )
        STH2k LDA ( tag^ [addr] )
        INC2r STH2kr LDA2 ( tag^ ohi* [addr+1] )
        INC2r INC2r STH2r LDA2 ( tag^ ohi* olo* )
        JMP2r
    &error
        POP2 ;error JMP2

@to-bool ( x^ -> bool$ )
    #5ffe   ( x 5f fe )
    ROT     ( 5f fe x )
    #00 NEQ ( 5f fe 0-or-1 )
    ORA     ( 5f fe-or-ff )
    JMP2r

@builtins

@null? ( r$ -> bool$ )
    #0000 EQU2 ;to-bool JMP2

@list? ( r$ -> bool$ )
    ORAk ,&not-null JCN      ( r )
        POP2 true JMP2r      ( true )
    &not-null                ( r )
        DUP2 #c000 AND2      ( r r&c000 )
        ORA ,&not-object JCN ( r )
        ;read-object JSR2    ( tag^ ohi* olo* )
        POP2 POP2            ( tag^ )
        ,&not-list JCN       ( )
        true JMP2r           ( true )
    &not-object POP2         ( )
    &not-list false JMP2r    ( false )

@number? ( r$ -> bool$ )
    DUP2 #8000 AND2 ORA ,&ref-num JCN
    DUP2 #c000 AND2 ORA ,&not-obj JCN
    ;read-object JSR2 POP2 POP2 #f0 AND ( tag^ )
    DUP #30 EQU SWP #40 EQU ;to-bool JMP2
    &ref-num POP2 true JMP2r
    &not-obj POP2 false JMP2r

@cons ( h$ t$ -> cons$ )
    SWP2                            ( t h )
    ;objects LDA2 ;alloc JSR2 STH2k ( t h addr [addr] )
    #00 STH2kr STA                  ( t h [addr] ; addr<-00 )
    STH2kr INC2 STA2                ( t [addr]   ; addr+1<-h )
    STH2kr #0003 ADD2 STA2          ( [addr]     ; addr+3<-t )
    STH2r ;objects SUB2             ( delta )
    #0005 DIV2 JMP2r                ( object )

@car ( ref$ -> h* )
    ;read-object JSR2     ( tag^ ohi* olo* )
    POP2 STH2             ( tag^ [ohi*] )
    #f0 AND ,&error JCN   ( [ohi*] ; tag should be 0 )
        STH2r JMP2r       ( ohi* )
    &error                ( [ohi*] )
        POP2r ;error JMP2 ( )

@cdr ( ref$ -> h* )
    ;read-object JSR2
    NIP2 STH2 ( tag^ [olo*] )
    #f0 AND ,&error JCN ( tag should be 0 )
        STH2r JMP2r
    &error
        POP2r ;error JMP2

~alloc.tal