Commit 006d4909 authored by Jens Wilke's avatar Jens Wilke
Browse files

- oops, left some debugging output 

- added comment for ghost fields
parent e2d80aae

cross.fs

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