[BACK]Return to cross.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/cross.fs between versions 1.108 and 1.109

version 1.108, 2001/09/05 11:45:38 version 1.109, 2001/09/05 13:11:36
Line 1684  previous Line 1684  previous
   
 : (cm) ( -- addr )  : (cm) ( -- addr )
     T here align H      T here align H
     -1 colon, ;                                 ' (cm) plugin-of colonmark,      -1 prim, ;                                  ' (cm) plugin-of colonmark,
   
 >TARGET  >TARGET
 : compile, ( xt -- )  : compile, ( xt -- )
Line 2468  Cond: DOES> Line 2468  Cond: DOES>
 \ do:-xt is executed 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
   
   ghost                 ( Create-xt do-ghost ghost )    ghost to built 
   to built   
   built >created @ 0= IF    built >created @ 0= IF
     built >created on      built >created on
     ['] prim-resolved built >comp !       ['] prim-resolved built >comp ! 
Line 2500  Cond: DOES> Line 2499  Cond: DOES>
    \ so predefined semantics e.g. for ....     \ so predefined semantics e.g. for ....
    \ FIXME: find an example in the normal kernel!!!     \ FIXME: find an example in the normal kernel!!!
    2dup >exec @ swap >exec2 !      2dup >exec @ swap >exec2 ! 
   \   cr ." XXX" over .ghost
   \   dup >comp @ xt-see
    >comp @ swap >comp ! ;     >comp @ swap >comp ! ;
 \ old version of this:  \ old version of this:
 \  >exec dup @ ['] NoExec =   \  >exec dup @ ['] NoExec = 
Line 2565  Cond: DOES> Line 2566  Cond: DOES>
 : ;DO ( [xt] [colon-sys] -- )  : ;DO ( [xt] [colon-sys] -- )
   postpone ; doexec! ; immediate    postpone ; doexec! ; immediate
   
 : by      ( -- do-ghost ) \ Name  : by      ( -- ) \ Name
   Ghost >do:ghost @ do:ghost! ;    Ghost >do:ghost @ do:ghost! ;
   
 : compile: ( do-ghost -- do-ghost [xt] [colon-sys] )  : compile: ( --[xt] [colon-sys] )
 \G defines a compile time action for created words  \G defines a compile time action for created words
 \G by this builder  \G by this builder
   :noname ;    :noname ;
   
 : ;compile ( do-ghost [xt] [colon-sys] -- do-ghost )  : ;compile ( [xt] [colon-sys] -- )
   postpone ;  built >do:ghost @ >comp ! ; immediate    postpone ; built >do:ghost @ >comp ! ; immediate
   
   
 >TARGET  
 \ Variables and Constants                              05dec92py  \ Variables and Constants                              05dec92py
   
 Builder (Constant)  Builder (Constant)
Line 2629  by Create Line 2628  by Create
   
 \ User variables                                       04may94py  \ User variables                                       04may94py
   
 >CROSS  
   
 Variable tup  0 tup !  Variable tup  0 tup !
 Variable tudp 0 tudp !  Variable tudp 0 tudp !
   
Line 2642  Variable tudp 0 tudp ! Line 2639  Variable tudp 0 tudp !
   tup @ tudp @ + T A! H    tup @ tudp @ + T A! H
   tudp @ dup T cell+ H tudp ! ;    tudp @ dup T cell+ H tudp ! ;
   
 >TARGET  
   
 Builder User  Builder User
 Build: 0 u, X , ;Build  Build: 0 u, X , ;Build
 by: :douser ( ghost -- up-addr )  X @ tup @ + ;DO  by: :douser ( ghost -- up-addr )  X @ tup @ + ;DO
Line 2680  DO: ( ghost -- ) ABORT" CROSS: Don't exe Line 2675  DO: ( ghost -- ) ABORT" CROSS: Don't exe
   
 \ Sturctures                                           23feb95py  \ Sturctures                                           23feb95py
   
 >CROSS  
 : nalign ( addr1 n -- addr2 )  : nalign ( addr1 n -- addr2 )
 \ addr2 is the aligned version of addr1 wrt the alignment size n  \ addr2 is the aligned version of addr1 wrt the alignment size n
  1- tuck +  swap invert and ;   1- tuck +  swap invert and ;
 >TARGET  
   
 Builder (Field)  Builder (Field)
 Build: ;Build  Build: ;Build
Line 2696  Build: ( align1 offset1 align size "name Line 2690  Build: ( align1 offset1 align size "name
     + >r nalign r> ;Build      + >r nalign r> ;Build
 by (Field)  by (Field)
   
   >TARGET
 : struct  T 1 chars 0 H ;  : struct  T 1 chars 0 H ;
 : end-struct  T 2Constant H ;  : end-struct  T 2Constant H ;
   
 : cell% ( n -- size align )  : cell% ( n -- size align )
     T 1 cells H dup ;      T 1 cells H dup ;
   >CROSS
   
 \ Input-Methods                                            01py  \ Input-Methods                                            01py
   
Line 2726  DO:  abort" Not in cross mode" ;DO Line 2722  DO:  abort" Not in cross mode" ;DO
   
 T has? peephole H [IF]  T has? peephole H [IF]
   
 : (cc) compile call T >body a, H ;              ' (cc) IS colon,  >CROSS
   : (callc) compile call T >body a, H ;           ' (callc) plugin-of colon,
   
   \ if we want this, we have to spilt aconstant
   \ and constant!!
   \ Builder (Constant)
   \ compile: g>body X @ lit, ;compile
   
 Builder (Constant)  Builder (Constant)
 compile: g>body X @ lit, ;compile  compile: g>body alit, compile @ ;compile
   
 Builder (Value)  Builder (Value)
 compile: g>body alit, compile @ ;compile  compile: g>body alit, compile @ ;compile
Line 3268  Variable outfile-fd Line 3270  Variable outfile-fd
 \ \ [IF] [ELSE] [THEN] ...                              14sep97jaw  \ \ [IF] [ELSE] [THEN] ...                              14sep97jaw
   
 \ it is useful to define our own structures and not to rely  \ it is useful to define our own structures and not to rely
 \ on the words in the compiler  \ on the words in the host system
 \ The words in the compiler might be defined with vocabularies  \ The words in the host system might be defined with vocabularies
 \ this doesn't work with our self-made compile-loop  \ this doesn't work with our self-made compile-loop
   
 Create parsed 20 chars allot    \ store word we parsed  Create parsed 20 chars allot    \ store word we parsed
Removed from v.1.108  
changed lines
  Added in v.1.109

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>