version 1.105, 2001/09/05 09:42:38
|
version 1.106, 2001/09/05 10:18:46
|
Line 801 Struct
|
Line 801 Struct
|
\ points to the where we have to resolve (linked-list) |
\ points to the where we have to resolve (linked-list) |
cell% field >link |
cell% field >link |
|
|
\ execution symantics (while target compiling) of ghost |
\ execution semantics (while target compiling) of ghost |
cell% field >exec |
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 |
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 |
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 >exec2 |
|
|
cell% field >created |
cell% field >created |
Line 865 Variable cross-space-dp-orig
|
Line 877 Variable cross-space-dp-orig
|
cross-space-end u> ABORT" CROSS: cross-space overflow" |
cross-space-end u> ABORT" CROSS: cross-space overflow" |
cross-space-dp-orig @ dp ! ; |
cross-space-dp-orig @ dp ! ; |
|
|
|
\ this is just for debugging, to see this in the backtrace |
: execute-exec execute ; |
: execute-exec execute ; |
: execute-exec2 execute ; |
: execute-exec2 execute ; |
: execute-exec-compile execute ; |
: execute-exec-compile execute ; |
Line 1443 variable constflag constflag off
|
Line 1456 variable constflag constflag off
|
|
|
bigendian |
bigendian |
[IF] |
[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 ; |
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; |
: S@ ( addr -- n ) >r 0 0 r> tcell bounds |
: DS@ ( addr -- d ) >r 0 0 r> tcell bounds |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP ; |
: Sc! ( n addr -- ) >r s>d r> tchar bounds swap 1- |
: Sc! ( n addr -- ) >r s>d r> tchar bounds swap 1- |
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; |
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; |
: Sc@ ( addr -- n ) >r 0 0 r> tchar bounds |
: Sc@ ( addr -- n ) >r 0 0 r> tchar bounds |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; |
[ELSE] |
[ELSE] |
: S! ( n addr -- ) >r s>d r> tcell bounds |
: DS! ( d addr -- ) tcell bounds |
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
: S@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1- |
: DS@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1- |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP ; |
: Sc! ( n addr -- ) >r s>d r> tchar bounds |
: Sc! ( n addr -- ) >r s>d r> tchar bounds |
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
: Sc@ ( addr -- n ) >r 0 0 r> tchar bounds swap 1- |
: 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 ; |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; |
[THEN] |
[THEN] |
|
|
|
: S! ( n addr -- ) >r s>d r> DS! ; |
|
: S@ ( addr -- n ) DS@ d>s ; |
|
|
: taddr>region ( taddr -- region | 0 ) |
: taddr>region ( taddr -- region | 0 ) |
\G finds for a target-address the correct region |
\G finds for a target-address the correct region |
\G returns 0 if taddr is not in range of a target memory region |
\G returns 0 if taddr is not in range of a target memory region |
Line 2183 Cond: ['] T ' H alit, ;Cond
|
Line 2199 Cond: ['] T ' H alit, ;Cond
|
\ \ threading modell 13dec92py |
\ \ threading modell 13dec92py |
\ modularized 14jun97jaw |
\ modularized 14jun97jaw |
|
|
T 2 cells H .s Value xt>body |
T 2 cells H Value xt>body |
|
|
: (>body) ( cfa -- pfa ) |
: (>body) ( cfa -- pfa ) |
xt>body + ; ' (>body) plugin-of t>body |
xt>body + ; ' (>body) plugin-of t>body |
|
|
: fillcfa ( usedcells -- ) |
: fillcfa ( usedcells -- ) |
T cells H xt>body swap - dup . |
T cells H xt>body swap - |
assert1( dup 0 >= ) |
assert1( dup 0 >= ) |
0 ?DO 0 X c, tchar +LOOP ; |
0 ?DO 0 X c, tchar +LOOP ; |
|
|
Line 2437 Cond: DOES>
|
Line 2453 Cond: DOES>
|
: Builder ( Create-xt do-ghost "name" -- ) |
: Builder ( Create-xt do-ghost "name" -- ) |
\ builds up a builder in current vocabulary |
\ builds up a builder in current vocabulary |
\ create-xt is executed when word is interpreted |
\ 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 |
\ for do:-xt an additional entry after the normal ghost-entrys is used |
|
|
Make-Ghost ( Create-xt do-ghost ghost ) |
Make-Ghost ( Create-xt do-ghost ghost ) |