diff --git a/startup.4th b/startup.4th index 31dd1ee..eb40c71 100644 --- a/startup.4th +++ b/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%