\ An implementation of CREATE DOES> and >BODY overtop of Gforth's existing one,
\ for illustration. Tested under Gforth 0.6.2.
\ Neal Bridges, 2006. neal@quartus.net
variable latestcreate
: (create) ( addr -- )
dup @ \ leave the dataspace address on the stack
swap cell+ perform \ perform the associated action
;
: CREATE
\ This implementation of CREATE gives each word two private cells:
\ The first holds the dataspace pointer at the time the word is CREATEd.
\ The second holds the xt of the associated action, noop by default.
align here >r \ save the address of the CREATEd word's dataspace pointer to backpatch
0 ,
here latestcreate ! \ save this so DOES> can assign an action to the CREATEd word
['] noop , \ default action is no action
:
r@ postpone literal postpone (create)
postpone ;
here r> ! \ backpatch the dataspace pointer with the correct address
;
: (does) ( xt -- ) latestcreate @ ! ;
: DOES>
['] noop postpone literal
here 1 cells - >r \ save this to backpatch the literal
postpone (does)
postpone ; \ terminate the current definition
here r> ! \ backpatch the literal with the xt of the subsequent code
(:noname) \ begin a new headerless word that doesn't leave an xt on the stack at ; time
; immediate
: >BODY
3 cells + @ @ \ this works in Gforth to retrieve the dataspace pointer from our CREATEs
;