--- gforth/cross.fs	1997/02/08 22:58:09	1.43
+++ gforth/cross.fs	1997/04/10 21:32:08	1.47
@@ -100,6 +100,7 @@ also Forth definitions
 [IFDEF] asm-include asm-include [THEN]
 
 previous
+hex
 
 >CROSS
 
@@ -245,6 +246,7 @@ VARIABLE VocTemp
 : <T  get-current VocTemp ! also Ghosts definitions ;
 : T>  previous VocTemp @ set-current ;
 
+hex
 4711 Constant <fwd>             4712 Constant <res>
 4713 Constant <imm>             4714 Constant <do:>
 
@@ -444,6 +446,9 @@ Defer skip? ' false IS skip?
     ghost dup >magic @ <fwd> =
     IF  >link @ 0<>  ELSE  drop false  THEN ;
 
+: doer? ( -- flag ) \ name
+    ghost >magic @ <do:> = ;
+
 : skip-defs ( -- )
     BEGIN  refill  WHILE  source -trailing nip 0= UNTIL  THEN ;
 
@@ -525,6 +530,7 @@ ghost (does>)   ghost noop
 ghost (.")      ghost (S")      ghost (ABORT")  2drop drop
 ghost '                                         drop
 ghost :docol    ghost :doesjump ghost :dodoes   2drop drop
+ghost over      ghost =         ghost drop      2drop drop
 
 \ compile                                              10may93jaw
 
@@ -539,7 +545,7 @@ ghost :docol    ghost :doesjump ghost :d
 \ generic threading modell
 : docol,  ( -- ) compile :docol T 0 , H ;
 
-: dodoes, ( -- ) compile :doesjump T 0 , H ;
+: dodoes, ( -- ) T cfalign H compile :doesjump T 0 , H ;
 
 [IFUNDEF] (code) 
 Defer (code)
@@ -549,7 +555,9 @@ Defer (end-code)
 >TARGET
 : Code
     (THeader there resolve
-    there 2 T cells H + T a, 0 , H
+    [ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF]
+	there 2 T cells H + T a, 0 , H
+    [THEN]
     depth (code) ;
 
 : Code:
@@ -644,7 +652,7 @@ Cond: MAXI
   docol, depth T ] H ;
 
 : :noname ( -- colon-sys )
-  T align H there docol, depth T ] H ;
+  T cfalign H there docol, depth T ] H ;
 
 Cond: EXIT ( -- )  restrict?  compile ;S  ;Cond
 
@@ -665,7 +673,7 @@ Cond: [  restrict? state off ;Cond
 
 >TARGET
 Cond: DOES> restrict?
-        compile (does>) dodoes, tdoes @ ?dup IF  @ T here H resolve THEN
+	compile (does>) dodoes, tdoes @ ?dup IF  @ T here H resolve THEN
         ;Cond
 : DOES> dodoes, T here H !does depth T ] H ;
 
@@ -760,24 +768,28 @@ Build: T 0 au, , H ;
 by User
 Builder AUser
 
-Build:  ( n -- ) T , H ;
+Build:  ( n -- ) ;
 by: :docon ( ghost -- n ) T @ H ;DO
+Builder (Constant)
+
+Build:  ( n -- ) T , H ;
+by (Constant)
 Builder Constant
 
 Build:  ( n -- ) T A, H ;
-by Constant
+by (Constant)
 Builder AConstant
 
 Build:  ( d -- ) T , , H ;
 DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO
 Builder 2Constant
 
-Build: T 0 , H ;
-by Constant
+Build: T , H ;
+by (Constant)
 Builder Value
 
-Build: T 0 A, H ;
-by Constant
+Build: T A, H ;
+by (Constant)
 Builder AValue
 
 Build:  ( -- ) compile noop ;
@@ -796,9 +808,13 @@ Builder interpret/compile:
  1- tuck +  swap invert and ;
 >TARGET
 
+Build: ;
+by: :dofield T @ H + ;DO
+Builder (Field)
+
 Build: 	>r rot r@ nalign  dup T , H  ( align1 size offset )
 	+ swap r> nalign ;
-by: :dofield T @ H + ;DO
+by (Field)
 Builder Field
 
 : struct  T 0 1 chars H ;
@@ -853,6 +869,12 @@ Cond: AGAIN     restrict? sys? compile b
 Cond: UNTIL     restrict? sys? compile ?branch <resolve ;Cond
 Cond: REPEAT    restrict? over 0= ?struc compile AGAIN compile THEN ;Cond
 
+Cond: CASE      restrict? 0 ;Cond
+Cond: OF        restrict? 1+ >r compile over compile = compile IF compile drop
+                r> ;Cond
+Cond: ENDOF     restrict? >r compile ELSE r> ;Cond
+Cond: ENDCASE   restrict? compile drop 0 ?DO  compile THEN  LOOP ;Cond
+
 \ Structural Conditionals                              12dec92py
 
 Cond: DO        restrict? compile (do)   T here H ;Cond
@@ -920,6 +942,8 @@ also minimal
 \ define new [IFDEF] and [IFUNDEF]                      20may93jaw
 
 : defined? defined? ;
+: needed? needed? ;
+: doer? doer? ;
 
 : [IFDEF] defined? postpone [IF] ;
 : [IFUNDEF] defined? 0= postpone [IF] ;
@@ -1018,6 +1042,7 @@ mach-file count included
 : undef-words  ['] defined? IS skip? ;
 
 : \  postpone \ ;  immediate
+: \G T-\G ; immediate
 : (  postpone ( ;  immediate
 : include bl word count included ;
 : .( [char] ) parse type ;