Verified Commit b1415277 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Work on extraxt stuff

parent 7af2a9f6

cross.fs

+10 −4
Original line number Diff line number Diff line
@@ -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

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

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

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

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