Diff for /gforth/cross.fs between versions 1.112 and 1.114

version 1.112, 2001/09/12 11:48:36 version 1.114, 2001/09/12 14:55:54
Line 1043  End-Struct addr-struct Line 1043  End-Struct addr-struct
   
 \ Predefined ghosts                                    12dec92py  \ Predefined ghosts                                    12dec92py
   
   Ghost - drop \ need a ghost otherwise "-" would be treated as a number
   
 Ghost 0=                                        drop  Ghost 0=                                        drop
 Ghost branch    Ghost ?branch                   2drop  Ghost branch    Ghost ?branch                   2drop
 Ghost (do)      Ghost (?do)                     2drop  Ghost (do)      Ghost (?do)                     2drop
Line 1057  Ghost ' Line 1059  Ghost '
 Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop  Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop
 Ghost :dovar                                    drop  Ghost :dovar                                    drop
 Ghost over      Ghost =         Ghost drop      2drop drop  Ghost over      Ghost =         Ghost drop      2drop drop
 Ghost - drop  
 Ghost 2drop drop  Ghost 2drop drop
 Ghost 2dup drop  Ghost 2dup drop
   
Line 1142  true DefaultValue standardthreading Line 1143  true DefaultValue standardthreading
 s" relocate" T environment? H   s" relocate" T environment? H 
 \ JAW why set NIL to this?!  \ JAW why set NIL to this?!
 [IF]    drop \ SetValue NIL  [IF]    drop \ SetValue NIL
 [ELSE]  >ENVIRON T NIL H SetValue relocate  [ELSE]  >ENVIRON X NIL SetValue relocate
 [THEN]  [THEN]
   >TARGET
   
   0 Constant NIL
   
 >CROSS  >CROSS
   
Line 1224  Variable mirrored-link          \ linked Line 1228  Variable mirrored-link          \ linked
 : >rlen cell+ ;  : >rlen cell+ ;
 : >rstart ;  : >rstart ;
   
   : (region) ( addr len region -- )
   \G change startaddress and length of an existing region
     >r r@ last-defined-region !
     r@ >rlen ! dup r@ >rstart ! r> >rdp ! ;
   
 : region ( addr len -- )                  : region ( addr len -- )                
 \G create a new region  \G create a new region
Line 1237  Variable mirrored-link          \ linked Line 1245  Variable mirrored-link          \ linked
         region-link linked 0 , 0 , 0 , bl word count string,          region-link linked 0 , 0 , 0 , bl word count string,
   ELSE  \ store new parameters in region    ELSE  \ store new parameters in region
         bl word drop          bl word drop
         >body >r r@ last-defined-region !          >body (region)
         r@ >rlen ! dup r@ >rstart ! r> >rdp !  
   THEN ;    THEN ;
   
 : borders ( region -- startaddr endaddr )   : borders ( region -- startaddr endaddr ) 
Line 1356  T has? rom H Line 1363  T has? rom H
   
 \ MakeKernel                                                    22feb99jaw  \ MakeKernel                                                    22feb99jaw
   
 : makekernel ( targetsize -- targetsize )  : makekernel ( targetsize -- )
   dup dictionary >rlen ! setup-target ;  \G convenience word to setup the memory of the target
   \G used by main.fs of the c-engine based systems
     100 swap dictionary (region)
     setup-target ;
   
 >MINIMAL  >MINIMAL
 : makekernel makekernel ;  : makekernel makekernel ;
Line 3004  magic 7 + c! Line 3014  magic 7 + c!
 : save-cross ( "image-name" "binary-name" -- )  : save-cross ( "image-name" "binary-name" -- )
   bl parse ." Saving to " 2dup type cr    bl parse ." Saving to " 2dup type cr
   w/o bin create-file throw >r    w/o bin create-file throw >r
   TNIL IF    s" header" X $has? IF
       s" #! "           r@ write-file throw        s" #! "           r@ write-file throw
       bl parse          r@ write-file throw        bl parse          r@ write-file throw
       s"  --image-file" r@ write-file throw        s"  --image-file" r@ write-file throw
Line 3020  magic 7 + c! Line 3030  magic 7 + c!
   THEN    THEN
   image @ there     image @ there 
   r@ write-file throw \ write image    r@ write-file throw \ write image
   TNIL IF    s" relocate" X $has? IF
       bit$  @ there 1- tcell>bit rshift 1+        bit$  @ there 1- tcell>bit rshift 1+
                 r@ write-file throw \ write tags                  r@ write-file throw \ write tags
   THEN    THEN

Removed from v.1.112  
changed lines
  Added in v.1.114


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