--- gforth/cross.fs	2001/09/05 13:11:36	1.109
+++ gforth/cross.fs	2001/09/12 14:45:38	1.113
@@ -986,7 +986,6 @@ Exists-Warnings on
 
 Variable reuse-ghosts reuse-ghosts off
 
-1 [IF] \ FIXME: define when vocs are ready
 : HeaderGhost ( "name" -- ghost )
   >in @ 
   bl word count 
@@ -1003,8 +1002,6 @@ Variable reuse-ghosts reuse-ghosts off
   \ defined words, this is a workaround
   \ for the redefined \ until vocs work
   Make-Ghost ;
-[THEN] 
-
  
 : .ghost ( ghost -- ) >ghostname type ;
 
@@ -1145,8 +1142,11 @@ true DefaultValue standardthreading
 s" relocate" T environment? H 
 \ JAW why set NIL to this?!
 [IF]	drop \ SetValue NIL
-[ELSE]	>ENVIRON T NIL H SetValue relocate
+[ELSE]	>ENVIRON X NIL SetValue relocate
 [THEN]
+>TARGET
+
+0 Constant NIL
 
 >CROSS
 
@@ -1227,6 +1227,10 @@ Variable mirrored-link          \ linked
 : >rlen cell+ ;
 : >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 -- )                
 \G create a new region
@@ -1240,8 +1244,7 @@ Variable mirrored-link          \ linked
 	region-link linked 0 , 0 , 0 , bl word count string,
   ELSE	\ store new parameters in region
         bl word drop
-	>body >r r@ last-defined-region !
-	r@ >rlen ! dup r@ >rstart ! r> >rdp !
+	>body (region)
   THEN ;
 
 : borders ( region -- startaddr endaddr ) 
@@ -1359,8 +1362,11 @@ T has? rom H
 
 \ MakeKernel                                           		22feb99jaw
 
-: makekernel ( targetsize -- targetsize )
-  dup dictionary >rlen ! setup-target ;
+: makekernel ( targetsize -- )
+\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
 : makekernel makekernel ;
@@ -1640,8 +1646,8 @@ T has? relocate H
 >TARGET
 
 : count dup X c@ swap X char+ swap ;
-\ FIXME -1 on 64 bit machines?!?!
-: on		T -1 swap ! H ; 
+
+: on		-1 -1 rot TD!  ; 
 : off   	T 0 swap ! H ;
 
 : tcmove ( source dest len -- )
@@ -1774,7 +1780,7 @@ Defer resolve-warning
 : prim-resolved  ( ghost -- )
     >link @ prim, ;
 
-\ FIXME: not activated
+\ FIXME: not used currently
 : does-resolved ( ghost -- )
     dup g>body alit, >do:ghost @ g>body colon, ;
 
@@ -1814,22 +1820,16 @@ Defer resolve-warning
 
 \ gexecute ghost,                                      01nov92py
 
-\ FIXME cleanup
-\ : is-resolved   ( ghost -- )
-\  >link @ colon, ; \ compile-call
-
 : (gexecute)   ( ghost -- )
   dup >comp @ EXECUTE ;
 
 : gexecute ( ghost -- )
-\  dup >magic @ <imm> = IF -1 ABORT" CROSS: gexecute on immediate word" THEN
+  dup >magic @ <imm> = IF -1 ABORT" CROSS: gexecute on immediate word" THEN
   (gexecute) ;
 
 : addr,  ( ghost -- )
   dup forward? IF  1 refered 0 T a, H ELSE >link @ T a, H THEN ;
 
-\ !! : ghost,     ghost  gexecute ;
-
 \ .unresolved                                          11may93jaw
 
 variable ResolveFlag
@@ -2111,12 +2111,12 @@ Variable last-prim-ghost
 
 Defer setup-prim-semantics
 
-: aprim   ( -- ) 
+: mapprim   ( "forthname" "asmlabel" -- ) 
   THeader -1 aprim-nr +! aprim-nr @ T A, H
   asmprimname, 
   setup-prim-semantics ;
 
-: aprim:   ( -- ) 
+: mapprim:   ( "forthname" "asmlabel" -- ) 
   -1 aprim-nr +! aprim-nr @
   Ghost tuck swap resolve <do:> swap tuck >magic !
   asmprimname, ;
@@ -2288,7 +2288,7 @@ Cond: ALiteral ( n -- )   alit, ;Cond
 Cond: [Char]   ( "<char>" -- )  Char  lit, ;Cond
 
 tchar 1 = [IF]
-\ Cond: chars ;Cond 
+Cond: chars ;Cond 
 [THEN]
 
 \ some special literals					27jan97jaw
@@ -2376,22 +2376,23 @@ Cond: MAXI
 \ by the way: defining a second interpreter (a compiler-)loop
 \             is not allowed if a system should be ans conform
 
+: (:) ( ghost -- ) 
+\ common factor of : and :noname. Prepare ;Resolve and start definition
+   ;Resolve ! there ;Resolve cell+ !
+   docol, ]comp  colon-start depth T ] H ;
+
 : : ( -- colon-sys ) \ Name
   defempty?
   constflag off \ don't let this flag work over colon defs
 		\ just to go sure nothing unwanted happens
   >in @ skip? IF  drop skip-defs  EXIT  THEN  >in !
-  (THeader ;Resolve ! there ;Resolve cell+ !
-   docol, ]comp  colon-start depth T ] H ;
+  (THeader (:) ;
 
 : :noname ( -- colon-sys )
-  X cfalign
-  \ FIXME: cleanup!!!!!!!!
-  \ idtentical to : with dummy ghost?!
-  here ghostheader dup ;Resolve ! dup last-header-ghost ! to lastghost
-  there ;Resolve cell+ !
-  there docol, ]comp 
-  colon-start depth T ] H ;
+  X cfalign there 
+  \ define a nameless ghost
+  here ghostheader dup last-header-ghost ! dup to lastghost
+  (:) ;  
 
 Cond: EXIT ( -- )   compile ;S  ;Cond
 
@@ -2492,19 +2493,13 @@ Cond: DOES>
 
 : takeover-x-semantics ( S constructor-ghost new-ghost -- )
 \g stores execution semantic and compilation semantic in the built word
-\g if the word already has a semantic (concerns S", IS, .", DOES>)
-\g then keep it
    swap >do:ghost @ 
-   \ we use the >exec2 field for the semantic of a crated word,
-   \ so predefined semantics e.g. for ....
-   \ FIXME: find an example in the normal kernel!!!
+   \ we use the >exec2 field for the semantic of a created word,
+   \ using exec or exec2 makes no difference for normal cross-compilation
+   \ but is usefull for instant where the exec field is already
+   \ defined (e.g. Vocabularies)
    2dup >exec @ swap >exec2 ! 
-\   cr ." XXX" over .ghost
-\   dup >comp @ xt-see
    >comp @ swap >comp ! ;
-\ old version of this:
-\  >exec dup @ ['] NoExec = 
-\  IF swap >do:ghost @ >exec @ swap ! ELSE 2drop THEN ;
 
 : TCreate ( <name> -- )
   create-forward-warn
@@ -2543,25 +2538,20 @@ Cond: DOES>
   postpone ; built >exec ! ; immediate
 
 : gdoes>  ( ghost -- addr flag )
-  executed-ghost @
-\ FIXME: cleanup
-\  compiling? ABORT" CROSS: Executing gdoes> while compiling"
-\ ?! compiling? IF  gexecute true EXIT  THEN
-  g>body ( false ) ;
+  executed-ghost @ g>body ;
 
 \ DO: ;DO                                               11may93jaw
-\ changed to ?EXIT                                      10may93jaw
 
 : do:ghost! ( ghost -- ) built >do:ghost ! ;
 : doexec! ( xt -- ) built >do:ghost @ >exec ! ;
 
 : DO:     ( -- [xt] [colon-sys] )
   here ghostheader do:ghost!
-  :noname postpone gdoes> ( postpone ?EXIT ) ;
+  :noname postpone gdoes> ;
 
 : by:     ( -- [xt] [colon-sys] ) \ name
   Ghost do:ghost!
-  :noname postpone gdoes> ( postpone ?EXIT ) ;
+  :noname postpone gdoes> ;
 
 : ;DO ( [xt] [colon-sys] -- )
   postpone ; doexec! ; immediate
@@ -3023,7 +3013,7 @@ magic 7 + c!
 : save-cross ( "image-name" "binary-name" -- )
   bl parse ." Saving to " 2dup type cr
   w/o bin create-file throw >r
-  TNIL IF
+  s" header" X $has? IF
       s" #! "           r@ write-file throw
       bl parse          r@ write-file throw
       s"  --image-file" r@ write-file throw
@@ -3039,7 +3029,7 @@ magic 7 + c!
   THEN
   image @ there 
   r@ write-file throw \ write image
-  TNIL IF
+  s" relocate" X $has? IF
       bit$  @ there 1- tcell>bit rshift 1+
                 r@ write-file throw \ write tags
   THEN
@@ -3050,7 +3040,7 @@ magic 7 + c!
   swap >image swap r@ write-file throw
   r> close-file throw ;
 
-1 [IF]
+\ save-asm-region                         		29aug01jaw
 
 Variable name-ptr
 Create name-buf 200 chars allot
@@ -3104,6 +3094,7 @@ Create name-buf 200 chars allot
   THEN
   @nb ;
 
+\ FIXME why disabled?!
 : label-from-ghostnameXX ( ghost -- addr len )
 \ same as (label-from-ghostname) but caches generated names
   dup >asm-name @ ?dup IF nip count EXIT THEN
@@ -3257,8 +3248,6 @@ Variable outfile-fd
 : save-asm-region ( region adr len -- )
   create-outfile (save-asm-region) close-outfile ;
 
-[THEN]
-
 \ \ minimal definitions
 	   
 >MINIMAL also minimal
@@ -3527,6 +3516,3 @@ UNLOCK >CROSS
 [IFDEF] extend-cross extend-cross [THEN]
 
 LOCK
-
-
-