--- gforth/cross.fs	1999/12/31 21:39:59	1.83
+++ gforth/cross.fs	2000/10/29 20:27:02	1.88
@@ -1,7 +1,7 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
 \ Idea and implementation: Bernd Paysan (py)
 
-\ Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -17,7 +17,7 @@
 
 \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software
-\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 
 0 
 [IF]
@@ -474,27 +474,17 @@ Create tfile 0 c, 255 chars allot
     THEN ;
 
 : compact.. ( adr len -- adr2 len2 )
-\ deletes phrases like "xy/.." out of our directory name 2dec97jaw
-  over >r -1 >r
-  BEGIN dup WHILE
-	over c@ pathsep? 
-	IF 	r@ -1 =
-		IF	r> drop dup >r
-		ELSE	2dup 1 /string 
-			3 min s" ../" compare
-			0=
-			IF	r@ over - ( diff )
-				2 pick swap - ( dest-adr )
-				>r 3 /string r> swap 2dup >r >r
-				move r> r>
-			ELSE	r> drop dup >r
-			THEN
-		THEN
-	THEN
-	1 /string
-  REPEAT 
-  r> drop 
-  drop r> tuck - ;
+    \ deletes phrases like "xy/.." out of our directory name 2dec97jaw
+    over swap
+    BEGIN  dup  WHILE
+        dup >r '/ scan 2dup 4 min s" /../" compare 0=
+        IF
+            dup r> - >r 4 /string over r> + 4 -
+            swap 2dup + >r move dup r> over -
+        ELSE
+            rdrop dup 1 min /string
+        THEN
+    REPEAT  drop over - ;
 
 : reworkdir ( -- )
   remove~+
@@ -812,6 +802,7 @@ false DefaultValue dcomps
 false DefaultValue hash
 false DefaultValue xconds
 false DefaultValue header
+false DefaultValue new-input
 [THEN]
 
 true DefaultValue interpreter
@@ -1180,8 +1171,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 @ + ;
 
@@ -1651,7 +1653,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
@@ -1674,9 +1678,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 @
@@ -1797,7 +1807,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]
@@ -2191,6 +2203,14 @@ Builder Field
 : cell% ( n -- size align )
     T 1 cells H dup ;
 
+Build: ( m v -- m' v )  dup T , H cell+ ;
+DO:  abort" Not in cross mode" ;DO
+Builder input-method
+
+Build: ( m v size -- m v' )  over T , H + ;
+DO:  abort" Not in cross mode" ;DO
+Builder input-var
+
 \ structural conditionals                              17dec92py
 
 >CROSS