97 lines
2.7 KiB
Tal
97 lines
2.7 KiB
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
|