[gforth] / gforth / cross.fs  

gforth: gforth/cross.fs

Diff for /gforth/cross.fs between version 1.120 and 1.121

version 1.120, Tue Mar 19 11:13:08 2002 UTC version 1.121, Tue Mar 19 18:07:55 2002 UTC
Line 717 
Line 717 
 Plugin branchtomark, ( -- target-addr ) \ marks a branch destination  Plugin branchtomark, ( -- target-addr ) \ marks a branch destination
   
 Plugin colon, ( tcfa -- )               \ compiles call to tcfa at current position  Plugin colon, ( tcfa -- )               \ compiles call to tcfa at current position
 Plugin xt, ( tcfa -- )                  \ compiles xt  
 Plugin prim, ( tcfa -- )                \ compiles primitive invocation  Plugin prim, ( tcfa -- )                \ compiles primitive invocation
 Plugin colonmark, ( -- addr )           \ marks a colon call  Plugin colonmark, ( -- addr )           \ marks a colon call
 Plugin colon-resolve ( tcfa addr -- )  Plugin colon-resolve ( tcfa addr -- )
Line 751 
Line 750 
 Plugin leave,   ( -- )  Plugin leave,   ( -- )
 Plugin ?leave,  ( -- )  Plugin ?leave,  ( -- )
   
 [IFUNDEF] ca>native  Plugin ca>native  \ Convert a code address to the processors
 Plugin ca>native                    \ native address. This is used in doprim, and
 [THEN]                    \ code/code: primitive definitions word to
                     \ convert the addresses.
                     \ The only target where we need this is the misc
                     \ which is a 16 Bit processor with word addresses
                     \ but the forth system we build has a normal byte
                     \ addressed memory model
   
 Plugin doprim,  \ compiles start of a primitive  Plugin doprim,  \ compiles start of a primitive
 Plugin docol,           \ compiles start of a colon definition  Plugin docol,           \ compiles start of a colon definition
Line 904 
Line 908 
   THEN ;    THEN ;
   
 Defer is-forward  Defer is-forward
 Defer do-refered  
   
 : prim-forward   ( ghost -- )  
 \  ." PF" .sourcepos  
   colonmark, 0 do-refered ; \ compile space for call  
 : doer-forward   ( ghost -- )  
 \  ." DF" .sourcepos  
   colonmark, 2 do-refered ; \ compile space for doer  
 ' prim-forward IS is-forward  
   
 : (ghostheader) ( -- )  : (ghostheader) ( -- )
     ghost-list linked <fwd> , 0 , ['] NoExec , what's is-forward ,      ghost-list linked <fwd> , 0 , ['] NoExec , ['] is-forward ,
     0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , ;      0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , ;
   
 : ghostheader ( -- ) (ghostheader) 0 , ;  : ghostheader ( -- ) (ghostheader) 0 , ;
Line 1092 
Line 1087 
 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 :docol    Ghost :doesjump Ghost :dodoes   2drop drop
 Ghost :dovar                                    drop  Ghost :dovar                                    drop
   
   
 ' prim-forward IS is-forward  
   
 \ \ Parameter for target systems                         06oct92py  \ \ Parameter for target systems                         06oct92py
   
   
Line 1658 
Line 1648 
   
 >CROSS  >CROSS
   
 : call-forward ( ghost -- )  
 \    ." CF" .sourcepos  
     there 0 colon, 0 do-refered ;  
 ' call-forward IS is-forward  
   
 Ghost (do)      Ghost (?do)                     2drop  Ghost (do)      Ghost (?do)                     2drop
 Ghost (for)                                     drop  Ghost (for)                                     drop
 Ghost (loop)    Ghost (+loop)                   2drop  Ghost (loop)    Ghost (+loop)                   2drop
Line 1672 
Line 1657 
 Ghost (C")                                      drop  Ghost (C")                                      drop
 Ghost '                                         drop  Ghost '                                         drop
   
 \ ' prim-forward IS is-forward  
   
 \ user ghosts  \ user ghosts
   
 Ghost state drop  Ghost state drop
Line 1735 
Line 1718 
 >CROSS  >CROSS
   
 : (cc) T a, H ;                                 ' (cc) plugin-of colon,  : (cc) T a, H ;                                 ' (cc) plugin-of colon,
 : (xt) T a, H ;                                 ' (xt) plugin-of xt,  
 : (prim) T a, H ;                               ' (prim) plugin-of prim,  : (prim) T a, H ;                               ' (prim) plugin-of prim,
   
 : (cr) >tempdp colon, tempdp> ;                 ' (cr) plugin-of colon-resolve  : (cr) >tempdp colon, tempdp> ;                 ' (cr) plugin-of colon-resolve
Line 1749 
Line 1731 
         tempdp> ;                               ' (dr) plugin-of doer-resolve          tempdp> ;                               ' (dr) plugin-of doer-resolve
   
 : (cm) ( -- addr )  : (cm) ( -- addr )
     T here align H      there -1 colon, ;                           ' (cm) plugin-of colonmark,
     -1 xt, ;                                    ' (cm) plugin-of colonmark,  
   
 >TARGET  >TARGET
 : compile, ( xt -- )  : compile, ( xt -- )
Line 1778 
Line 1759 
     space>      space>
 ;  ;
   
 ' (refered) IS do-refered  
   
 : refered ( ghost tag -- )  : refered ( ghost tag -- )
 \G creates a resolve structure  \G creates a resolve structure
     T here aligned H swap (refered)      T here aligned H swap (refered)
Line 1837 
Line 1816 
   >link ! ;    >link ! ;
   
 : colon-resolved   ( ghost -- )  : colon-resolved   ( ghost -- )
     >link @ colon, ; \ compile-call  \ compiles a call to a colon definition,
   \ compile action for >comp field
       >link @ colon, ;
   
 : prim-resolved  ( ghost -- )  : prim-resolved  ( ghost -- )
   \ compiles a call to a primitive
     >link @ prim, ;      >link @ prim, ;
   
   : (is-forward)   ( ghost -- )
       colonmark, 0 (refered) ; \ compile space for call
   ' (is-forward) IS is-forward
   
 0 Value resolved  0 Value resolved
   
 : resolve  ( ghost tcfa -- )  : resolve  ( ghost tcfa -- )
Line 1864 
Line 1850 
     \ mark ghost as resolved      \ mark ghost as resolved
     dup r@ >link ! <res> r@ >magic !      dup r@ >link ! <res> r@ >magic !
     r@ to resolved      r@ to resolved
     r@ >comp @ ['] prim-forward = IF  
         ['] prim-resolved  r@ >comp !  THEN  \    r@ >comp @ ['] is-forward =
     r@ >comp @ what's is-forward = IF  \    ABORT" >comp action not set on a resolved ghost"
         ['] prim-resolved  r@ >comp !  THEN  
       \ copmile action defaults to colon-resolved
       \ if this is not right something must be set before
       \ calling resolve
       r@ >comp @ ['] is-forward = IF
           ['] colon-resolved r@ >comp !
       THEN
     \ loop through forward referencies      \ loop through forward referencies
     r> -rot      r> -rot
     comp-state @ >r Resolving comp-state !      comp-state @ >r Resolving comp-state !
Line 2217 
Line 2209 
      .sourcepos ." needs prim: " >in @ bl word count type >in ! cr       .sourcepos ." needs prim: " >in @ bl word count type >in ! cr
   THEN    THEN
   prim# @ (THeader ( S xt ghost )    prim# @ (THeader ( S xt ghost )
     ['] prim-resolved over >comp !
   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!
   -1 prim# +! ;    -1 prim# +! ;
Line 2298 
Line 2291 
   
 : (docol,)  ( -- ) [G'] :docol (doer,) ;                ' (docol,) plugin-of docol,  : (docol,)  ( -- ) [G'] :docol (doer,) ;                ' (docol,) plugin-of docol,
   
                                                           ' NOOP plugin-of ca>native
   
 : (doprim,) ( -- )  : (doprim,) ( -- )
   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,
   
Line 2336 
Line 2331 
 >TARGET  >TARGET
 : Code  : Code
   defempty?    defempty?
   (THeader there resolve    (THeader ( ghost )
     ['] prim-resolved over >comp !
     there resolve
   
   [ T e? prims H 0= [IF] T e? ITC H [ELSE] true [THEN] ] [IF]    [ T e? prims H 0= [IF] T e? ITC H [ELSE] true [THEN] ] [IF]
   doprim,    doprim,
   [THEN]    [THEN]
   depth (code) ;    depth (code) ;
   
   \ FIXME : no-compile -1 ABORT" this ghost is not for compilation" ;
   
 : Code:  : Code:
   defempty?    defempty?
     Ghost dup there ca>native resolve  <do:> swap >magic !      Ghost >r
       r@ there ca>native resolve
       <do:> r@ >magic !
       r> drop
     depth (code) ;      depth (code) ;
   
 : end-code  : end-code
Line 2513 
Line 2516 
 : !does ( does-action -- )  : !does ( does-action -- )
     tlastcfa @ [G'] :dovar killref      tlastcfa @ [G'] :dovar killref
     >space here >r ghostheader space>      >space here >r ghostheader space>
       ['] colon-resolved r@ >comp !
     r@ created >do:ghost ! r@ swap resolve      r@ created >do:ghost ! r@ swap resolve
     r> tlastcfa @ >tempdp dodoes, tempdp> ;      r> tlastcfa @ >tempdp dodoes, tempdp> ;
   
Line 2796 
Line 2800 
 \ this section defines different compilation  \ this section defines different compilation
 \ actions for created words  \ actions for created words
 \ this will help the peephole optimizer  \ this will help the peephole optimizer
 \ I (jaw) took this from bernds lates cross-compiler  \ I (jaw) took this from bernds latest cross-compiler
 \ changes but seperated it from the original  \ changes but seperated it from the original
 \ Builder words. The final plan is to put this  \ Builder words. The final plan is to put this
 \ into a seperate file, together with the peephole  \ into a seperate file, together with the peephole
Line 2808 
Line 2812 
 >CROSS  >CROSS
   
 : (callc) compile call T >body a, H ;           ' (callc) plugin-of colon,  : (callc) compile call T >body a, H ;           ' (callc) plugin-of colon,
   : (callcm) T here 0 a, 0 a, H ;                 ' (callcm) plugin-of colonmark,
 : (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  : (pprim) dup 0< IF  $4000 -  ELSE
     ." wrong usage of (prim) "      cr ." wrong usage of (prim) "
     dup gdiscover IF  .ghost  ELSE  .  THEN  cr -2 throw  THEN      dup gdiscover IF  .ghost  ELSE  .  THEN  cr -1 throw  THEN
     T a, H ;                                    ' (prim) plugin-of prim,      T a, H ;                                    ' (pprim) plugin-of prim,
   
 \ if we want this, we have to spilt aconstant  \ if we want this, we have to spilt aconstant
 \ and constant!!  \ and constant!!

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help