add CLOSURE to capture data and code in a single execution token

startup.4th

@@ -1409,6 +1409,28 @@ VARIABLE TOTAL
    ( S: obj-addr1 obj-addr2 copy-size R: obj-addr1 obj-addr2 )
    CMOVE R> R> FREE ;
 
+>>SYSTEM
+
+\ Execute the closure captured at a-addr
+\ The memory at a-addr consists of a cell count, an xt, and >=0 cells of data
+\ The cell count includes the xt and must be >=1
+\ For example, if a-addr points to "4 xt x1 x2 x3" (ascending addresses) then
+\ this is equivalent to the sequence "x3 x2 x1 xt EXECUTE"
+: (CLOSURE) ( i*x a-addr -- j*x )
+   DUP @ SWAP CELL+ N@ EXECUTE ;
+
+>>FORTH
+
+\ Store xt1 and xu ... x1 in a "closure object" and return an execution token
+\ The execution token is located at the start of the "closure object" and may
+\ be passed to FREE to release the memory when the closure is no longer needed
+\ When executed, the closure object will place xu ... x1 on the data stack
+\ and then execute the captured xt1
+: CLOSURE ( xu ... x1 xt1 u -- xt2 )
+   1+ DUP 5 + CELLS ALLOCATE DUP >R
+   DODOES OVER ! CELL+ [ ' (CLOSURE) >DFA @ ] LITERAL OVER ! CELL+
+   0 OVER ! CELL+ 0 OVER ! CELL+ 2DUP ! CELL+ N! R> ;
+
 \ Basic type descriptors giving alignment and size for each type
 1         1       2CONSTANT CHAR%
 1 ALIGNED 1 CELLS 2CONSTANT CELL%