--- gforth/cross.fs	1994/06/17 12:34:58	1.6
+++ gforth/cross.fs	1994/08/25 15:25:20	1.10
@@ -1,5 +1,5 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.6 1994/06/17 12:34:58 anton Exp $
+\ $Id: cross.fs,v 1.10 1994/08/25 15:25:20 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,8 +104,9 @@ 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
 
@@ -208,6 +168,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : !  ( w taddr -- )     >r bswap r> >image ! ;
 : c@ ( taddr -- char )  >image c@ ;
 : c! ( char taddr -- )  >image c! ;
+: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
+: 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ;
 
 \ Target compilation primitives                        06oct92py
 \ included A!                                          16may93jaw
@@ -334,7 +296,13 @@ variable ResolveFlag
   Ghostnames
   BEGIN @ dup
   WHILE dup ?resolved
-  REPEAT drop ResolveFlag @ 0= IF ." Nothing!" THEN cr ;
+  REPEAT drop ResolveFlag @
+  IF
+      1 (bye)
+  ELSE
+      ." Nothing!"
+  THEN
+  cr ;
 
 >CROSS
 \ Header states                                        12dec92py
@@ -348,7 +316,7 @@ VARIABLE ^imm
                 ^imm @ @ dup <imm> = ?EXIT
                 <res> <> ABORT" CROSS: Cannot immediate a unresolved word"
                 <imm> ^imm @ ! ;
-: restrict      ;
+: restrict      40 flag! ;
 >CROSS
 
 \ ALIAS2 ansforth conform alias                          9may93jaw
@@ -422,6 +390,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
 
@@ -612,6 +581,7 @@ Builder Value
 Build:  ( -- ) compile noop ;
 DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
 Builder Defer
+by Defer :dodefer resolve
 
 \ structural conditionals                              17dec92py
 
@@ -680,6 +650,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