d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update alloc docs + optimizations

This commit is contained in:
~d6 2022-11-23 12:58:51 -05:00
parent 9647d78805
commit fa800fcfba
2 changed files with 50 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
alloc.tal
View File

@ -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 )

18
test-alloc.tal
View File

@ -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