Convert doextra to doextraxt

parent b1415277
Pipeline #654 failed with stage
in 5 minutes and 21 seconds
......@@ -1199,7 +1199,6 @@ Ghost refill drop
Ghost :docol Ghost :doesjump Ghost :dodoes 2drop drop
Ghost :dovar drop
Ghost :doextra drop
Ghost :dodoesxt Ghost :doextraxt 2drop
\ \ Parameter for target systems 06oct92py
......@@ -1833,7 +1832,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 !extra 2drop
Ghost !does Ghost !extraxt 2drop
Ghost compile, drop
Ghost (.") Ghost (S") Ghost (ABORT") 2drop drop
Ghost (C") Ghost c(abort") Ghost type 2drop drop
......@@ -2838,7 +2837,7 @@ Defer gset-optimizer
r@ created >do:ghost ! r@ swap resolve
r> tlastcfa @ >tempdp dodoes, tempdp> ;
Defer !extra
Defer !extraxt
Defer instant-interpret-does>-hook ' noop IS instant-interpret-does>-hook
......@@ -2876,8 +2875,7 @@ Cond: DOES>
: EXTRA>
['] extra-resolved created >comp !
switchrom T align H
doeshandler, !extra
switchrom doeshandler, T here H !extraxt
instant-interpret-does>-hook
depth ;Resolve off T ] H ;
[ELSE]
......@@ -3036,7 +3034,6 @@ ghost :,
ghost peephole-compile,
2drop
ghost does,
ghost extra,
ghost extraxt,
2drop drop
ghost value,
......@@ -3217,9 +3214,9 @@ variable cross-boot[][]
r@ created >do:ghost @ >exec2 !
T align H r> hereresolve
r> T here vtsize H + resolve
[G'] extra, set-optimizer T here H
tlastcfa @ >tempdp [G'] :doextra (doer,) tempdp> ;
IS !extra
[G'] extraxt, set-optimizer T here H
tlastcfa @ >tempdp [G'] :doextraxt (doer,) tempdp> ;
IS !extraxt
: ;DO ( [xt] [colon-sys] -- )
postpone ; doexec! ; immediate
......@@ -3261,11 +3258,6 @@ by: :dodoesxt ;DO
vt: [G'] doesxt, gset-optimizer ;vt
\ vtghost: dodoesxt-vt
Builder extra>-dummy
Build: ;Build
by: :doextra ;DO
vt: [G'] extra, gset-optimizer ;vt
Builder extraxt>-dummy
Build: ;Build
by: :doextraxt ;DO
......
......@@ -117,10 +117,9 @@ extern void* (*realloc_l)(void* addr, size_t size);
#define DODOES 7
#define DOABICODE 8
#define DOSEMIABICODE 9
#define DOEXTRA 10
#define DOEXTRAXT 10
#define DODOESXT 11
#define DOEXTRAXT 12
#define DOER_MAX 12
#define DOER_MAX 11
#include "machine.h"
......
......@@ -387,18 +387,7 @@ void gforth_relocate(Cell *image, const Char *bitstring,
switch(token|0x4000) {
case CF_NIL : image[i]=0; break;
#if !defined(DOUBLY_INDIRECT)
case CF(DOCOL) :
case CF(DOVAR) :
case CF(DOCON) :
case CF(DOVAL) :
case CF(DOUSER) :
case CF(DODEFER) :
case CF(DOFIELD) :
case CF(DODOES) :
case CF(DOABICODE) :
case CF(DOSEMIABICODE):
case CF(DOEXTRA):
case CF(DODOESXT):
case CF(DOER_MAX) ... CF(DOCOL):
MAKE_CF(image+i,symbols[CF(token)]); break;
#endif /* !defined(DOUBLY_INDIRECT) */
default : /* backward compatibility */
......
......@@ -27,9 +27,8 @@
-9 Doer: :dodoes
-&10 Doer: :doabicode
-&11 Doer: :do;abicode
-&12 Doer: :doextra
-&12 Doer: :doextraxt
-&13 Doer: :dodoesxt
-&14 Doer: :doextraxt
-&2 first-primitive
\ this does not work for (at least) (DODOES),
\ so the following routines are commented out
......@@ -544,14 +544,6 @@ opt: drop ( xt -- )
[ has? peephole [IF] ] finish-code [ [THEN] ]
defstart ;
extra>-dummy (doextra-dummy)
: !extra ( addr -- ) \ gforth store-extra
created?
IF
['] extra, set-optimizer
THEN
latestxt extra-code! ;
extraxt>-dummy (doextraxt-dummy)
: !extraxt ( addr -- ) \ gforth store-extra
created?
......
......@@ -544,7 +544,7 @@ cell% -2 * 0 0 field body> ( xt -- a_addr )
else dup @ dodoesxt: = if
cell+ @
else
dup @ doextra: = IF
dup @ doextraxt: = IF
>namevt @ >vtextra @
ELSE
drop 0
......@@ -574,11 +574,6 @@ cell% -2 * 0 0 field body> ( xt -- a_addr )
\G code field, for correctness you also need to change the compiler
dodoesxt: over ! cell+ ! ;
: extra-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.
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.
......
......@@ -259,40 +259,21 @@ INST_TAIL;
goto *next_code;
#endif /* defined(NO_IP) */
(doextra) ( -- a_body R:a_retaddr ) gforth-internal paren_doextra
""run-time routine for @code{does>}-defined words""
#ifdef NO_IP
a_retaddr = next_code;
a_body = PFA(CFA);
INST_TAIL;
#ifdef DEBUG
debugp(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body);
#endif
goto **(Label *)EXTRA_CODE(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(EXTRA_CODE(CFA));
#endif /* !defined(NO_IP) */
(dodoesxt) ( -- a_body ) gforth-internal paren_dodoesxt
(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(DOES_CODEXT(CFA)));
VM_JUMP(EXEC1(EXTRA_CODEXT(CFA)));
(doextraxt) ( -- a_body ) gforth-internal paren_doextraxt
(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(EXTRA_CODEXT(CFA)));
VM_JUMP(EXEC1(DOES_CODEXT(CFA)));
\F [endif]
......
......@@ -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 + @ ['] !extra >body = if drop
over 2 cells + @ ['] !extraxt >body = if drop
S" DOES> " Com# ?.string 4 cells + EXIT endif
endif
[IFDEF] !;abi-code
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment