[gforth] / gforth / cross.fs  

gforth: gforth/cross.fs

Diff for /gforth/cross.fs between version 1.118 and 1.119

version 1.118, Sat Jan 5 20:16:17 2002 UTC version 1.119, Sat Jan 5 22:58:59 2002 UTC
Line 902 
Line 902 
 Defer do-refered  Defer do-refered
   
 : prim-forward   ( ghost -- )  : prim-forward   ( ghost -- )
   colonmark, 1 do-refered ; \ compile space for call    colonmark, 0 do-refered ; \ compile space for call
   : doer-forward   ( ghost -- )
     colonmark, 2 do-refered ; \ compile space for doer
 ' prim-forward IS is-forward  ' prim-forward IS is-forward
   
 : (ghostheader) ( -- )  : (ghostheader) ( -- )
Line 1068 
Line 1070 
 Ghost unloop    Ghost ;S                        2drop  Ghost unloop    Ghost ;S                        2drop
 Ghost lit       Ghost !                         2drop  Ghost lit       Ghost !                         2drop
 Ghost noop                                      drop  Ghost noop                                      drop
 Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop  
 Ghost :dovar                                    drop  
 Ghost over      Ghost =         Ghost drop      2drop drop  Ghost over      Ghost =         Ghost drop      2drop drop
 Ghost 2drop drop  Ghost 2drop drop
 Ghost 2dup drop  Ghost 2dup drop
Line 1085 
Line 1085 
 Ghost lit+ drop  Ghost lit+ drop
 Ghost does-exec drop  Ghost does-exec drop
   
   ' doer-forward IS is-forward
   
   Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop
   Ghost :dovar                                    drop
   
   ' prim-forward IS is-forward
   
 \ \ Parameter for target systems                         06oct92py  \ \ Parameter for target systems                         06oct92py
   
   
Line 2183 
Line 2190 
   Ghost tuck swap resolve <do:> swap tuck >magic !    Ghost tuck swap resolve <do:> swap tuck >magic !
   asmprimname, ;    asmprimname, ;
   
 : Alias:   ( cfa -- ) \ name  : Doer:   ( cfa -- ) \ name
   >in @ skip? IF  2drop  EXIT  THEN  >in !    >in @ skip? IF  2drop  EXIT  THEN  >in !
   dup 0< s" prims" T $has? H 0= and    dup 0< s" prims" T $has? H 0= and
   IF    IF
       .sourcepos ." needs doer: " >in @ bl word count type >in ! cr        .sourcepos ." needs doer: " >in @ bl word count type >in ! cr
   THEN    THEN
   Ghost tuck swap resolve <do:> swap >magic ! ;    Ghost
     tuck swap resolve <do:> swap >magic ! ;
   
 Variable prim#  Variable prim#
 : first-primitive ( n -- )  prim# ! ;  : first-primitive ( n -- )  prim# ! ;
Line 2199 
Line 2207 
   IF    IF
      .sourcepos ." needs prim: " >in @ bl word count type >in ! cr       .sourcepos ." needs prim: " >in @ bl word count type >in ! cr
   THEN    THEN
 \  ['] prim-forward IS is-forward  
   prim# @ (THeader ( S xt ghost )    prim# @ (THeader ( S xt ghost )
   dup >ghost-flags <primitive> set-flag    dup >ghost-flags <primitive> set-flag
   over resolve T A, H alias-mask flag!    over resolve T A, H alias-mask flag!
 \  ['] call-forward IS is-forward  
   -1 prim# +! ;    -1 prim# +! ;
 >CROSS  >CROSS
   
Line 2287 
Line 2293 
   there xt>body + ca>native T a, H 1 fillcfa ;          ' (doprim,) plugin-of doprim,    there xt>body + ca>native T a, H 1 fillcfa ;          ' (doprim,) plugin-of doprim,
   
 : (doeshandler,) ( -- )  : (doeshandler,) ( -- )
   T cfalign H compile :doesjump T 0 , H ;               ' (doeshandler,) plugin-of doeshandler,    T cfalign H [G'] :doesjump addr, T 0 , H ;            ' (doeshandler,) plugin-of doeshandler,
   
 : (dodoes,) ( does-action-ghost -- )  : (dodoes,) ( does-action-ghost -- )
   ]comp [G'] :dodoes gexecute comp[    ]comp [G'] :dodoes addr, comp[
   addr,    addr,
   \ the relocator in the c engine, does not like the    \ the relocator in the c engine, does not like the
   \ does-address to marked for relocation    \ does-address to marked for relocation
Line 2505 
Line 2511 
   
 : does-resolved ( ghost -- )  : does-resolved ( ghost -- )
     compile does-exec g>xt T a, H ;      compile does-exec g>xt T a, H ;
 \    dup g>body alit, >do:ghost @ g>xt 0 t>body - colon, ;  
   
 : resolve-does>-part ( -- )  : resolve-does>-part ( -- )
 \ resolve words made by builders  \ resolve words made by builders
Line 2796 
Line 2801 
 : (callc) compile call T >body a, H ;           ' (callc) plugin-of colon,  : (callc) compile call T >body a, H ;           ' (callc) plugin-of colon,
 : (call-res) >tempdp resolved gexecute tempdp> drop ;  : (call-res) >tempdp resolved gexecute tempdp> drop ;
                                                 ' (call-res) plugin-of colon-resolve                                                  ' (call-res) plugin-of colon-resolve
 : (prim) dup 0< IF  ( $4000 - ) ELSE  : (prim) dup 0< IF  $4000 -  ELSE
     ." wrong usage of (prim) "      ." wrong usage of (prim) "
     dup gdiscover IF  .ghost  ELSE  .  THEN  cr -2 throw  THEN      dup gdiscover IF  .ghost  ELSE  .  THEN  cr -2 throw  THEN
     T a, H ;                                    ' (prim) plugin-of prim,      T a, H ;                                    ' (prim) plugin-of prim,

Generate output suitable for use with a patch program
Legend:
Removed from v.1.118  
changed lines
  Added in v.1.119
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help