Verified Commit 5835866c authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Convert doextra to doextraxt

parent b1415277

cross.fs

+6 −14
Original line number Diff line number Diff line
@@ -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

engine/forth.h

+2 −3
Original line number Diff line number Diff line
@@ -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"

engine/main.c

+1 −12
Original line number Diff line number Diff line
@@ -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 */

kernel/aliases0.fs

+1 −2
Original line number Diff line number Diff line
@@ -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

kernel/comp.fs

+0 −8
Original line number Diff line number Diff line
@@ -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?