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 ) ( MAJOR WORDS )
( ) ( )
( init-arena ( n* k* -> arena* ) create arena holding n k-byte slots ) ( NAME EFFECT DESCRIPTION )
( clear-arena ( arena* -> ) free all memory in the given arena ) ( init-arena n* k* -> arena* create arena holding n k-byte slots )
( alloc ( arena* -> addr* ) allocate one slot of the given arena ) ( clear-arena arena* -> free all memory in the given arena )
( alloc-of ( k -> addr* ) find k-byte arena and allocate slot ) ( alloc arena* -> addr* allocate one slot of the given arena )
( free ( addr* -> ) find the given slot and free it ) ( alloc-of k* -> addr* find k-byte arena and allocate slot )
( free addr* -> find the given slot and free it )
( ) ( )
( ERROR DETECTION ) ( ERROR DETECTION )
( ) ( )
@ -51,15 +52,17 @@
( store up to n k-byte items ) ( store up to n k-byte items )
( ) ( )
( total memory usage: n * k + ceil(n/8) + 6 ) ( total memory usage: n * k + ceil(n/8) + 6 )
( )
( returns 0000 if allocated region is larger than remaining space )
@init-arena ( n* k* -> arena* ) @init-arena ( n* k* -> arena* )
DUP2 ,&k STR2 ( n k ) 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] ) STH2 ( n k [h] )
MUL2 STH2r ADD2 ( nk+h ) MUL2 STH2r ADD2 ( nk+h )
#0006 ADD2 ,&t STR2 ( ; t <- nk+h+6 ) #0006 ADD2 ,&t STR2 ( ; t <- nk+h+6 )
;arena-pos LDA2 DUP2 ,&t LDR2 ADD2 GTH2k ,&toobig JCN ( a0 a1=a0+t ) ;arena-pos LDA2 DUP2 ,&t LDR2 ADD2 GTH2k ,&toobig JCN ( a0 a1=a0+t )
DUP2 ;arena-pos STA2 ( a0 a1 ) 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 ) ,&k LDR2 STH2kr STA2 ( [a0] ; a0<-k )
STH2kr ,&h LDR2 ADD2 #0006 ADD2 STH2kr #0004 ADD2 STA2 ( [a0] ; a0+4<-a0+6+h ) STH2kr ,&h LDR2 ADD2 #0006 ADD2 STH2kr #0004 ADD2 STA2 ( [a0] ; a0+4<-a0+6+h )
STH2r JMP2r ( a0 ) STH2r JMP2r ( a0 )
@ -67,6 +70,8 @@
[ &k $2 &h $2 &t $2 ] [ &k $2 &h $2 &t $2 ]
( free all slots in the given arena ) ( free all slots in the given arena )
( )
( if an invalid arena is provided corruption will occur )
@clear-arena ( arena* -> ) @clear-arena ( arena* -> )
DUP2 ;arena-data JSR2 STH2 ( arena [data] ) DUP2 ;arena-data JSR2 STH2 ( arena [data] )
;arena-header JSR2 STH2 ( [data header] ) ;arena-header JSR2 STH2 ( [data header] )
@ -81,6 +86,8 @@
POP POP2r POP2r JMP2r ( ) POP POP2r POP2r JMP2r ( )
( allocate one slot of the given arena ) ( allocate one slot of the given arena )
( )
( returns 0000 if allocation fails )
@alloc ( arena* -> addr* ) @alloc ( arena* -> addr* )
DUP2 ;find-open-slot JSR2 ( arena index ) DUP2 ;find-open-slot JSR2 ( arena index )
DUP2 #ffff EQU2 ,&failed JCN ( arena index ) DUP2 #ffff EQU2 ,&failed JCN ( arena index )
@ -92,6 +99,8 @@
( allocate one k-byte slot, finding the appropraite arena ) ( allocate one k-byte slot, finding the appropraite arena )
( ) ( )
( this word will fail if a k-byte arena wasn't already initialized ) ( this word will fail if a k-byte arena wasn't already initialized )
( )
( returns 00000 if allocation fails )
@alloc-of ( k* -> addr* ) @alloc-of ( k* -> addr* )
;find-arena JSR2 ORAk ( arena* arena-is-zero^ ) ;find-arena JSR2 ORAk ( arena* arena-is-zero^ )
,&ok JCN JMP2r ( 0000 ) ,&ok JCN JMP2r ( 0000 )
@ -100,9 +109,11 @@
( free the slot corresponding to the given address ) ( free the slot corresponding to the given address )
( ) ( )
( if the address is not part of an arena this word does nothing ) ( if the address is not part of an arena this word does nothing )
( )
( if an unmanaged address is provided nothing will happen )
@free ( addr* -> ) @free ( addr* -> )
;find-addr JSR2 ;find-addr JSR2
DUP2 #0000 EQU2 ,&skip JCN ORAk #00 EQU ,&skip JCN
;erase-slot JMP2 ;erase-slot JMP2
&skip POP2 JSR2 &skip POP2 JSR2
@ -113,6 +124,8 @@
@arena-header ( arena* -> addr* ) #0006 ADD2 JMP2r @arena-header ( arena* -> addr* ) #0006 ADD2 JMP2r
( find the arena for item size k, if any. ) ( find the arena for item size k, if any. )
( )
( returns 0000 if no arena can be found )
@find-arena ( k* -> arena* ) @find-arena ( k* -> arena* )
STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [k*] ) STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [k*] )
&loop ( end* arena ) &loop ( end* arena )
@ -125,6 +138,8 @@
POP2r POP2 POP2 #0000 JMP2r ( 0000 ) POP2r POP2 POP2 #0000 JMP2r ( 0000 )
( find the arena and slot index (if any) for the given address ) ( 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* ) @find-addr ( addr* -> arena* index* )
STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [addr*] ) STH2 ;arena-pos LDA2 ;arenas ( end* arena0* [addr*] )
&loop ( end* arena [addr*] ) &loop ( end* arena [addr*] )
@ -144,7 +159,9 @@
( finds the index of the first open slot, if any ) ( 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* ) @find-open-slot ( arena* -> index* )
STH2k ;arena-data JSR2 ( data [a] ) STH2k ;arena-data JSR2 ( data [a] )
STH2r ;arena-header JSR2 ( data h ) STH2r ;arena-header JSR2 ( data h )
@ -162,25 +179,29 @@
#80 SWP ( 80 bits [i] ) #80 SWP ( 80 bits [i] )
&loop2 ( 80 bits [i] ) &loop2 ( 80 bits [i] )
GTHk ,&done2 JCN ( 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] ) &done2 ( 80 _ [index] )
POP2 STH2r JMP2r ( index ) POP2 STH2r JMP2r ( index )
( mark a given slot in the arena as allocated ) ( mark a given slot in the arena as allocated )
( )
( corruption will occur if an invalid arena or index are provided )
@mark-slot ( arena* index* -> ) @mark-slot ( arena* index* -> )
SWP2 OVR2 ( index* arena* index* ) SWP2 OVR2 ( index* arena* index* )
#03 SFT2 ADD2 #0006 ADD2 STH2 ( index* [addr*=arena+index/8] ) #03 SFT2 ADD2 #0006 ADD2 STH2 ( index* [addr*=arena+index/8] )
#0007 AND2 NIP #80 SWP SFT ( bit^=80>>(index&7) [addr*] ) #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 ( ) STH2r STA JMP2r ( )
( deallocate a given slot in the arena ) ( deallocate a given slot in the arena )
( )
( corruption will occur if an invalid arena or index are provided )
@erase-slot ( arena* index* -> ) @erase-slot ( arena* index* -> )
SWP2 OVR2 ( index* arena* index* ) SWP2 OVR2 ( index* arena* index* )
#03 SFT2 ADD2 #0006 ADD2 STH2 ( index* [addr*=arena+index/8] ) #03 SFT2 ADD2 #0006 ADD2 STH2 ( index* [addr*=arena+index/8] )
#ff7f SWP2 #0007 AND2 NIP ( ff7f sh^=(index&7) [addr*] ) #ff7f SWP2 #0007 AND2 NIP ( ff7f sh^=(index&7) [addr*] )
SFT2 NIP ( mask^=ff7f>>sh [addr*] ) SFT2 NIP ( mask^=ff7f>>sh [addr*] )
STH2kr LDA AND ( new^=old&mask [addr*] ) LDAkr STHr AND ( new^=old&mask [addr*] )
STH2r STA JMP2r ( ) STH2r STA JMP2r ( )
( keeps track of the limit of our arenas ) ( 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 } %NL { #0a18 DEO }
%SP { #2018 DEO } %SP { #2018 DEO }
%WR { #18 DEO } %WR { #18 DEO }
@ -9,8 +24,9 @@
|0100 |0100
( initialize arena: 16 cells x 4 bytes each ) ( 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 #0040 #0004 ;init-arena JSR2 .arena STZ2
SP ;arenas HX SP ;arena-pos LDA2 HX NL
( display the metadata about the arena ) ( 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 LIT "h WR LIT "e WR LIT "a WR LIT "d WR LIT "e WR LIT "r WR LIT "s WR SP