add ALLOCA, %ALLOCA, and UNALLOCA for reserving space on the return stack

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