--- gforth/cross.fs	1994/10/24 19:15:53	1.14
+++ gforth/cross.fs	1995/01/19 17:47:59	1.19
@@ -1,7 +1,7 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.14 1994/10/24 19:15:53 anton Exp $
+\ $Id: cross.fs,v 1.19 1995/01/19 17:47:59 pazsan Exp $
 \ Idea and implementation: Bernd Paysan (py)
-\ Copyright 1992 by the ANSI figForth Development Group
+\ Copyright 1992-94 by the GNU Forth Development Group
 
 \ Log:
 \       changed in ; [ to state off           12may93jaw
@@ -86,17 +86,28 @@ Variable tdp
 
 included
 
+\ Create additional parameters                         19jan95py
+
+T
+cell               Constant tcell
+cell<<             Constant tcell<<
+cell>bit           Constant tcell>bit
+bits/byte          Constant tbits/byte
+float              Constant tfloat
+1 bits/byte lshift Constant maxbyte
+H
+
 >TARGET
 
 \ Byte ordering and cell size                          06oct92py
 
-: cell+         cell + ;
-: cells         cell<< lshift ;
+: cell+         tcell + ;
+: cells         tcell<< lshift ;
 : chars         ;
-: floats	float * ;
+: floats	tfloat * ;
     
 >CROSS
-: cell/         cell<< rshift ;
+: cell/         tcell<< rshift ;
 >TARGET
 20 CONSTANT bl
 -1 Constant NIL
@@ -111,11 +122,23 @@ included
 >CROSS
 
 bigendian  0 pad ! -1 pad c! pad @ 0<
-= [IF]   : bswap ; immediate 
-[ELSE]   : bswap ( big / little -- little / big )  0
-           cell 1- FOR  bits/byte lshift over
-                        [ 1 bits/byte lshift 1- ] Literal and or
-                        swap bits/byte rshift swap  NEXT  nip ;
+= [IF]
+\   : bswap ; immediate 
+: T!  ( n addr -- )  >r s>d r> tcell bounds swap 1-
+  DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
+: T@  ( addr -- n )  >r 0 0 r> tcell bounds
+  DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
+
+[ELSE]
+: T!  ( n addr -- )  >r s>d r> tcell bounds
+  DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
+: T@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-
+  DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
+
+\   : bswap ( big / little -- little / big )  0
+\           cell 1- FOR  bits/byte lshift over
+\                        [ 1 bits/byte lshift 1- ] Literal and or
+\                        swap bits/byte rshift swap  NEXT  nip ;
 [THEN]
 
 \ Memory initialisation                                05dec92py
@@ -164,8 +187,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 >CROSS
 : >image ( taddr -- absaddr )  image @ + ;
 >TARGET
-: @  ( taddr -- w )     >image @ bswap ;
-: !  ( w taddr -- )     >r bswap r> >image ! ;
+: @  ( taddr -- w )     >image t@ ;
+: !  ( w taddr -- )     >image t! ;
 : c@ ( taddr -- char )  >image c@ ;
 : c! ( char taddr -- )  >image c! ;
 : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
@@ -256,7 +279,7 @@ VARIABLE Already
   BEGIN @ dup
   WHILE 2dup cell+ @ =
   UNTIL
-        nip 2 cells + count cr ." CROSS: Exists: " type 4 spaces
+        2 cells + count cr ." CROSS: Exists: " type 4 spaces drop
         swap cell+ !
   ELSE true ABORT" CROSS: Ghostnames inconsistent"
   THEN ;
@@ -312,7 +335,7 @@ VARIABLE ^imm
 
 >TARGET
 : immediate     20 flag!
-                ^imm @ @ dup <imm> = ?EXIT
+                ^imm @ @ dup <imm> = IF  drop  EXIT  THEN
                 <res> <> ABORT" CROSS: Cannot immediate a unresolved word"
                 <imm> ^imm @ ! ;
 : restrict      40 flag! ;
@@ -322,7 +345,7 @@ VARIABLE ^imm
 
 : ALIAS2 create here 0 , DOES> @ execute ;
 \ usage:
-\ ' alias2 bla !
+\ ' <name> alias2 bla !
 
 \ Target Header Creation                               01nov92py
 
@@ -337,10 +360,10 @@ VARIABLE CreateFlag CreateFlag off
   tlast @ dup 0> IF  T 1 cells - THEN  A, H  there tlast !
   >in @ name, >in ! T here H tlastcfa !
   CreateFlag @ IF
-  >in @ alias2 swap >in !         \ create alias in target
-  >in @ ghost swap >in !
-  swap also ghosts ' previous swap !        \ tick ghost and store in alias
-  CreateFlag off
+       >in @ alias2 swap >in !         \ create alias in target
+       >in @ ghost swap >in !
+       swap also ghosts ' previous swap !     \ tick ghost and store in alias
+       CreateFlag off
   ELSE ghost THEN
   dup >magic ^imm !     \ a pointer for immediate
   Already @ IF  dup >end tdoes !
@@ -547,10 +570,10 @@ Variable tup  0 tup !
 Variable tudp 0 tudp !
 : u,  ( n -- udp )
   tup @ tudp @ + T  ! H
-  tudp @ dup cell+ tudp ! ;
+  tudp @ dup T cell+ H tudp ! ;
 : au, ( n -- udp )
   tup @ tudp @ + T A! H
-  tudp @ dup cell+ tudp ! ;
+  tudp @ dup T cell+ H tudp ! ;
 >TARGET
 
 Build: T 0 u, , H ;
@@ -738,8 +761,10 @@ bigendian Constant bigendian
 : save-cross ( "name" -- )
   bl parse ." Saving to " 2dup type
   w/o bin create-file throw >r
-  image @ there r@ write-file throw
-  bit$  @ there 1- cell>bit rshift 1+ r@ write-file throw
+  s" gforth00"  r@ write-file throw \ write magic
+  image @ there r@ write-file throw \ write image
+  bit$  @ there 1- cell>bit rshift 1+
+                r@ write-file throw \ write tags
   r> close-file throw ;
 
 \ words that should be in minimal
@@ -749,8 +774,9 @@ bigendian Constant bigendian
 : * * ;         : / / ;
 : dup dup ;     : over over ;
 : swap swap ;   : rot rot ;
-: drop drop ;
+: drop drop ;   : =   = ;
 : lshift lshift ; : 2/ 2/ ;
+: . . ;
 cell constant cell
 
 \ include bug5.fs