--- gforth/cross.fs	1994/07/13 19:20:59	1.8
+++ gforth/cross.fs	1994/09/09 16:27:17	1.12
@@ -1,5 +1,5 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.8 1994/07/13 19:20:59 pazsan Exp $
+\ $Id: cross.fs,v 1.12 1994/09/09 16:27:17 anton Exp $
 \ Idea and implementation: Bernd Paysan (py)
 \ Copyright 1992 by the ANSI figForth Development Group
 
@@ -21,7 +21,7 @@
 \             targets                         09jun93jaw
 \       added: 2user and value                11jun93jaw
 
-include other.fs       \ ansforth extentions for cross
+\ include other.fs       \ ansforth extentions for cross
 
 : comment? ( c-addr u -- c-addr u )
         2dup s" (" compare 0=
@@ -31,47 +31,6 @@ include other.fs       \ ansforth extent
 
 decimal
 
-\ number?                                               11may93jaw
-
-\ checks for +, -, $, & ...
-: leading? ( c-addr u -- c-addr u doubleflag negflag base )
-        2dup 1- chars + c@ [char] . =   \ process double
-        IF dup 1 chars = IF over 1 swap c! false ELSE 1 chars - true THEN
-        \ only if more than only . ( may be number output! )
-        \ if only . => store garbage
-        ELSE false THEN >r      \ numbers
-        false -rot base @ -rot
-        BEGIN over c@
-                dup [char] - =
-                        IF drop >r >r >r
-                           drop true r> r> r> 0 THEN
-                dup [char] + =
-                        IF drop 0 THEN
-                dup [char] $ =
-                        IF drop >r >r drop 16 r> r> 0 THEN
-                dup [char] & =
-                        IF drop >r >r drop 10 r> r> 0 THEN
-              0= IF 1 chars - swap char+ swap false ELSE true THEN
-              over 0= or
-        UNTIL
-              rot >r rot r> r> -rot ;
-
-: number? ( c-addr -- n/d flag )
-\ return -1 if cell 1 if double 0 if garbage
-                0 swap 0 swap           \ create double number
-                count leading?
-                base @ >r base !
-                >r >r
-                >number IF 2drop false r> r> 2drop
-                           r> base ! EXIT THEN
-                drop r> r>
-                IF IF dnegate 1
-                   ELSE drop negate -1 THEN
-                ELSE IF 1 ELSE drop -1 THEN
-                THEN r> base ! ;
-
-
-
 \ Begin CROSS COMPILER:
 
 \ GhostNames                                            9may93jaw
@@ -125,7 +84,7 @@ Variable tdp
 
 \ Parameter for target systems                         06oct92py
 
-include machine.fs
+include-file
 
 >TARGET
 
@@ -145,12 +104,13 @@ include machine.fs
 -3 Constant :docon
 -4 Constant :dovar
 -5 Constant :douser
--6 Constant :dodoes
--7 Constant :doesjump
+-6 Constant :dodefer
+-7 Constant :dodoes
+-8 Constant :doesjump
 
 >CROSS
 
-endian  0 pad ! -1 pad c! pad @ 0<
+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
@@ -260,11 +220,12 @@ Variable atonce atonce off
 : >magic ; : >link cell+ ; : >exec cell+ cell+ ;
 : >end 3 cells + ;
 
+Variable last-ghost
 : Make-Ghost ( "name" -- ghost )
   >in @ GhostName swap >in !
   <T Create atonce @ IF immediate atonce off THEN
   here tuck swap ! ghostheader T>
-  DOES>  >exec @ execute ;
+  DOES> dup last-ghost ! >exec @ execute ;
 
 \ ghost words                                          14oct92py
 \                                          changed:    10may93py/jaw
@@ -336,7 +297,13 @@ variable ResolveFlag
   Ghostnames
   BEGIN @ dup
   WHILE dup ?resolved
-  REPEAT drop ResolveFlag @ 0= IF ." Nothing!" THEN cr ;
+  REPEAT drop ResolveFlag @
+  IF
+      abort" Unresolved words!"
+  ELSE
+      ." Nothing!"
+  THEN
+  cr ;
 
 >CROSS
 \ Header states                                        12dec92py
@@ -384,7 +351,8 @@ VARIABLE CreateFlag CreateFlag off
 
 VARIABLE ;Resolve 1 cells allot
 
-: Theader  ( "name" -- )     (THeader there resolve 0 ;Resolve ! ;
+: Theader  ( "name" -- ghost )
+  (THeader dup there resolve 0 ;Resolve ! ;
 
 >TARGET
 : Alias    ( cfa -- ) \ name
@@ -424,6 +392,7 @@ ghost unloop    ghost ;S
 ghost lit       ghost (compile) ghost !         2drop drop
 ghost (;code)   ghost noop                      2drop
 ghost (.")      ghost (S")      ghost (ABORT")  2drop drop
+ghost '
 
 \ compile                                              10may93jaw
 
@@ -520,34 +489,33 @@ Cond: DOES> restrict?
   >in @ alias2 swap dup >in ! >r >r
   Make-Ghost rot swap >exec ! ,
   r> r> >in !
-  also ghosts ' previous swap !
-  DOES> dup >exec @ execute ;
+  also ghosts ' previous swap ! ;
+\  DOES>  dup >exec @ execute ;
 
 : gdoes,  ( ghost -- )  >end @ dup >magic @ <fwd> <>
   IF dup >link @ dup 0< IF T A, 0 , H drop EXIT THEN drop THEN
   :dodoes T A, H gexecute T here H cell - reloff ;
 
-: TCreate ( ghost -- )
+: TCreate ( -- )
+  last-ghost @
   CreateFlag on
-  Theader dup gdoes,
-  >end @ >exec @ execute ;
+  Theader >r dup gdoes,
+  >end @ >exec @ r> >exec ! ;
 
 : Build:  ( -- [xt] [colon-sys] )
   :noname  postpone TCreate ;
 
 : gdoes>  ( ghost -- addr flag )
+  last-ghost @
   state @ IF  gexecute true EXIT  THEN
   cell+ @ T >body H false ;
 
 \ DO: ;DO                                               11may93jaw
 \ changed to ?EXIT                                      10may93jaw
 
-: (does>)        postpone does> ; immediate \ second level does>
-
 : DO:     ( -- addr [xt] [colon-sys] )
   here ghostheader
-  :noname
-  postpone (does>) postpone gdoes> postpone ?EXIT ;
+  :noname postpone gdoes> postpone ?EXIT ;
 
 : ;DO ( addr [xt] [colon-sys] -- )
   postpone ;    ( S addr xt )
@@ -614,6 +582,7 @@ Builder Value
 Build:  ( -- ) compile noop ;
 DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
 Builder Defer
+by Defer :dodefer resolve
 
 \ structural conditionals                              17dec92py
 
@@ -682,6 +651,8 @@ Cond: ABORT"    restrict? compile (ABORT
 
 Cond: IS        T ' >body H compile ALiteral compile ! ;Cond
 : IS            T ' >body ! H ;
+Cond: TO        T ' >body H compile ALiteral compile ! ;Cond
+: TO            T ' >body ! H ;
 
 \ LINKED ERR" ENV" 2ENV"                                18may93jaw
 
@@ -762,7 +733,7 @@ Cond: [ELSE]    [ELSE] ;Cond
 \ [THEN]
 \ included throw after create-file                     11may93jaw
 
-endian Constant endian
+bigendian Constant bigendian
 
 : save-cross ( "name" -- )
   bl parse ." Saving to " 2dup type
@@ -775,6 +746,7 @@ endian Constant endian
 
 : + + ;         : 1- 1- ;
 : - - ;         : 2* 2* ;
+: * * ;         : / / ;
 : dup dup ;     : over over ;
 : swap swap ;   : rot rot ;