Commit b1415277 authored by Bernd Paysan's avatar Bernd Paysan

Work on extraxt stuff

parent 7af2a9f6
Pipeline #653 passed with stage
in 8 minutes and 41 seconds
......@@ -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)
......
......@@ -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 */
......
......@@ -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)
......
......@@ -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]
......@@ -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).
......
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