--- gforth/cross.fs	1999/05/18 14:38:49	1.78
+++ gforth/cross.fs	2000/05/04 09:31:16	1.84
@@ -646,7 +646,7 @@ VARIABLE GhostNames
 0 GhostNames !
 
 : GhostName ( -- addr )
-    here GhostNames @ , GhostNames ! here 0 ,
+    align here GhostNames @ , GhostNames ! here 0 ,
     bl word count
     \ 2dup type space
     string, \ !! cfalign ?
@@ -787,7 +787,7 @@ VARIABLE env-current \ save information
 
 >ENVIRON get-order get-current swap 1+ set-order
 true SetValue compiler
-true  SetValue cross
+true SetValue cross
 true SetValue standard-threading
 >TARGET previous
 
@@ -864,7 +864,7 @@ float             	Constant tfloat
 bits/byte		Constant tbits/byte
 [THEN]
 H
-tbits/byte bits/byte /	Constant tbyte
+tbits/char bits/byte /	Constant tbyte
 
 
 \ Variables                                            06oct92py
@@ -927,7 +927,7 @@ Variable mirrored-link          \ linked
   dup >rstart @ swap >rdp @ over - ;
 
 : area ( region -- startaddr totallen ) \G returns the total area
-  dup >rstart swap >rlen @ ;
+  dup >rstart @ swap >rlen @ ;
 
 : mirrored                              \G mark a region as mirrored
   mirrored-link
@@ -1180,8 +1180,19 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : +bit ( addr n -- )  >bit over c@ or swap c! ;
 : -bit ( addr n -- )  >bit invert over c@ and swap c! ;
 
-: (relon) ( taddr -- )  bit$ @ swap cell/ +bit ;
-: (reloff) ( taddr -- ) bit$ @ swap cell/ -bit ;
+: (relon) ( taddr -- )  
+  [ [IFDEF] fd-relocation-table ]
+  s" +" fd-relocation-table write-file throw
+  dup s>d <# #s #> fd-relocation-table write-line throw
+  [ [THEN] ]
+  bit$ @ swap cell/ +bit ;
+
+: (reloff) ( taddr -- ) 
+  [ [IFDEF] fd-relocation-table ]
+  s" -" fd-relocation-table write-file throw
+  dup s>d <# #s #> fd-relocation-table write-line throw
+  [ [THEN] ]
+  bit$ @ swap cell/ -bit ;
 
 : (>image) ( taddr -- absaddr ) image @ + ;
 
@@ -1222,7 +1233,7 @@ T has? relocate H
 : c@ ( taddr -- char )  >image Sc@ ;
 : c! ( char taddr -- )  >image Sc! ;
 : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
-: 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ;
+: 2! ( x1 x2 taddr -- ) T tuck ! cell+ ! H ;
 
 \ Target compilation primitives                        06oct92py
 \ included A!                                          16may93jaw
@@ -1489,7 +1500,6 @@ variable ResolveFlag
   ELSE 	drop 
   THEN ;
 
->MINIMAL
 : .unresolved  ( -- )
   ResolveFlag off cr ." Unresolved: "
   Ghostnames
@@ -1508,6 +1518,10 @@ variable ResolveFlag
   cr ." named Headers: " headers-named @ . 
   r> base ! ;
 
+>MINIMAL
+
+: .unresolved .unresolved ;
+
 >CROSS
 \ Header states                                        12dec92py
 
@@ -1604,7 +1618,8 @@ Create tag-bof 1 c,  0C c,
 Defer skip? ' false IS skip?
 
 : skipdef ( <name> -- )
-\G skip definition of an undefined word in undef-words mode
+\G skip definition of an undefined word in undef-words and
+\G all-words mode
     ghost dup forward?
     IF  >magic <skip> swap !
     ELSE drop THEN ;
@@ -1617,6 +1632,10 @@ Defer skip? ' false IS skip?
 \G that's what we want
     ghost forward? 0= ;
 
+: forced? ( -- flag ) \ name
+\G return ture if it is a foreced skip with defskip
+    ghost >magic @ <skip> = ;
+
 : needed? ( -- flag ) \ name
 \G returns a false flag when
 \G a word is not defined
@@ -1643,7 +1662,9 @@ NoHeaderFlag off
     base @ >r hex 
     0 swap <# 0 ?DO # LOOP #> type 
     r> base ! ;
-: .sym
+
+: .sym ( adr len -- )
+\G escapes / and \ to produce sed output
   bounds 
   DO I c@ dup
 	CASE	[char] / OF drop ." \/" ENDOF
@@ -1666,9 +1687,15 @@ NoHeaderFlag off
 	>in @ T name, H >in !
     THEN
     T cfalign here H tlastcfa !
-    \ Symbol table
+    \ Old Symbol table sed-script
 \    >in @ cr ." sym:s/CFA=" there 4 0.r ." /"  bl word count .sym ." /g" cr >in !
     ghost
+    \ output symbol table to extra file
+    [ [IFDEF] fd-symbol-table ]
+      base @ hex there s>d <# 8 0 DO # LOOP #> fd-symbol-table write-file throw base !
+      s" :" fd-symbol-table write-file throw
+      dup >ghostname fd-symbol-table write-line throw
+    [ [THEN] ]
     dup Last-Header-Ghost !
     dup >magic ^imm !     \ a pointer for immediate
     Already @
@@ -1789,7 +1816,9 @@ Cond: [']  T ' H alit, ;Cond
 : (lit,) ( n -- )   compile lit T  ,  H ;	' (lit,) IS lit,
 
 \ if we dont produce relocatable code alit, defaults to lit, jaw
-has? relocate
+\ this is just for convenience, so we don't have to define alit,
+\ seperately for embedded systems....
+T has? relocate H
 [IF]
 : (alit,) ( n -- )  compile lit T  a, H ;	' (alit,) IS alit,
 [ELSE]
@@ -2347,7 +2376,7 @@ Cond: defers	T ' >body @ compile, H ;Con
 \ LINKED ERR" ENV" 2ENV"                                18may93jaw
 
 \ linked list primitive
-: linked        T here over @ A, swap ! H ;
+: linked        X here over X @ X A, swap X ! ;
 : chained	T linked A, H ;
 
 : err"   s" ErrLink linked" evaluate T , H
@@ -2398,9 +2427,9 @@ magic 7 + c!
   bl parse ." Saving to " 2dup type cr
   w/o bin create-file throw >r
   TNIL IF
-      s" #! "   r@ write-file throw
-      bl parse  r@ write-file throw
-      s"  -i"   r@ write-file throw
+      s" #! "           r@ write-file throw
+      bl parse          r@ write-file throw
+      s"  --image-file" r@ write-file throw
       #lf       r@ emit-file throw
       r@ dup file-position throw drop 8 mod 8 swap ( file-id limit index )
       ?do
@@ -2587,7 +2616,7 @@ previous
 : 2/ 2/ ;
 : . . ;
 
-: all-words    ['] false    IS skip? ;
+: all-words    ['] forced?    IS skip? ;
 : needed-words ['] needed?  IS skip? ;
 : undef-words  ['] defined2? IS skip? ;
 : skipdef skipdef ;