--- gforth/cross.fs	1994/02/11 16:30:45	1.1
+++ gforth/cross.fs	1994/07/08 15:00:30	1.7
@@ -1,5 +1,5 @@
 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.1 1994/02/11 16:30:45 anton Exp $
+\ $Id: cross.fs,v 1.7 1994/07/08 15:00:30 anton Exp $
 \ Idea and implementation: Bernd Paysan (py)
 \ Copyright 1992 by the ANSI figForth Development Group
 
@@ -23,6 +23,12 @@
 
 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
 
 \ number?                                               11may93jaw
@@ -117,13 +123,6 @@ Variable bit$
 Variable tdp
 : there  tdp @ ;
 
-\ Constants                                            06apr93py
-
--2 Constant :docol
--3 Constant :docon
--4 Constant :dovar
--5 Constant :dodoes
-
 \ Parameter for target systems                         06oct92py
 
 include machine.fs
@@ -135,7 +134,8 @@ include machine.fs
 : cell+         cell + ;
 : cells         cell<< lshift ;
 : chars         ;
-
+: floats	float * ;
+    
 >CROSS
 : cell/         cell<< rshift ;
 >TARGET
@@ -144,7 +144,9 @@ include machine.fs
 -2 Constant :docol
 -3 Constant :docon
 -4 Constant :dovar
--5 Constant :dodoes
+-5 Constant :douser
+-6 Constant :dodoes
+-7 Constant :doesjump
 
 >CROSS
 
@@ -160,10 +162,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"
@@ -186,7 +188,9 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 
 : >bit ( addr n -- c-addr mask ) 8 /mod rot + swap bits ;
 : +bit ( addr n -- )  >bit over c@ or swap c! ;
+: -bit ( addr n -- )  >bit invert over c@ and swap c! ;
 : relon ( taddr -- )  bit$ @ swap cell/ +bit ;
+: reloff ( taddr -- )  bit$ @ swap cell/ -bit ;
 
 \ Target memory access                                 06oct92py
 
@@ -204,6 +208,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
@@ -228,7 +234,7 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : >body   ( cfa -- pfa ) T cell+ cell+ H ;
 >CROSS
 
-: dodoes, ( -- ) T 0 , 0 , H ;
+: dodoes, ( -- ) T :doesjump A, 0 , H ;
 
 \ Ghost Builder                                        06oct92py
 
@@ -266,8 +272,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
 
@@ -412,7 +420,7 @@ ghost (do)      ghost (?do)
 ghost (for)                                     drop
 ghost (loop)    ghost (+loop)                   2drop
 ghost (next)                                    drop
-ghost unloop    ghost EXIT                      2drop
+ghost unloop    ghost ;S                        2drop
 ghost lit       ghost (compile) ghost !         2drop drop
 ghost (;code)   ghost noop                      2drop
 ghost (.")      ghost (S")      ghost (ABORT")  2drop drop
@@ -481,10 +489,14 @@ Cond: [Char]   ( "<char>" -- )  restrict
   (THeader ;Resolve ! there ;Resolve cell+ !
   docol, depth T ] H ;
 
+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
-               compile EXIT state off
+               compile ;S state off
                ;Resolve @
                IF ;Resolve @ ;Resolve cell+ @ resolve THEN
                ;Cond
@@ -513,7 +525,7 @@ Cond: DOES> restrict?
 
 : 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 ;
+  :dodoes T A, H gexecute T here H cell - reloff ;
 
 : TCreate ( ghost -- )
   CreateFlag on
@@ -560,16 +572,30 @@ Build: T 0 A, H ;
 by Create
 Builder AVariable
 
-Build: T 0 , H ;
-by Create
+\ User variables                                       04may94py
+
+>CROSS
+Variable tup  0 tup !
+Variable tudp 0 tudp !
+: u,  ( n -- udp )
+  tup @ tudp @ + T  ! H
+  tudp @ dup cell+ tudp ! ;
+: au, ( n -- udp )
+  tup @ tudp @ + T A! H
+  tudp @ dup cell+ tudp ! ;
+>TARGET
+
+Build: T 0 u, , H ;
+DO: ( ghost -- up-addr )  T @ H tup @ + ;DO
 Builder User
+by User :douser resolve
 
-Build: T 0 , 0 , H ;
-by Create
+Build: T 0 u, , 0 u, drop H ;
+by User
 Builder 2User
 
-Build: T 0 A, H ;
-by Create
+Build: T 0 au, , H ;
+by User
 Builder AUser
 
 Build:  ( n -- ) T , H ;
@@ -769,6 +795,8 @@ only forth also minimal definitions
 : decimal       decimal ;
 : hex           hex ;
 
+: tudp          T tudp H ;
+: tup           T tup H ;  minimal
 
 \ for debugging...
 : order         order ;