--- gforth/cross.fs	1994/05/18 17:29:50	1.4
+++ 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.4 1994/05/18 17:29:50 pazsan 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,50 +21,15 @@
 \             targets                         09jun93jaw
 \       added: 2user and value                11jun93jaw
 
-include other.fs       \ ansforth extentions for cross
-
-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 ! ;
+\ include other.fs       \ ansforth extentions for cross
 
+: comment? ( c-addr u -- c-addr u )
+        2dup s" (" compare 0=
+        IF    postpone (
+        ELSE  2dup s" \" compare 0= IF postpone \ THEN
+        THEN ;
 
+decimal
 
 \ Begin CROSS COMPILER:
 
@@ -119,7 +84,7 @@ Variable tdp
 
 \ Parameter for target systems                         06oct92py
 
-include machine.fs
+include-file
 
 >TARGET
 
@@ -128,7 +93,8 @@ include machine.fs
 : cell+         cell + ;
 : cells         cell<< lshift ;
 : chars         ;
-
+: floats	float * ;
+    
 >CROSS
 : cell/         cell<< rshift ;
 >TARGET
@@ -138,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
 
@@ -155,10 +122,10 @@ endian  0 pad ! -1 pad c! pad @ 0<
 \ Fixed bug in else part                               11may93jaw
 
 [IFDEF] Memory \ Memory is a bigFORTH feature
-   Memory
+   also Memory
    : initmem ( var len -- )
      2dup swap handle! >r @ r> erase ;
-   Target
+   toss
 [ELSE]
    : initmem ( var len -- )
      tuck allocate abort" CROSS: No memory for target"
@@ -201,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
@@ -263,8 +232,10 @@ Variable atonce atonce off
 : gfind   ( string -- ghost true/1 / string false )
 \ searches for string in word-list ghosts
 \ !! wouldn't it be simpler to just use search-wordlist ? ae
-  >r get-order  0 set-order also ghosts  r> find >r >r
-  set-order  r> r@  IF  >body  THEN  r> ;
+  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> ;
 
 VARIABLE Already
 
@@ -325,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
@@ -339,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
@@ -413,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
 
@@ -480,6 +458,8 @@ Cond: [Char]   ( "<char>" -- )  restrict
 
 Cond: EXIT ( -- )  restrict?  compile ;S  ;Cond
 
+Cond: ?EXIT ( -- ) 1 abort" CROSS: using ?exit" ;Cond
+
 Cond: ; ( -- ) restrict?
                depth ?dup IF   1- <> ABORT" CROSS: Stack changed"
                           ELSE true ABORT" CROSS: Stack empty" THEN
@@ -601,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
 
@@ -669,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