Cleanup and rename doextra->dodoes

closures.fs

@@ -101,7 +101,7 @@ forth definitions
 
 : (closure-;]) ( closure-sys lastxt -- )
     >r r@ dup >namevt @ >vtextra !
-    ['] extraxt, set-optimizer
+    ['] does, set-optimizer
     vt,
     postpone THEN
     orig? r> >namevt @ swap ! drop
@@ -116,7 +116,7 @@ forth definitions
 
 : closure> ( body -- addr ) \ gforth-experimental closure-end
     \G create trampoline head
-    doextraxt: >l >l lp@ cell+ ;
+    dodoes: >l >l lp@ cell+ ;
 : end-dclosure ( unravel-xt -- closure-sys )
     >r wrap@
     postpone lit >mark

comp-i.fs

@@ -20,7 +20,7 @@
 require sections.fs
 
 s" address-unit-bits" environment? drop constant bits/au
-11 constant maxdoer-tag
+9 constant maxdoer-tag
 
 0 value image1
 0 value size1

cross.fs

@@ -1190,16 +1190,12 @@ Ghost hex drop
 Ghost lit@ drop
 Ghost lit-perform drop
 Ghost lit+ drop
-Ghost does-exec drop
-Ghost extra-exec drop
-Ghost extra-xt drop
 Ghost does-xt drop
 Ghost no-to drop
 Ghost refill drop
 
-Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop
+Ghost :docol    Ghost :dodoes   2drop
 Ghost :dovar	drop
-Ghost :doextraxt drop
 
 \ \ Parameter for target systems                         06oct92py
 
@@ -1832,7 +1828,7 @@ Ghost (+do)     Ghost (-do)     Ghost (u-do)    2drop drop
 Ghost (for)                                     drop
 Ghost (loop)    Ghost (+loop)   Ghost (-loop)   2drop drop
 Ghost (next)                                    drop
-Ghost !does     Ghost !extraxt                  2drop
+Ghost set-does> drop
 Ghost compile,                                  drop
 Ghost (.")      Ghost (S")      Ghost (ABORT")  2drop drop
 Ghost (C")      Ghost c(abort") Ghost type      2drop drop
@@ -2583,9 +2579,9 @@ T 1 cells H Value xt>body
 
 Defer gset-extra
 
-: doextraxt, ( does-action-ghost -- )
-    ]comp [G'] :doextraxt addr, comp[
-    gset-extra ;					' doextraxt, plugin-of dodoes,
+: (dodoes,) ( does-action-ghost -- )
+    ]comp [G'] :dodoes addr, comp[
+    gset-extra ;					' (dodoes,) plugin-of dodoes,
 
 : (dlit,) ( n -- ) compile lit td, ;			' (dlit,) plugin-of dlit,
 
@@ -2833,14 +2829,10 @@ Defer instant-interpret-does>-hook  ' noop IS instant-interpret-does>-hook
 X has? new-does [IF]
 X has? primcentric [IF]
 : does-resolved ( ghost -- )
-    compile does-exec g>xt T a, H ;
-: extra-resolved ( ghost -- )
-    compile extra-xt g>xt T a, H ;
+    compile does-xt g>xt T a, H ;
 [ELSE]
 : does-resolved ( ghost -- )
     g>xt T a, H ;
-: extra-resolved ( ghost -- )
-    g>xt T a, H ;
 [THEN]
 
 : resolve-does>-part ( -- )
@@ -2850,14 +2842,14 @@ X has? primcentric [IF]
 
 Cond: DOES>
     T here cfaligned H [ T has? primcentric H [IF] ] 8 [ [ELSE] ] 7 [ [THEN] ] T cells
-    H + alit, compile !extraxt compile ;
+    H + alit, compile set-does> compile ;
     Last-Header-Ghost @ >do:ghost @ >r
 T :noname H
     r> ?dup IF  swap resolve  ELSE  drop  THEN
 ;Cond
 
 : DOES>
-    ['] extra-resolved created >comp !
+    ['] does-resolved created >comp !
     T here cfaligned #10 cells H \ includes noname header+vtable
     + !newdoes
     T :noname H 2drop
@@ -2867,7 +2859,7 @@ T :noname H
 T has? primcentric H [IF]
 : does-resolved ( ghost -- )
 \    g>xt dup T >body H alit, compile call T cell+ @ a, H ;
-    compile does-exec g>xt T a, H ;
+    compile does-xt g>xt T a, H ;
 [ELSE]
 : does-resolved ( ghost -- )
     g>xt T a, H ;
@@ -3014,7 +3006,7 @@ Ghost docol-vt drop
 ghost :,
 ghost peephole-compile,
 2drop
-ghost extraxt,
+ghost set-does>
 drop
 ghost value,
 ghost constant,
@@ -3187,11 +3179,11 @@ variable cross-boot[][]
 
 :noname ( doesxt -- )
     tlastcfa @ [G'] :dovar killref
-    [G'] extraxt, gset-optimizer
+    [G'] does, gset-optimizer
     >space here >r ghostheader space>
     ['] colon-resolved r@ >comp !
     r@ created >do:ghost ! r@ swap resolve
-    r> tlastcfa @ >tempdp doextraxt, tempdp> ;
+    r> tlastcfa @ >tempdp dodoes, tempdp> ;
 IS !newdoes
 
 : ;DO ( [xt] [colon-sys] -- )
@@ -3228,11 +3220,6 @@ by: :dodoes ;DO
 vt: [G'] does, gset-optimizer ;vt
 \ vtghost: dodoes-vt
 
-Builder extraxt>-dummy
-Build: ;Build
-by: :doextraxt ;DO
-vt: [G'] extraxt, gset-optimizer ;vt
-
 \ Variables and Constants                              05dec92py
 
 Builder (Constant)

engine/forth.h

@@ -114,12 +114,10 @@ extern void* (*realloc_l)(void* addr, size_t size);
 #define DODEFER	4
 #define DOFIELD	5
 #define DOVAL	6
-#define DODOES	7
+#define DODOES  7
 #define DOABICODE	8
 #define DOSEMIABICODE   9
-#define DOEXTRAXT 10
-#define DODOESXT 11
-#define DOER_MAX 11
+#define DOER_MAX 9
 
 #include "machine.h"
 

kernel/aliases0.fs

@@ -27,8 +27,6 @@
 -9 Doer: :dodoes
 -&10 Doer: :doabicode
 -&11 Doer: :do;abicode
--&12 Doer: :doextraxt
--&13 Doer: :dodoesxt
 -&2 first-primitive
 \ this does not work for (at least) (DODOES),
 \ so the following routines are commented out

kernel/comp.fs

@@ -522,13 +522,6 @@ opt: drop ( xt -- )
     [ has? peephole [IF] ] finish-code [ [THEN] ]
     defstart ;
 
-: !extraxt   ( addr -- ) \ gforth store-extra
-    created?
-    IF
-	['] extraxt, set-optimizer
-    THEN
-    latestxt extra-xt! ;
-
 \ call with locals - unused
 
 \ docolloc-dummy (docolloc-dummy)
@@ -594,7 +587,9 @@ Create vttemplate
 : set-defer@    ( defer@-xt -- ) vttemplate >vtdefer@ ! ;
 : set->int      ( xt -- ) vttemplate >vt>int ! ;
 : set->comp     ( xt -- ) vttemplate >vt>comp ! ;
-: set-does>     ( xt -- ) !extraxt ; \ more work than the aboves
+: set-does>     ( xt -- ) vttemplate >vtextra !
+    created?  IF  ['] does, set-optimizer  THEN
+    dodoes: latestxt ! ;
 
 :noname ( -- colon-sys ) start-xt  set-optimizer ;
 :noname ['] set-optimizer start-xt-like ;
@@ -740,13 +735,7 @@ defer 0-adjust-locals-size ( -- )
 \ does>
 
 : created? ( -- flag )
-    vttemplate >vtcompile, @ ['] udp >namevt @ >vtcompile, @ = ;
-
-: !does    ( addr -- ) \ gforth	store-does
-    created? IF
-	['] does, set-optimizer
-    THEN
-    latestxt does-code! ;
+    vttemplate >vtcompile, @ ['] variable, = ;
 
 : comp-does>; ( some-sys flag lastxt -- )
     \ used as colon-sys xt; this is executed after ";" has removed the

kernel/int.fs

@@ -23,16 +23,13 @@
 
 \ \ input stream primitives                       	23feb93py
 
-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)
-	#-12 throw ;
-    opt: #-12 throw ; \ 
-    : no-defer@ ( xt -- ) #-2055 throw ;
-[THEN]
+: >comp  ( xt -- ) name>comp execute ;
+: no-to ( xt -- )
+    \ default to action: report an error ASAP (even right when COMPILE,ing)
+    #-12 throw ;
+opt: #-12 throw ; \ 
+: no-defer@ ( xt -- ) #-2055 throw ;
+opt: #-2055 throw ;
 
 require ./basics.fs 	\ bounds decimal hex ...
 require ./io.fs		\ type ...
@@ -539,7 +536,7 @@ cell% -1 * 0 0 field body> ( xt -- a_addr )
 \G If @i{xt} is the execution token of a child of a @code{DOES>} word,
 \G @i{a-addr} is the start of the Forth code after the @code{DOES>};
 \G Otherwise @i{a-addr} is 0.
-    dup @ doextraxt: = if
+    dup @ dodoes: = if
 	>namevt @ >vtextra @ >body
     else
 	drop 0
@@ -552,18 +549,11 @@ cell% -1 * 0 0 field body> ( xt -- a_addr )
     \ for implementing DOES> and ;ABI-CODE, maybe :
     \ code-address is stored at cfa, a-addr at cfa+cell
     over !  >namevt @ >vtextra ! ;
-    
-: does-code! ( a-addr xt -- ) \ gforth
-\G Create a code field at @i{xt} for a child of a @code{DOES>}-word;
-\G @i{a-addr} is the start of the Forth code after @code{DOES>}.
-    dodoes: over ! cell+ ! ;
-\ after eliminating dodoes:, this changes to
-\   body> extra-xt! ;
-
-: extra-xt! ( xt1 xt2 -- ) \ gforth
+
+: does-code! ( 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! ;
+    dodoes: any-code! ;
 
 2 cells constant /does-handler ( -- n ) \ gforth
 \G The size of a @code{DOES>}-handler (includes possible padding).
@@ -889,7 +879,7 @@ defer reset-dpp
 
 : gforth ( -- )
     ." Gforth " version-string type 
-    ." , Copyright (C) 1995-2017,2018 Free Software Foundation, Inc." cr
+    ." , Copyright (C) 1995-2018 Free Software Foundation, Inc." cr
     ." Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'"
 [ has? os [IF] ]
      cr ." Type `help' for basic help"

kernel/vtables.fs

@@ -29,7 +29,7 @@
 : field+, >body @ ['] lit+ peephole-compile, , ;
 : abi-code, >body ['] abi-call peephole-compile, , ;
 : ;abi-code, ['] ;abi-code-exec peephole-compile, , ;
-: does, ['] does-exec peephole-compile, , ;
+: does, ['] does-xt peephole-compile, , ;
 : umethod, >body cell+ 2@ ['] u#exec peephole-compile, , , ;
 : uvar, >body cell+ 2@ ['] u#+ peephole-compile, , , ;
 \ : :loc, >body ['] call-loc peephole-compile, , ;

libcc.fs

@@ -916,7 +916,7 @@ tmp$ $execstr-ptr !
 noname Create
 \ can not be named due to rebind-libcc
 ' cfun, set-optimizer
-' rt-does> !extraxt
+' rt-does> set-does>
 
 latestxt to rt-vtable
 

prim

@@ -217,24 +217,13 @@ INST_TAIL;
 goto *next_code;
 #endif /* defined(NO_IP) */
 
-(dodoes) ( -- a_body R:a_retaddr )	gforth-internal	paren_dodoes
-""run-time routine for @code{does>}-defined words""
-#ifdef NO_IP
-a_retaddr = next_code;
+(dodoes) ( -- a_body )  gforth-internal       paren_dodoes
 a_body = PFA(CFA);
-INST_TAIL;
-#ifdef DEBUG
-debugp(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body);
-#endif
-goto **(Label *)DOES_CODE1(CFA);
-#else /* !defined(NO_IP) */
-a_retaddr = (Cell *)IP;
-a_body = PFA(CFA);
-#ifdef DEBUG
-debugp(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body);
-#endif
-SET_IP(DOES_CODE1(CFA));
+#ifndef NO_IP
+ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */
 #endif /* !defined(NO_IP) */
+SUPER_END; /* !! probably unnecessary and may lead to measurement errors */
+VM_JUMP(EXEC1(EXTRA_CODEXT(CFA)));
 
 (doabicode) ( ... -- ...)	gforth-internal	paren_doabicode
 ""run-time routine for @code{ABI-code} definitions""
@@ -259,22 +248,6 @@ INST_TAIL;
 goto *next_code;
 #endif /* defined(NO_IP) */
 
-(doextraxt) ( -- a_body )  gforth-internal       paren_doextraxt
-a_body = PFA(CFA);
-#ifndef NO_IP
-ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */
-#endif /* !defined(NO_IP) */
-SUPER_END; /* !! probably unnecessary and may lead to measurement errors */
-VM_JUMP(EXEC1(EXTRA_CODEXT(CFA)));
-
-(dodoesxt) ( -- a_body )  gforth-internal       paren_dodoesxt
-a_body = PFA(CFA);
-#ifndef NO_IP
-ip=IP; /* undo any ip updating that may have been performed by NEXT_P0 */
-#endif /* !defined(NO_IP) */
-SUPER_END; /* !! probably unnecessary and may lead to measurement errors */
-VM_JUMP(EXEC1(DOES_CODEXT(CFA)));
-
 \F [endif]
 
 \g control
@@ -353,58 +326,7 @@ ip=IP;
 SUPER_END;
 VM_JUMP(EXEC1(*(Xt *)a_addr));
 
-does-exec ( #a_cfa -- R:a_retaddr a_body )	new	does_exec
-#ifdef NO_IP
-/* compiled to LIT CALL by compile_prim */
-assert(0);
-#else
-a_body = PFA(a_cfa);
-a_retaddr = (Cell *)IP;
-#ifdef DEBUG
-    {
-      CFA_TO_NAME(a_cfa);
-      debugp(stderr,"%08lx: does %08lx %.*s\n",
-	     (Cell)ip,(Cell)a_cfa,len,name);
-    }
-#endif
-SET_IP(DOES_CODE1(a_cfa));
-#endif
-
-extra-exec ( #a_cfa -- R:a_retaddr a_body )	new	extra_exec
-#ifdef NO_IP
-/* compiled to LIT CALL by compile_prim */
-assert(0);
-#else
-a_body = PFA(a_cfa);
-a_retaddr = (Cell *)IP;
-#ifdef DEBUG
-    {
-      CFA_TO_NAME(a_cfa);
-      debugp(stderr,"%08lx: does %08lx %.*s\n",
-	     (Cell)ip,(Cell)a_cfa,len,name);
-    }
-#endif
-SET_IP(EXTRA_CODE(a_cfa));
-#endif
-
-does-xt ( #a_cfa -- a_body )	new	does_xt
-#ifdef NO_IP
-/* compiled to LIT CALL by compile_prim */
-assert(0);
-#else
-a_body = PFA(a_cfa);
-#ifdef DEBUG
-    {
-      CFA_TO_NAME(a_cfa);
-      debugp(stderr,"%08lx: does %08lx %.*s exec %p\n",
-	     (Cell)ip,(Cell)a_cfa,len,name,DOES_CODEXT(a_cfa));
-    }
-#endif
-SUPER_END;
-VM_JUMP(EXEC1(DOES_CODEXT(a_cfa)));
-#endif
-
-extra-xt ( #a_cfa -- a_body )	new	extra_xt
+does-xt ( #a_cfa -- a_body )	new	extra_xt
 #ifdef NO_IP
 /* compiled to LIT CALL by compile_prim */
 assert(0);

see.fs

@@ -371,7 +371,7 @@ VARIABLE C-Pass
 	over 1 cells + @ decompile-prim ['] call xt= >r
 	over 3 cells + @ decompile-prim ['] ;S xt=
 	r> and if
-	    over 2 cells + @ ['] !extraxt >body = if  drop
+	    over 2 cells + @ ['] set-does> >body = if  drop
 		S" DOES> " Com# ?.string 4 cells + EXIT endif
 	endif
 	[IFDEF] !;abi-code
@@ -706,7 +706,7 @@ VARIABLE C-Pass
 
 CREATE C-Table \ primitives map to code only
 	        ' lit A,            ' c-lit A,
-		' does-exec A,	    ' c-callxt A,
+[IFDEF] does-exec ' does-exec A,	    ' c-callxt A, [THEN]
 [IFDEF] does-xt ' does-xt A,        ' c-callxt A, [THEN]
 [IFDEF] extra-exec ' extra-exec A,	    ' c-callxt A, [THEN]
 [IFDEF] extra-xt ' extra-xt A,	    ' c-callxt A, [THEN]