first pass at alloc.tal and test-alloc.tal
This commit is contained in:
parent
62bb579153
commit
efea7c94bf
|
|
@ -0,0 +1,195 @@
|
||||||
|
( alloc.tal )
|
||||||
|
( )
|
||||||
|
( SUMMARY )
|
||||||
|
( )
|
||||||
|
( this code can be used to dynamically claim and release memory. )
|
||||||
|
( )
|
||||||
|
( OVERVIEW )
|
||||||
|
( )
|
||||||
|
( memory is allocated using arenas which track which memory is free )
|
||||||
|
( and which memory is allocated. each arena can allocate items of a )
|
||||||
|
( fixed size (k bytes), and these arenas are configured at program )
|
||||||
|
( start using ;arena-init. )
|
||||||
|
( )
|
||||||
|
( an arena that can allocate n items of k bytes each has an overhead )
|
||||||
|
( of ceil(n/8)+6 bytes; it will occuppy n*k+ceil(n/8)+6 bytes total. )
|
||||||
|
( )
|
||||||
|
( each slot of memory of size k is tracked using 1 bit in the header's )
|
||||||
|
( bitset. we will "mark" the slot using 1 when the memory is allocated )
|
||||||
|
( and we will "free" the slot using 0 when the memory is free and )
|
||||||
|
( ready to be used again. )
|
||||||
|
( )
|
||||||
|
( this system has no means of compacting memory in use to maximize )
|
||||||
|
( contiguous free memory. however the entire arena can be efficiently )
|
||||||
|
( cleared in a single operation. )
|
||||||
|
( )
|
||||||
|
( ARENA LAYOUT )
|
||||||
|
( )
|
||||||
|
( ADDR SIZE DESCRIPTION )
|
||||||
|
( a 2 bytes item size (k) )
|
||||||
|
( a+2 2 bytes next-arena-addr (a+t) )
|
||||||
|
( a+4 2 bytes data-addr (a+6+h) )
|
||||||
|
( a+6 ceil(n/8) bytes header bitset (h = n bits) )
|
||||||
|
( a+6+h nk bytes n item slots )
|
||||||
|
( a+6+h+nk ... (next arena starts here) )
|
||||||
|
( )
|
||||||
|
( MAJOR WORDS )
|
||||||
|
( )
|
||||||
|
( init-arena ( n* k* -> arena* ) create arena holding n k-byte slots )
|
||||||
|
( clear-arena ( arena* -> ) free all memory in the given arena )
|
||||||
|
( alloc ( arena* -> addr* ) allocate one slot of the given arena )
|
||||||
|
( alloc-of ( k -> addr* ) find k-byte arena and allocate slot )
|
||||||
|
( free ( addr* -> ) find the given slot and free it )
|
||||||
|
( )
|
||||||
|
( ERROR DETECTION )
|
||||||
|
( )
|
||||||
|
( words that return arenas or addresses typically use 0000 or ffff to )
|
||||||
|
( signal errors. however, some words (such as free) will silently fail )
|
||||||
|
( if given invalid arguments. passing an invalid arena address will )
|
||||||
|
( likely corrupt your program's memory. )
|
||||||
|
|
||||||
|
( store up to n k-byte items )
|
||||||
|
( )
|
||||||
|
( total memory usage: n * k + ceil(n/8) + 6 )
|
||||||
|
@init-arena ( n* k* -> arena* )
|
||||||
|
DUP2 ,&k STR2 ( n k )
|
||||||
|
OVR2 #0007 ADD2 #0008 DIV2 DUP2 ,&h STR2 ( n k h )
|
||||||
|
STH2 ( n k [h] )
|
||||||
|
MUL2 STH2r ADD2 ( nk+h )
|
||||||
|
#0006 ADD2 ,&t STR2 ( ; t <- nk+h+6 )
|
||||||
|
;arena-pos LDA2 DUP2 ,&t LDR2 ADD2 GTH2k ,&toobig JCN ( a0 a1=a0+t )
|
||||||
|
DUP2 ;arena-pos STA2 ( a0 a1 )
|
||||||
|
SWP2 STH2k #0002 ADD2 STA2 ( [a0] ; a0+2<-a1 )
|
||||||
|
,&k LDR2 STH2kr STA2 ( [a0] ; a0<-k )
|
||||||
|
STH2kr ,&h LDR2 ADD2 #0006 ADD2 STH2kr #0004 ADD2 STA2 ( [a0] ; a0+4<-a0+6+h )
|
||||||
|
STH2r JMP2r ( a0 )
|
||||||
|
&toobig POP2 POP2 POP2 POP2 POP2 #0000 JMP2r ( 0000 )
|
||||||
|
[ &k $2 &h $2 &t $2 ]
|
||||||
|
|
||||||
|
( free all slots in the given arena )
|
||||||
|
@clear-arena ( arena* -> )
|
||||||
|
DUP2 ;arena-data JSR2 STH2 ( arena [data] )
|
||||||
|
;arena-header JSR2 STH2 ( [data header] )
|
||||||
|
#00 ( 00 [limit pos] )
|
||||||
|
&loop ( 00 [limit pos] )
|
||||||
|
GTH2kr STHr ,&ok JCN ( 00 [limit pos] )
|
||||||
|
,&done JMP ( 00 [limit pos] )
|
||||||
|
&ok ( 00 [limit pos] )
|
||||||
|
DUP STH2kr STA INC2r ( 00 [limit pos+1] )
|
||||||
|
,&loop JMP ( 00 [limit pos+1] )
|
||||||
|
&done ( 00 [limit pos] )
|
||||||
|
POP POP2r POP2r JMP2r ( )
|
||||||
|
|
||||||
|
( allocate one slot of the given arena )
|
||||||
|
@alloc ( arena* -> addr* )
|
||||||
|
DUP2 ;find-open-slot JSR2 ( arena index )
|
||||||
|
DUP2 #ffff EQU2 ,&failed JCN ( arena index )
|
||||||
|
OVR2 OVR2 ;mark-slot JSR2 ( arena index )
|
||||||
|
STH2 DUP2 ;arena-item JSR2 STH2r MUL2 ( arena index*k )
|
||||||
|
SWP2 ;arena-data JSR2 ADD2 JMP2r ( data+index*k )
|
||||||
|
&failed DUP2 EOR2 JMP2r ( 0000 )
|
||||||
|
|
||||||
|
( allocate one k-byte slot, finding the appropraite arena )
|
||||||
|
( )
|
||||||
|
( this word will fail if a k-byte arena wasn't already initialized )
|
||||||
|
@alloc-of ( k* -> addr* )
|
||||||
|
;find-arena JSR2 ORAk ( arena* arena-is-zero^ )
|
||||||
|
,&ok JCN JMP2r ( 0000 )
|
||||||
|
&ok ;alloc JMP2 ( addr* )
|
||||||
|
|
||||||
|
( free the slot corresponding to the given address )
|
||||||
|
( )
|
||||||
|
( if the address is not part of an arena this word does nothing )
|
||||||
|
@free ( addr* -> )
|
||||||
|
;find-addr JSR2
|
||||||
|
DUP2 #0000 EQU2 ,&skip JCN
|
||||||
|
;erase-slot JMP2
|
||||||
|
&skip POP2 JSR2
|
||||||
|
|
||||||
|
( reading metadata from the arena )
|
||||||
|
@arena-item ( arena* -> k* ) LDA2 JMP2r
|
||||||
|
@arena-next ( arena* -> addr* ) INC2 INC2 LDA2 JMP2r
|
||||||
|
@arena-data ( arena* -> addr* ) #0004 ADD2 LDA2 JMP2r
|
||||||
|
@arena-header ( arena* -> addr* ) #0006 ADD2 JMP2r
|
||||||
|
|
||||||
|
( find the arena for item size k, if any. )
|
||||||
|
@find-arena ( k* -> arena* )
|
||||||
|
STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [k*] )
|
||||||
|
&loop ( end* arena )
|
||||||
|
GTH2k #00 EQU ,¬found JCN ( end* arena* )
|
||||||
|
LDA2k STH2kr EQU2 ,&found JCN ( end* arena* [k*] )
|
||||||
|
;arena-next JSR2 ,&loop JCN ( end* next* [k*] )
|
||||||
|
&found ( end* arena* [k*] )
|
||||||
|
POP2r NIP2 JMP2r ( arena* )
|
||||||
|
¬found ( end* addr* [k*] )
|
||||||
|
POP2r POP2 POP2 #0000 JMP2r ( 0000 )
|
||||||
|
|
||||||
|
( find the arena and slot index (if any) for the given address )
|
||||||
|
@find-addr ( addr* -> arena* index* )
|
||||||
|
STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [addr*] )
|
||||||
|
&loop ( end* arena [addr*] )
|
||||||
|
GTH2k #00 EQU ,¬found JCN ( end* arena* [addr*] )
|
||||||
|
DUP2 ;arena-data JSR2 ( end* arena* start* [addr*] )
|
||||||
|
STH2kr GTH2 ,¬found JCN ( end* arena* [addr*] )
|
||||||
|
DUP2 ;arena-next JSR2 ( end* arena* next* [addr*] )
|
||||||
|
DUP2 STH2kr GTH2 ,&found JCN ( end* arena* next* [addr*] )
|
||||||
|
NIP2 ,&loop JCN ( end* next* [addr*] )
|
||||||
|
&found ( end* arena* next* [addr*] )
|
||||||
|
POP2 NIP2 ( arena* [addr*] )
|
||||||
|
DUP2 ;arena-data JSR2 STH2r ( arena* start* addr* )
|
||||||
|
SWP2 SUB2 ( arena* delta*=addr-start )
|
||||||
|
OVR2 LDA2 DIV2 JMP2r ( arena* slot*=delta/k )
|
||||||
|
¬found ( end* arena* [addr*] )
|
||||||
|
POP2r POP2 DUP2 EOR2 DUP2 JMP2r ( 0000 0000 )
|
||||||
|
|
||||||
|
( finds the index of the first open slot, if any )
|
||||||
|
( )
|
||||||
|
( returns the index of the slot, or ffff if all are full. )
|
||||||
|
@find-open-slot ( arena* -> index* )
|
||||||
|
STH2k ;arena-data JSR2 ( data [a] )
|
||||||
|
STH2r ;arena-header JSR2 ( data h )
|
||||||
|
LIT2r 0008 LIT2r 0000 ( data h [8 0] )
|
||||||
|
&loop ( data h [8 i] )
|
||||||
|
GTH2k #00 EQU ,&failed JCN ( data h [8 i] )
|
||||||
|
LDAk #ff NEQ ,&found JCN ( data h [8 i] )
|
||||||
|
INC2 OVR2r ADD2r ( data h [8 i+8] )
|
||||||
|
,&loop JMP ( data h [8 i+8] )
|
||||||
|
&failed ( data header [8 i] )
|
||||||
|
POP2 POP2 POP2r POP2r ( )
|
||||||
|
#ffff JMP2r ( 0000 )
|
||||||
|
&found ( data h [8 i] )
|
||||||
|
NIP2 NIP2r LDA ( bits [i] )
|
||||||
|
#80 SWP ( 80 bits [i] )
|
||||||
|
&loop2 ( 80 bits [i] )
|
||||||
|
GTHk ,&done2 JCN ( 80 bits [i] )
|
||||||
|
#10 SFT INC2r ,&loop2 JMP ( 80 bits<<1 [i+1] )
|
||||||
|
&done2 ( 80 _ [index] )
|
||||||
|
POP2 STH2r JMP2r ( index )
|
||||||
|
|
||||||
|
( mark a given slot in the arena as allocated )
|
||||||
|
@mark-slot ( arena* index* -> )
|
||||||
|
SWP2 OVR2 ( index* arena* index* )
|
||||||
|
#03 SFT2 ADD2 #0006 ADD2 STH2 ( index* [addr*=arena+index/8] )
|
||||||
|
#0007 AND2 NIP #80 SWP SFT ( bit^=80>>(index&7) [addr*] )
|
||||||
|
STH2kr LDA ORA ( new^=old|bit [addr*] )
|
||||||
|
STH2r STA JMP2r ( )
|
||||||
|
|
||||||
|
( deallocate a given slot in the arena )
|
||||||
|
@erase-slot ( arena* index* -> )
|
||||||
|
SWP2 OVR2 ( index* arena* index* )
|
||||||
|
#03 SFT2 ADD2 #0006 ADD2 STH2 ( index* [addr*=arena+index/8] )
|
||||||
|
#ff7f SWP2 #0007 AND2 NIP ( ff7f sh^=(index&7) [addr*] )
|
||||||
|
SFT2 NIP ( mask^=ff7f>>sh [addr*] )
|
||||||
|
STH2kr LDA AND ( new^=old&mask [addr*] )
|
||||||
|
STH2r STA JMP2r ( )
|
||||||
|
|
||||||
|
( keeps track of the limit of our arenas )
|
||||||
|
( )
|
||||||
|
( this will be the memory address of the next arena )
|
||||||
|
@arena-pos :arenas
|
||||||
|
|
||||||
|
( the starting point of all arenas )
|
||||||
|
( )
|
||||||
|
( memory addresses before this point are guaranteed )
|
||||||
|
( not to belong to any arena. )
|
||||||
|
@arenas
|
||||||
|
|
@ -0,0 +1,76 @@
|
||||||
|
%NL { #0a18 DEO }
|
||||||
|
%SP { #2018 DEO }
|
||||||
|
%WR { #18 DEO }
|
||||||
|
%HX { ;emit/short JSR2 }
|
||||||
|
|
||||||
|
|0000
|
||||||
|
@arena $2
|
||||||
|
@saved $2
|
||||||
|
|
||||||
|
|0100
|
||||||
|
( initialize arena: 16 cells x 4 bytes each )
|
||||||
|
LIT "i WR LIT "n WR LIT "i WR LIT "t WR NL
|
||||||
|
#0040 #0004 ;init-arena JSR2 .arena STZ2
|
||||||
|
|
||||||
|
( display the metadata about the arena )
|
||||||
|
LIT "h WR LIT "e WR LIT "a WR LIT "d WR LIT "e WR LIT "r WR LIT "s WR SP
|
||||||
|
.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 )
|
||||||
|
LIT "a WR LIT "l WR LIT "l WR LIT "o WR LIT "c WR SP
|
||||||
|
.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 )
|
||||||
|
LIT "c WR LIT "l WR LIT "e WR LIT "a WR LIT "r WR NL
|
||||||
|
.arena LDZ2 ;clear-arena JSR2
|
||||||
|
|
||||||
|
( allocate again, addresses should be the same as before )
|
||||||
|
LIT "a WR LIT "l WR LIT "l WR LIT "o WR LIT "c WR SP
|
||||||
|
.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 )
|
||||||
|
LIT "c WR LIT "l WR LIT "e WR LIT "a WR LIT "r WR NL
|
||||||
|
.arena LDZ2 ;clear-arena JSR2
|
||||||
|
|
||||||
|
( use alloc-of, addresses should be the same as above )
|
||||||
|
LIT "a WR LIT "l WR LIT "l WR LIT "o WR LIT "c WR LIT "- WR LIT "o WR LIT "f WR SP
|
||||||
|
#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 )
|
||||||
|
LIT "a WR LIT "l WR LIT "l WR LIT "o WR LIT "c WR SP
|
||||||
|
.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 )
|
||||||
|
LIT "f WR LIT "r WR LIT "e WR LIT "e WR NL
|
||||||
|
.saved LDZ2 ;free JSR2
|
||||||
|
|
||||||
|
( continue allocating, should see free address and then unused one )
|
||||||
|
LIT "a WR LIT "l WR LIT "l WR LIT "o WR LIT "c WR SP
|
||||||
|
.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
|
||||||
|
|
||||||
|
~alloc.tal
|
||||||
Loading…
Reference in New Issue