--- gforth/cross.fs	1994/09/09 16:27:17	1.12
+++ gforth/cross.fs	1994/12/15 12:35:12	1.18
@@ -1,7 +1,7 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.12 1994/09/09 16:27:17 anton Exp $
+\ $Id: cross.fs,v 1.18 1994/12/15 12:35:12 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
@@ -40,7 +40,7 @@ VARIABLE GhostNames
 0 GhostNames !
 : GhostName ( -- addr )
         here GhostNames @ , GhostNames ! here 0 ,
-        name count
+        bl word count
 \        2dup type space
         dup c, here over chars allot swap move align ;
 
@@ -84,7 +84,7 @@ Variable tdp
 
 \ Parameter for target systems                         06oct92py
 
-include-file
+included
 
 >TARGET
 
@@ -234,15 +234,13 @@ Variable last-ghost
 \ searches for string in word-list ghosts
 \ !! wouldn't it be simpler to just use search-wordlist ? ae
   dup count [ ' ghosts >body ] ALiteral search-wordlist
-\ >r get-order  0 set-order also ghosts  r> find >r >r
-  >r r@ IF  >body nip  THEN  r> ;
-\ set-order  r> r@  IF  >body  THEN  r> ;
+  dup IF  >r >body nip r>  THEN ;
 
 VARIABLE Already
 
 : ghost   ( "name" -- ghost )
   Already off
-  >in @  name gfind   IF  Already on nip EXIT  THEN
+  >in @  bl word gfind   IF  Already on nip EXIT  THEN
   drop  >in !  Make-Ghost ;
 
 \ resolve                                              14oct92py
@@ -258,7 +256,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 ;
@@ -314,7 +312,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! ;
@@ -324,13 +322,13 @@ VARIABLE ^imm
 
 : ALIAS2 create here 0 , DOES> @ execute ;
 \ usage:
-\ ' alias2 bla !
+\ ' <name> alias2 bla !
 
 \ Target Header Creation                               01nov92py
 
 : string,  ( addr count -- )
   dup T c, H bounds  DO  I c@ T c, H  LOOP ; 
-: name,  ( "name" -- )  name count string, T align H ;
+: name,  ( "name" -- )  bl word count string, T align H ;
 : view,   ( -- ) ( dummy ) ;
 
 VARIABLE CreateFlag CreateFlag off
@@ -339,10 +337,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 !
@@ -398,18 +396,20 @@ ghost '
 
 : compile  ( -- ) \ name
   restrict?
-  name gfind dup 0= ABORT" CROSS: Can't compile "
+  bl word gfind dup 0= ABORT" CROSS: Can't compile "
   0> ( immediate? )
   IF    >exec @ compile,
   ELSE  postpone literal postpone gexecute  THEN ;
                                         immediate
 
 >TARGET
-: '  ( -- cfa ) name gfind 0= ABORT" CROSS: undefined "
+: '  ( -- cfa ) bl word gfind 0= ABORT" CROSS: undefined "
   dup >magic @ <fwd> = ABORT" CROSS: forward " >link @ ;
 
 Cond: [']  compile lit ghost gexecute ;Cond
 
+Cond: chars ;Cond
+
 >CROSS
 \ tLiteral                                             12dec92py
 
@@ -442,7 +442,7 @@ Cond: [Char]   ( "<char>" -- )  restrict
 
 : ] state on
     BEGIN
-        BEGIN >in @ name
+        BEGIN >in @ bl word
               dup c@ 0= WHILE 2drop refill 0=
               ABORT" CROSS: End of file while target compiling"
         REPEAT
@@ -672,14 +672,14 @@ Cond: TO        T ' >body H compile ALit
 \ compile must be last                                 22feb93py
 
 Cond: compile ( -- ) restrict? \ name
-      name gfind dup 0= ABORT" CROSS: Can't compile"
+      bl word gfind dup 0= ABORT" CROSS: Can't compile"
       0> IF    gexecute
          ELSE  dup >magic @ <imm> =
                IF   gexecute
                ELSE compile (compile) gexecute THEN THEN ;Cond
 
 Cond: postpone ( -- ) restrict? \ name
-      name gfind dup 0= ABORT" CROSS: Can't compile"
+      bl word gfind dup 0= ABORT" CROSS: Can't compile"
       0> IF    gexecute
          ELSE  dup >magic @ <imm> =
                IF   gexecute
@@ -693,7 +693,7 @@ also minimal
 
 \ define new [IFDEF] and [IFUNDEF]                      20may93jaw
 
-: there? name gfind IF >magic @ <fwd> <> ELSE drop false THEN ;
+: there? bl word gfind IF >magic @ <fwd> <> ELSE drop false THEN ;
 
 : [IFDEF] there? postpone [IF] ;
 : [IFUNDEF] there? 0= postpone [IF] ;
@@ -738,8 +738,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,6 +751,9 @@ bigendian Constant bigendian
 : * * ;         : / / ;
 : dup dup ;     : over over ;
 : swap swap ;   : rot rot ;
+: drop drop ;
+: lshift lshift ; : 2/ 2/ ;
+cell constant cell
 
 \ include bug5.fs
 \ only forth also minimal definitions