diff --git a/alloc.tal b/alloc.tal index 13b0ac0..87cbd47 100644 --- a/alloc.tal +++ b/alloc.tal @@ -35,11 +35,12 @@ ( ) ( 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 ) +( NAME EFFECT DESCRIPTION ) +( 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 ) ( ) @@ -51,15 +52,17 @@ ( store up to n k-byte items ) ( ) ( total memory usage: n * k + ceil(n/8) + 6 ) +( ) +( returns 0000 if allocated region is larger than remaining space ) @init-arena ( n* k* -> arena* ) DUP2 ,&k STR2 ( n k ) - OVR2 #0007 ADD2 #0008 DIV2 DUP2 ,&h STR2 ( n k h ) + OVR2 #0007 ADD2 #03 SFT2 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 ) + SWP2 STH2k INC2 INC2 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 ) @@ -67,6 +70,8 @@ [ &k $2 &h $2 &t $2 ] ( free all slots in the given arena ) +( ) +( if an invalid arena is provided corruption will occur ) @clear-arena ( arena* -> ) DUP2 ;arena-data JSR2 STH2 ( arena [data] ) ;arena-header JSR2 STH2 ( [data header] ) @@ -81,6 +86,8 @@ POP POP2r POP2r JMP2r ( ) ( allocate one slot of the given arena ) +( ) +( returns 0000 if allocation fails ) @alloc ( arena* -> addr* ) DUP2 ;find-open-slot JSR2 ( arena index ) DUP2 #ffff EQU2 ,&failed JCN ( arena index ) @@ -92,6 +99,8 @@ ( allocate one k-byte slot, finding the appropraite arena ) ( ) ( this word will fail if a k-byte arena wasn't already initialized ) +( ) +( returns 00000 if allocation fails ) @alloc-of ( k* -> addr* ) ;find-arena JSR2 ORAk ( arena* arena-is-zero^ ) ,&ok JCN JMP2r ( 0000 ) @@ -100,9 +109,11 @@ ( free the slot corresponding to the given address ) ( ) ( if the address is not part of an arena this word does nothing ) +( ) +( if an unmanaged address is provided nothing will happen ) @free ( addr* -> ) ;find-addr JSR2 - DUP2 #0000 EQU2 ,&skip JCN + ORAk #00 EQU ,&skip JCN ;erase-slot JMP2 &skip POP2 JSR2 @@ -113,6 +124,8 @@ @arena-header ( arena* -> addr* ) #0006 ADD2 JMP2r ( find the arena for item size k, if any. ) +( ) +( returns 0000 if no arena can be found ) @find-arena ( k* -> arena* ) STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [k*] ) &loop ( end* arena ) @@ -125,6 +138,8 @@ POP2r POP2 POP2 #0000 JMP2r ( 0000 ) ( find the arena and slot index (if any) for the given address ) +( ) +( returns 0000 0000 if address does not belong to an arena ) @find-addr ( addr* -> arena* index* ) STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [addr*] ) &loop ( end* arena [addr*] ) @@ -144,7 +159,9 @@ ( finds the index of the first open slot, if any ) ( ) -( returns the index of the slot, or ffff if all are full. ) +( returns the index of the slot ) +( ) +( if all slots are full returns ffff ) @find-open-slot ( arena* -> index* ) STH2k ;arena-data JSR2 ( data [a] ) STH2r ;arena-header JSR2 ( data h ) @@ -162,25 +179,29 @@ #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] ) + DUP ADD INC2r ,&loop2 JMP ( 80 bits<<1 [i+1] ) &done2 ( 80 _ [index] ) POP2 STH2r JMP2r ( index ) ( mark a given slot in the arena as allocated ) +( ) +( corruption will occur if an invalid arena or index are provided ) @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*] ) + LDAkr STHr ORA ( new^=old|bit [addr*] ) STH2r STA JMP2r ( ) ( deallocate a given slot in the arena ) +( ) +( corruption will occur if an invalid arena or index are provided ) @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*] ) + LDAkr STHr AND ( new^=old&mask [addr*] ) STH2r STA JMP2r ( ) ( keeps track of the limit of our arenas ) diff --git a/test-alloc.tal b/test-alloc.tal index ab7f1d9..2075379 100644 --- a/test-alloc.tal +++ b/test-alloc.tal @@ -1,3 +1,18 @@ +( 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 } %WR { #18 DEO } @@ -9,8 +24,9 @@ |0100 ( initialize arena: 16 cells x 4 bytes each ) - LIT "i WR LIT "n WR LIT "i WR LIT "t WR NL + LIT "i WR LIT "n WR LIT "i WR LIT "t WR #0040 #0004 ;init-arena JSR2 .arena STZ2 + SP ;arenas HX SP ;arena-pos LDA2 HX NL ( 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