Work on extraxt stuff

cross.fs

@@ -1198,9 +1198,9 @@ Ghost no-to drop
 Ghost refill drop
 
 Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop
-Ghost :dovar	Ghost dovar-vt	Ghost dodoes-vt	2drop drop
-Ghost :doextra  Ghost doextra-vt Ghost extra,   2drop drop
-Ghost :dodoesxt drop
+Ghost :dovar	drop
+Ghost :doextra  drop
+Ghost :dodoesxt Ghost :doextraxt 2drop
 
 \ \ Parameter for target systems                         06oct92py
 
@@ -3037,7 +3037,8 @@ ghost peephole-compile,
 2drop
 ghost does,
 ghost extra,
-2drop
+ghost extraxt,
+2drop drop
 ghost value,
 ghost constant,
 2drop
@@ -3265,6 +3266,11 @@ Build: ;Build
 by: :doextra ;DO
 vt: [G'] extra, gset-optimizer ;vt
 
+Builder extraxt>-dummy
+Build: ;Build
+by: :doextraxt ;DO
+vt: [G'] extraxt, gset-optimizer ;vt
+
 \ Variables and Constants                              05dec92py
 
 Builder (Constant)

engine/forth.h

@@ -119,7 +119,8 @@ extern void* (*realloc_l)(void* addr, size_t size);
 #define DOSEMIABICODE   9
 #define DOEXTRA	10
 #define DODOESXT 11
-#define DOER_MAX        11
+#define DOEXTRAXT 12
+#define DOER_MAX 12
 
 #include "machine.h"
 
@@ -319,15 +320,19 @@ typedef Label *Xt;
 #define DOES_CODE1(cfa)	 ((Xt *)(((Cell *)cfa)[1]))
 #define DOES_CODEXT(cfa) ((Xt)(((Cell *)cfa)[1]))
 
-/* MAKE_CF creates an appropriate code field at the cfa;
-   ca is the code address */
+/* Extra is used for DOES */
 #define VTLINK 0
 #define VTCOMPILE 1
-#define VTLIT 2
-#define VTEXTRA 3
-#define VTTO 4
+#define VTTO 2
+#define VT2INT 3
+#define VT2COMP 4
+#define VTDEFER 5
+#define VTEXTRA 6
 #define EXTRA_CODE(cfa) ((Xt *)(((Cell **)cfa)[-1][VTEXTRA]))
 #define EXTRA_CODEXT(cfa) ((Xt)(((Cell **)cfa)[-1][VTEXTRA]))
+
+/* MAKE_CF creates an appropriate code field at the cfa;
+   ca is the code address */
 #define MAKE_CF(cfa,ca) ((*(Label *)(cfa)) = ((Label)ca))
 /* make a code field for a defining-word-defined word */
 

kernel/comp.fs

@@ -552,6 +552,14 @@ extra>-dummy (doextra-dummy)
     THEN
     latestxt extra-code! ;
 
+extraxt>-dummy (doextraxt-dummy)
+: !extraxt   ( addr -- ) \ gforth store-extra
+    created?
+    IF
+	['] extraxt, set-optimizer
+    THEN
+    latestxt extra-xt! ;
+
 \ call with locals - unused
 
 \ docolloc-dummy (docolloc-dummy)

kernel/getdoers.fs

@@ -92,3 +92,9 @@ doer? :doextra [IF]
 : doextra: ( -- addr )
     ['] (doextra-dummy) >code-address ;
 [THEN]
+
+doer? :doextraxt [IF]
+\ extra>-dummy (doextra-dummy)
+: doextraxt: ( -- addr )
+    ['] (doextraxt-dummy) >code-address ;
+[THEN]

kernel/int.fs

@@ -25,6 +25,7 @@
 
 has? new-does [IF]
     : extra, ['] extra-exec peephole-compile, , ;
+    : extraxt, ['] extra-xt peephole-compile, , ;
     : >comp  ( xt -- ) name>comp execute ;
     : no-to ( xt -- )
 	\ default to action: report an error ASAP (even right when COMPILE,ing)
@@ -578,6 +579,11 @@ cell% -2 * 0 0 field body> ( xt -- a_addr )
 \G @i{xt1} is the execution token of the assigned Forth code.
     doextra: any-code! ;
 
+: extra-xt! ( xt1 xt2 -- ) \ gforth
+\G Create a code field at @i{xt2} for a child of a @code{DOES>}-word;
+\G @i{xt1} is the execution token of the assigned Forth code.
+    doextraxt: any-code! ;
+
 2 cells constant /does-handler ( -- n ) \ gforth
 \G The size of a @code{DOES>}-handler (includes possible padding).