--- gforth/cross.fs	1998/10/25 23:15:46	1.57
+++ gforth/cross.fs	1999/01/10 22:00:22	1.65
@@ -1,7 +1,7 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
 \ Idea and implementation: Bernd Paysan (py)
 
-\ Copyright (C) 1995 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -52,6 +52,7 @@ Warnings off
 
 \ words that are generaly useful
 
+: KB  400 * ;
 : >wordlist ( vocabulary-xt -- wordlist-struct )
   also execute get-order swap >r 1- set-order r> ;
 
@@ -302,6 +303,7 @@ true  SetValue cross
 true SetValue standard-threading
 >TARGET previous
 
+
 mach-file count included hex
 
 >ENVIRON
@@ -653,10 +655,11 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : c,    ( char -- )     T here    tchar allot c! H ;
 : align ( -- )          T here H align+ 0 ?DO  bl T c, H LOOP ;
 : cfalign ( -- )
-    T here H cfalign+ 0 ?DO  bl T c, H LOOP ;
+    T here H cfalign+ 0 ?DO  bl T c, tchar H +LOOP ;
 
-: A!                    dup relon T ! H ;
-: A,    ( w -- )        T here H relon T , H ;
+: >address		dup 0>= IF tchar / THEN ;
+: A!                    swap >address swap dup relon T ! H ;
+: A,    ( w -- )        >address T here H relon T , H ;
 
 >CROSS
 
@@ -1115,7 +1118,7 @@ NoHeaderFlag off
     IF  NoHeaderFlag off
     ELSE
 	T align H view,
-	tlast @ dup 0> IF  T 1 cells - THEN  A, H  there tlast !
+	tlast @ dup 0> IF  T 1 cells - H THEN T A, H  there tlast !
 	1 headers-named +!	\ Statistic
 	>in @ T name, H >in !
     THEN
@@ -1161,6 +1164,11 @@ VARIABLE ;Resolve 1 cells allot
 	.sourcepos ." needs doer: " >in @ bl word count type >in ! cr
     THEN
     ghost tuck swap resolve <do:> swap >magic ! ;
+
+Variable prim#
+: first-primitive ( n -- )  prim# ! ;
+: Primitive  ( -- ) \ name
+    prim# @ T Alias H  -1 prim# +! ;
 >CROSS
 
 \ Conditionals and Comments                            11may93jaw
@@ -1223,7 +1231,7 @@ Cond: [']  T ' H alit, ;Cond
 \ modularized						14jun97jaw
 
 : fillcfa   ( usedcells -- )
-  T cells H xt>body swap - 0 ?DO 0 T c, H LOOP ;
+  T cells H xt>body swap - 0 ?DO 0 T c, tchar H +LOOP ;
 
 : (>body)   ( cfa -- pfa ) xt>body + ;		' (>body) T IS >body H
 
@@ -1631,7 +1639,7 @@ Builder Field
 : sys?        ( sys -- sys )    dup 0= ?struc ;
 : >mark       ( -- sys )        T here  ( dup ." M" hex. ) 0 , H ;
 
-: branchoffset ( src dest -- ) - ;
+: branchoffset ( src dest -- ) - tchar / ;
 
 : >resolve    ( sys -- )        T here ( dup ." >" hex. ) over branchoffset swap ! H ;
 
@@ -1951,9 +1959,18 @@ previous
 \ save-cross                                           17mar93py
 
 >CROSS
-Create magic  s" Gforth10" here over allot swap move
+Create magic  s" Gforth2x" here over allot swap move
 
-char 1 bigendian + tcell + magic 7 + c!
+bigendian 1+ \ strangely, in magic big=0, little=1
+tcell 1 = 0 and or
+tcell 2 = 2 and or
+tcell 4 = 4 and or
+tcell 8 = 6 and or
+tchar 1 = $00 and or
+tchar 2 = $28 and or
+tchar 4 = $50 and or
+tchar 8 = $78 and or
+magic 7 + c!
 
 : save-cross ( "image-name" "binary-name" -- )
   bl parse ." Saving to " 2dup type cr
@@ -2003,7 +2020,8 @@ bigendian Constant bigendian
 : tempdp> tempdp> ;
 : const constflag on ;
 : warnings name 3 = 0= twarnings ! drop ;
-: | NoHeaderFlag on ;
+: | ;
+\ : | NoHeaderFlag on ; \ This is broken (damages the last word)
 
 : save-cross save-cross ;
 : save-region save-region ;