From efea7c94bf67e8b57a11bb37c3efc4350874eaf3 Mon Sep 17 00:00:00 2001 From: d6 Date: Wed, 23 Nov 2022 00:22:28 -0500 Subject: [PATCH] first pass at alloc.tal and test-alloc.tal --- alloc.tal | 195 +++++++++++++++++++++++++++++++++++++++++++++++++ test-alloc.tal | 76 +++++++++++++++++++ 2 files changed, 271 insertions(+) create mode 100644 alloc.tal create mode 100644 test-alloc.tal diff --git a/alloc.tal b/alloc.tal new file mode 100644 index 0000000..2cfb88c --- /dev/null +++ b/alloc.tal @@ -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 diff --git a/test-alloc.tal b/test-alloc.tal new file mode 100644 index 0000000..ab7f1d9 --- /dev/null +++ b/test-alloc.tal @@ -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