Commit 006d4909 authored by jwilke's avatar jwilke

- oops, left some debugging output

- added comment for ghost fields
parent e2d80aae
......@@ -801,13 +801,25 @@ Struct
\ points to the where we have to resolve (linked-list)
cell% field >link
\ execution symantics (while target compiling) of ghost
\ execution semantics (while target compiling) of ghost
cell% field >exec
\ compilation action of this ghost; this is what is
\ done to compile a call (or whatever) to this definition.
\ E.g. >comp contains the semantic of postpone s"
\ whereas >exec-compile contains the semantic of s"
cell% field >comp
\ Compilation sematics (while parsing) of this ghost. E.g.
\ "\" will skip the rest of line.
\ These semantics are defined by Cond: and
\ if a word is made immediate in instant, then the >exec2 field
\ gets copied to here
cell% field >exec-compile
\ Additional execution semantics of this ghost. This is used
\ for code generated by instant and for the doer-xt of created
\ words
cell% field >exec2
cell% field >created
......@@ -865,6 +877,7 @@ Variable cross-space-dp-orig
cross-space-end u> ABORT" CROSS: cross-space overflow"
cross-space-dp-orig @ dp ! ;
\ this is just for debugging, to see this in the backtrace
: execute-exec execute ;
: execute-exec2 execute ;
: execute-exec-compile execute ;
......@@ -1443,25 +1456,28 @@ variable constflag constflag off
bigendian
[IF]
: S! ( n addr -- ) >r s>d r> tcell bounds swap 1-
: DS! ( d addr -- ) tcell bounds swap 1-
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ;
: S@ ( addr -- n ) >r 0 0 r> tcell bounds
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ;
: DS@ ( addr -- d ) >r 0 0 r> tcell bounds
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP ;
: Sc! ( n addr -- ) >r s>d r> tchar bounds swap 1-
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ;
: Sc@ ( addr -- n ) >r 0 0 r> tchar bounds
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ;
[ELSE]
: S! ( n addr -- ) >r s>d r> tcell bounds
: DS! ( d addr -- ) tcell bounds
DO maxbyte ud/mod rot I c! LOOP 2drop ;
: S@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1-
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ;
: DS@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1-
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP ;
: Sc! ( n addr -- ) >r s>d r> tchar bounds
DO maxbyte ud/mod rot I c! LOOP 2drop ;
: Sc@ ( addr -- n ) >r 0 0 r> tchar bounds swap 1-
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ;
[THEN]
: S! ( n addr -- ) >r s>d r> DS! ;
: S@ ( addr -- n ) DS@ d>s ;
: taddr>region ( taddr -- region | 0 )
\G finds for a target-address the correct region
\G returns 0 if taddr is not in range of a target memory region
......@@ -2183,13 +2199,13 @@ Cond: ['] T ' H alit, ;Cond
\ \ threading modell 13dec92py
\ modularized 14jun97jaw
T 2 cells H .s Value xt>body
T 2 cells H Value xt>body
: (>body) ( cfa -- pfa )
xt>body + ; ' (>body) plugin-of t>body
: fillcfa ( usedcells -- )
T cells H xt>body swap - dup .
T cells H xt>body swap -
assert1( dup 0 >= )
0 ?DO 0 X c, tchar +LOOP ;
......@@ -2437,7 +2453,7 @@ Cond: DOES>
: Builder ( Create-xt do-ghost "name" -- )
\ builds up a builder in current vocabulary
\ create-xt is executed when word is interpreted
\ do:-xt is executet when the created word from builder is executed
\ do:-xt is executed when the created word from builder is executed
\ for do:-xt an additional entry after the normal ghost-entrys is used
Make-Ghost ( Create-xt do-ghost ghost )
......
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