--- gforth/cross.fs	1999/02/22 18:27:22	1.71
+++ gforth/cross.fs	1999/05/05 18:07:51	1.74
@@ -58,7 +58,7 @@ Warnings off
 	\ we have to set current to be topmost context wordlist
 	get-order get-order get-current swap 1+ set-order
 	r> ['] to execute
-	set-order order
+	set-order
   ELSE Value THEN ;
 
 : DefaultValue ( n -- <name> )
@@ -118,8 +118,9 @@ also forth definitions  \ these values m
 false DefaultValue stack-warn   	 \ check on empty stack at any definition
 false DefaultValue create-forward-warn   \ warn on forward declaration of created words
 
-[IFUNDEF] DebugMaskSrouce Variable DebugMaskSource 0 DebugMaskSource ! [THEN]
-[IFUNDEF] DebugMaskCross  Variable DebugMaskCross  0 DebugMaskCross  ! [THEN]
+
+
+  
 
 previous >CROSS
 
@@ -143,7 +144,46 @@ stack-warn [IF]
 : defempty? ; immediate
 [THEN]
 
+\ debugging
+
+0 [IF]
+
+This implements debugflags for the cross compiler and the compiled
+images. It works identical to the has-flags in the environment.
+The debugflags are defined in a vocabluary. If the word exists and
+its value is true, the flag is switched on.
+
+[THEN]
 
+Vocabulary debugflags	\ debug flags for cross
+also debugflags get-order over
+Constant debugflags-wl
+set-order previous
+
+: DebugFlag
+  get-current >r debugflags-wl set-current
+  SetValue
+  r> set-current ;
+
+: Debug? ( adr u -- flag )
+\G return true if debug flag is defined or switched on
+  debugflags-wl search-wordlist
+  IF EXECUTE
+  ELSE false THEN ;
+
+: D? ( <name> -- flag )
+\G return true if debug flag is defined or switched on
+\G while compiling we do not return the current value but
+  bl word count debug? ;
+
+: [d?]
+\G compile the value-xt so the debug flag can be switched
+\G the flag must exist!
+  bl word count debugflags-wl search-wordlist
+  IF 	compile,
+  ELSE  -1 ABORT" unknown debug flag"
+	\ POSTPONE false 
+  THEN ; immediate
 
 \ \ GhostNames Ghosts                                  9may93jaw
 
@@ -315,6 +355,7 @@ false DefaultValue header
 true DefaultValue interpreter
 true DefaultValue ITC
 false DefaultValue rom
+true DefaultValue standardthreading
 
 >TARGET
 s" relocate" T environment? H 
@@ -377,30 +418,6 @@ Variable bit$
 Variable headers-named 0 headers-named !
 Variable user-vars 0 user-vars !
 
-\ Memory initialisation                                05dec92py
-
-[IFDEF] Memory \ Memory is a bigFORTH feature
-   also Memory
-   : initmem ( var len -- )
-     2dup swap handle! >r @ r> erase ;
-   toss
-[ELSE]
-   : initmem ( var len -- )
-     tuck allocate abort" CROSS: No memory for target"
-     ( len var adr ) dup rot !
-     ( len adr ) swap erase ;
-[THEN]
-
-\ MakeKernal                                           12dec92py
-
-: makekernel ( targetsize -- targetsize )
-  bit$  over 1- tcell>bit rshift 1+ initmem
-  image over initmem ;
-
->MINIMAL
-: makekernel makekernel ;
->CROSS
-
 : target>bitmask-size ( u1 -- u2 )
   1- tcell>bit rshift 1+ ;
 
@@ -408,8 +425,6 @@ Variable user-vars 0 user-vars !
   dup allocate ABORT" CROSS: No memory for target"
   swap over swap erase ;
 
-
-
 \ \ memregion.fs
 
 
@@ -515,10 +530,10 @@ T has? rom H
 : setup-target ( -- )   \G initialize targets memory space
   s" rom" T $has? H
   IF  \ check for ram and rom...
-      address-space area nip 0<>
+      \ address-space area nip 0<>
       ram-dictionary area nip 0<>
       rom-dictionary area nip 0<>
-      and and 0=
+      and 0=
       ABORT" CROSS: define address-space, rom- , ram-dictionary, with rom-support!"
   THEN
   address-space area nip
@@ -543,12 +558,20 @@ T has? rom H
                 r@ >rmem !
 
                 target>bitmask-size allocatetarget
-                dup
-                bit$ !
+                dup bit$ !
                 r> >rbm !
 
         ELSE    r> drop THEN
-   REPEAT ;
+   REPEAT drop ;
+
+\ MakeKernal                                           		22feb99jaw
+
+: makekernel ( targetsize -- targetsize )
+  dup dictionary >rlen ! setup-target ;
+
+>MINIMAL
+: makekernel makekernel ;
+>CROSS
 
 \ \ switched tdp for rom support				03jun97jaw
 
@@ -765,7 +788,7 @@ T has? relocate H
 \ \ Load Assembler
 
 >TARGET
-H also Forth definitions \ ." asm: " order
+H also Forth definitions
 
 : X 	also target bl word find
 	IF	state @ IF compile,
@@ -883,8 +906,11 @@ Create NoFile ," #load-file#"
 	REPEAT
 	2drop drop false ;	
 
+false DebugFlag showincludedfiles
+
 : included 
-\	cr ." Including: " 2dup type ." ..."
+	[d?] showincludedfiles
+	IF	cr ." Including: " 2dup type ." ..." THEN
 	FileMem >r
 	2dup add-included-file included 
 	r> to FileMem ;
@@ -2037,8 +2063,10 @@ Cond: [IFUNDEF] postpone [IFUNDEF] ;Cond
 
 also minimal
 
-\G doesn't skip line when bit is set in debugmask
-: \D name evaluate debugmasksource @ and 0= IF postpone \ THEN ;
+: d? d? ;
+
+\G doesn't skip line when debug switch is on
+: \D D? 0= IF postpone \ THEN ;
 
 \G interprets the line if word is not defined
 : \- defined? IF postpone \ THEN ;
@@ -2208,7 +2236,7 @@ minimal
 \ these ones are pefered:
 
 : lock   turnkey ;
-: unlock forth also cross ;
+: unlock previous forth also cross ;
 
 : [[ also unlock ;
 : ]] previous previous ;