--- gforth/cross.fs	1994/12/15 12:35:12	1.18
+++ gforth/cross.fs	1995/02/08 13:38:50	1.23
@@ -1,5 +1,5 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.18 1994/12/15 12:35:12 pazsan Exp $
+\ $Id: cross.fs,v 1.23 1995/02/08 13:38:50 pazsan Exp $
 \ Idea and implementation: Bernd Paysan (py)
 \ Copyright 1992-94 by the GNU Forth Development Group
 
@@ -23,6 +23,10 @@
 
 \ include other.fs       \ ansforth extentions for cross
 
+: string, ( c-addr u -- )
+    \ puts down string as cstring
+    dup c, here swap chars dup allot move ;
+' falign Alias cfalign
 : comment? ( c-addr u -- c-addr u )
         2dup s" (" compare 0=
         IF    postpone (
@@ -39,10 +43,10 @@ decimal
 VARIABLE GhostNames
 0 GhostNames !
 : GhostName ( -- addr )
-        here GhostNames @ , GhostNames ! here 0 ,
-        bl word count
-\        2dup type space
-        dup c, here over chars allot swap move align ;
+    here GhostNames @ , GhostNames ! here 0 ,
+    bl word count
+    \ 2dup type space
+    string, cfalign ;
 
 hex
 
@@ -86,17 +90,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
@@ -110,12 +125,17 @@ 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 ;
+bigendian
+[IF]
+   : 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 ;
 [THEN]
 
 \ Memory initialisation                                05dec92py
@@ -156,16 +176,23 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 
 : align+  ( taddr -- rest )
     cell tuck 1- and - [ cell 1- ] Literal and ;
+: cfalign+  ( taddr -- rest )
+    \ see kernal.fs:cfaligned
+    float tuck 1- and - [ float 1- ] Literal and ;
 
 >TARGET
 : aligned ( taddr -- ta-addr )  dup align+ + ;
 \ assumes cell alignment granularity (as GNU C)
 
+: cfaligned ( taddr1 -- taddr2 )
+    \ see kernal.fs
+    dup cfalign+ + ;
+
 >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 ;
@@ -179,6 +206,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : ,     ( w -- )        T here H cell T allot  ! H ;
 : c,    ( char -- )     T here    1 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 ;
 
 : A!                    dup relon T ! H ;
 : A,    ( w -- )        T here H relon T , H ;
@@ -328,7 +357,7 @@ VARIABLE ^imm
 
 : string,  ( addr count -- )
   dup T c, H bounds  DO  I c@ T c, H  LOOP ; 
-: name,  ( "name" -- )  bl word count string, T align H ;
+: name,  ( "name" -- )  bl word count string, T cfalign H ;
 : view,   ( -- ) ( dummy ) ;
 
 VARIABLE CreateFlag CreateFlag off
@@ -547,10 +576,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 ;
@@ -751,8 +780,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