diff --git a/startup.4th b/startup.4th index b0729d2..ef352a8 100644 --- a/startup.4th +++ b/startup.4th @@ -1767,12 +1767,32 @@ ENDSTRUCT MEMBLOCK% \ The xt points to the codeword, which is two cells above the base of the object : FREE-CLOSURE ( closure-xt -- ) 2 CELLS- FREE ; +' SYSTEM (DEFINITIONS) + +0x33A110CA CONSTANT ALLOCA-MARK + +: ?ALLOCA-MARK R> R@ ALLOCA-MARK <> "mismatched UNALLOCA" ?FAIL >R ; + +' FORTH (DEFINITIONS) + +\ NOTE: ALLOCA, UNALLOCA, and %ALLOCA all assume that the return address +\ ("nest-sys" in ANS FORTH) is a single cell which may be relocated. + +\ Allocate some space from the return stack; must release with UNALLOCA +: ALLOCA ( bytes -- a-addr ) + R> RSP@ ROT OVER SWAP - -8 AND DUP RSP! -ROT >R ALLOCA-MARK >R >R ; + +\ Release return-stack space reserved with ALLOCA +: UNALLOCA R> ?ALLOCA-MARK RDROP R> RSP! >R ; + \ Reserve data or heap space for a data structure given alignment and size -\ It is assumed that ALLOCATE (but not ALLOT) returns an address suitably -\ aligned for any primitive data type; %ALLOCATE is not suitable for data -\ structures with unusually high alignment requirements +\ It is assumed that ALLOCATE and ALLOCA (but not ALLOT) return addresses +\ suitably aligned for any primitive data type; %ALLOCATE and %ALLOCA are +\ not suitable for data structures with unusually high alignment requirements +\ %ALLOCATE must be paired with FREE; %ALLOCA must be paired with UNALLOCA : %ALLOT ( align bytes -- a-addr ) SWAP ALIGN-TO HERE SWAP ALLOT ; : %ALLOCATE ( align bytes -- a-addr ) %SIZEOF ALLOCATE ; +: %ALLOCA ( align bytes -- a-addr ) NIP R> SWAP ALLOCA SWAP >R ; \ Reserve data space for a data structure and give it a name \ The content is indeterminate and must be initialized before the first use