nxu/test-alloc.tal

( test alloc.tal                         )
(                                        )
( valid output will look something like  )
(                                        )
( init 057e 068c                         )
( headers 0004 068c 058c 0584            )
( alloc 058c 0590 0594 0598              )
( clear                                  )
( alloc 058c 0590 0594 0598              )
( clear                                  )
( alloc-of 058c 0590 0594 0598           )
( alloc 059c 05a0 05a4 05a8              )
( free                                   )
( alloc 05a4 05ac                        )

%NL { #0a18 DEO }
%SP { #2018 DEO }
%HX { ;emit/short JSR2 }

|0000
    @arena $2
    @saved $2

|0100
    ( initialize arena: 16 cells x 4 bytes each )
    ;print JSR2 "init 20 00
    #0040 #0004 ;init-arena JSR2 .arena STZ2
    ;arenas HX SP ;arena-pos LDA2 HX NL

    ( display the metadata about the arena )
    ;print JSR2 "headers 20 00
    .arena LDZ2 ;arena-item JSR2 HX SP
    .arena LDZ2 ;arena-next JSR2 HX SP
    .arena LDZ2 ;arena-data JSR2 HX SP
    .arena LDZ2 ;arena-header JSR2 HX NL

    ( start allocating, addresses should increase in steps of 4 )
    ;print JSR2 "alloc 20 00
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX NL
    
    ( clear the arena )
    ;print JSR2 "clear 0a 00
    .arena LDZ2 ;clear-arena JSR2

    ( allocate again, addresses should be the same as before )
    ;print JSR2 "alloc 20 00
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX NL

    ( clear again )
    ;print JSR2 "clear 0a 00
    .arena LDZ2 ;clear-arena JSR2

    ( use alloc-of, addresses should be the same as above )
    ;print JSR2 "alloc-of 20 00
    #0004 ;alloc-of JSR2 HX SP
    #0004 ;alloc-of JSR2 HX SP
    #0004 ;alloc-of JSR2 HX SP
    #0004 ;alloc-of JSR2 HX NL

    ( keep allocating, save one allocated address to use later )
    ;print JSR2 "alloc 20 00
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 DUP2 .saved STZ2 HX SP
    .arena LDZ2 ;alloc JSR2 HX NL

    ( free the saved address )
    ;print JSR2 "free 0a 00
    .saved LDZ2 ;free JSR2
    
    ( continue allocating, should see free address and then unused one )
    ;print JSR2 "alloc 20 00
    .arena LDZ2 ;alloc JSR2 HX SP
    .arena LDZ2 ;alloc JSR2 HX NL

    ( done, so exit )
    #010f DEO BRK

@emit
    &short SWP ,&byte JSR
    &byte DUP #04 SFT ,&char JSR
    &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
    JMP2r

( usage: ;print JSR2 "literal-string 00 <rest-of-code> )
@print ( -- )
    LDArk STHr DUP #18 DEO
    INC2r ,print JCN JMP2r

~alloc.tal