--- gforth/cross.fs	1998/05/31 19:29:22	1.55
+++ gforth/cross.fs	1998/12/08 22:02:38	1.58
@@ -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.
 
@@ -68,14 +68,14 @@ Warnings off
 \G SetValue searches in the current vocabulary
  save-input bl word >r restore-input throw r> count
  get-current search-wordlist
- IF bl word drop >body ! ELSE Value THEN ;
+ IF ['] to execute ELSE Value THEN ;
 
 : DefaultValue ( n -- <name> )
 \G Same behaviour as "Value" if the <name> is not defined
 \G DefaultValue searches in the current vocabulary
  save-input bl word >r restore-input throw r> count
  get-current search-wordlist
- IF bl word drop drop drop ELSE Value THEN ;
+ IF bl word drop 2drop ELSE Value THEN ;
 
 hex
 
@@ -334,14 +334,16 @@ s" relocate" T environment? H
 
 \ \ Create additional parameters                         19jan95py
 
+1 8 lshift Constant maxbyte
 T
 NIL		   Constant TNIL
 cell               Constant tcell
 cell<<             Constant tcell<<
 cell>bit           Constant tcell>bit
 bits/byte          Constant tbits/byte
+bits/byte 8 /      Constant tchar
 float              Constant tfloat
-1 bits/byte lshift Constant maxbyte
+1 bits/byte lshift Constant tmaxbyte
 H
 
 \ Variables                                            06oct92py
@@ -589,11 +591,19 @@ bigendian
      DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
    : S@  ( addr -- n )  >r 0 0 r> tcell bounds
      DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
+   : Sc!  ( n addr -- )  >r s>d r> tchar bounds swap 1-
+     DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
+   : Sc@  ( addr -- n )  >r 0 0 r> tchar bounds
+     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
 [ELSE]
    : S!  ( n addr -- )  >r s>d r> tcell bounds
      DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
    : S@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-
      DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
+   : Sc!  ( n addr -- )  >r s>d r> tchar bounds
+     DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
+   : Sc@  ( addr -- n )  >r 0 0 r> tchar bounds swap 1-
+     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
 [THEN]
 
 >CROSS
@@ -629,8 +639,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 >TARGET
 : @  ( taddr -- w )     >image S@ ;
 : !  ( w taddr -- )     >image S! ;
-: c@ ( taddr -- char )  >image c@ ;
-: c! ( char taddr -- )  >image c! ;
+: 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 ;
 
@@ -640,7 +650,7 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : here  ( -- there )    there ;
 : allot ( n -- )        tdp +! ;
 : ,     ( w -- )        T here H tcell T allot  ! H T here drop H ;
-: c,    ( char -- )     T here    1 allot c! H ;
+: 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 ;
@@ -652,9 +662,9 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 
 : tcmove ( source dest len -- )
 \G cmove in target memory
-  bounds
+  tchar * bounds
   ?DO  dup T c@ H I T c! H 1+
-  LOOP  drop ;
+  tchar +LOOP  drop ;
 
 >TARGET
 H also Forth definitions \ ." asm: " order
@@ -1263,7 +1273,7 @@ Defer (end-code)
     ELSE true ABORT" CROSS: Stack empty" THEN
     ;
 
-Cond: chars ;Cond
+( Cond ) : chars tchar * ; ( Cond )
 
 >CROSS