--- gforth/cross.fs	2001/09/06 08:14:16	1.111
+++ gforth/cross.fs	2001/11/11 22:33:31	1.116
@@ -202,6 +202,13 @@ Create bases   10 ,   2 ,   A , 100 ,
 
 [THEN]
 
+\ this provides assert( and struct stuff
+\GFORTH [IFUNDEF] assert1(
+\GFORTH also forth definitions require assert.fs previous
+\GFORTH [THEN]
+
+>CROSS
+
 hex     \ the defualt base for the cross-compiler is hex !!
 \ Warnings off
 
@@ -1007,10 +1014,13 @@ Variable reuse-ghosts reuse-ghosts off
 
 \ ' >ghostname ALIAS @name
 
+: findghost ( "ghostname" -- ghost ) 
+  bl word gfind 0= ABORT" CROSS: Ghost don't exists" ;
+
 : [G'] ( -- ghost : name )
 \G ticks a ghost and returns its address
-\  bl word gfind 0= ABORT" CROSS: Ghost don't exists"
-  ghost state @ IF postpone literal THEN ; immediate
+  findghost
+  state @ IF postpone literal THEN ; immediate
 
 : g>xt ( ghost -- xt )
 \G Returns the xt (cfa) of a ghost. Issues a warning if undefined.
@@ -1043,6 +1053,8 @@ End-Struct addr-struct
 
 \ Predefined ghosts                                    12dec92py
 
+Ghost - drop \ need a ghost otherwise "-" would be treated as a number
+
 Ghost 0=                                        drop
 Ghost branch    Ghost ?branch                   2drop
 Ghost (do)      Ghost (?do)                     2drop
@@ -1057,11 +1069,17 @@ Ghost '
 Ghost :docol    Ghost :doesjump Ghost :dodoes   2drop drop
 Ghost :dovar					drop
 Ghost over      Ghost =         Ghost drop      2drop drop
-Ghost - drop
 Ghost 2drop drop
 Ghost 2dup drop
-
-
+Ghost state drop
+Ghost call drop
+Ghost @ drop
+Ghost useraddr drop
+Ghost execute drop
+Ghost + drop
+Ghost (C") drop
+Ghost decimal drop
+Ghost hex drop
 
 \ \ Parameter for target systems                         06oct92py
 
@@ -1142,8 +1160,11 @@ true DefaultValue standardthreading
 s" relocate" T environment? H 
 \ JAW why set NIL to this?!
 [IF]	drop \ SetValue NIL
-[ELSE]	>ENVIRON T NIL H SetValue relocate
+[ELSE]	>ENVIRON X NIL SetValue relocate
 [THEN]
+>TARGET
+
+0 Constant NIL
 
 >CROSS
 
@@ -1224,6 +1245,10 @@ Variable mirrored-link          \ linked
 : >rlen cell+ ;
 : >rstart ;
 
+: (region) ( addr len region -- )
+\G change startaddress and length of an existing region
+  >r r@ last-defined-region !
+  r@ >rlen ! dup r@ >rstart ! r> >rdp ! ;
 
 : region ( addr len -- )                
 \G create a new region
@@ -1237,8 +1262,7 @@ Variable mirrored-link          \ linked
 	region-link linked 0 , 0 , 0 , bl word count string,
   ELSE	\ store new parameters in region
         bl word drop
-	>body >r r@ last-defined-region !
-	r@ >rlen ! dup r@ >rstart ! r> >rdp !
+	>body (region)
   THEN ;
 
 : borders ( region -- startaddr endaddr ) 
@@ -1356,8 +1380,11 @@ T has? rom H
 
 \ MakeKernel                                           		22feb99jaw
 
-: makekernel ( targetsize -- targetsize )
-  dup dictionary >rlen ! setup-target ;
+: makekernel ( targetsize -- )
+\G convenience word to setup the memory of the target
+\G used by main.fs of the c-engine based systems
+  100 swap dictionary (region)
+  setup-target ;
 
 >MINIMAL
 : makekernel makekernel ;
@@ -1937,11 +1964,13 @@ Variable to-doc  to-doc on
 \ Target TAGS creation
 
 s" kernel.TAGS" r/w create-file throw value tag-file-id
+s" kernel.tags" r/w create-file throw value vi-tag-file-id
 \ contains the file-id of the tags file
 
 Create tag-beg 2 c,  7F c, bl c,
 Create tag-end 2 c,  bl c, 01 c,
 Create tag-bof 1 c,  0C c,
+Create tag-tab 1 c,  09 c,
 
 2variable last-loadfilename 0 0 last-loadfilename 2!
 	    
@@ -1955,13 +1984,13 @@ Create tag-bof 1 c,  0C c,
 	s" ,0" tag-file-id write-line throw
     THEN ;
 
-: cross-tag-entry  ( -- )
+: cross-gnu-tag-entry  ( -- )
     tlast @ 0<>	\ not an anonymous (i.e. noname) header
     IF
 	put-load-file-name
 	source >in @ min tag-file-id write-file throw
 	tag-beg count tag-file-id write-file throw
-	tlast @ >image count 1F and tag-file-id write-file throw
+	Last-Header-Ghost @ >ghostname tag-file-id write-file throw
 	tag-end count tag-file-id write-file throw
 	base @ decimal sourceline# 0 <# #s #> tag-file-id write-file throw
 \	>in @ 0 <# #s [char] , hold #> tag-file-id write-line throw
@@ -1969,6 +1998,22 @@ Create tag-bof 1 c,  0C c,
 	base !
     THEN ;
 
+: cross-vi-tag-entry ( -- )
+    tlast @ 0<>	\ not an anonymous (i.e. noname) header
+    IF
+	sourcefilename vi-tag-file-id write-file throw
+	tag-tab count vi-tag-file-id write-file throw
+	Last-Header-Ghost @ >ghostname vi-tag-file-id write-file throw
+	tag-tab count vi-tag-file-id write-file throw
+	s" /^" vi-tag-file-id write-file throw
+	source vi-tag-file-id write-file throw
+	s" $/" vi-tag-file-id write-line throw
+    THEN ;
+
+: cross-tag-entry ( -- )
+    cross-gnu-tag-entry
+    cross-vi-tag-entry ;
+
 \ Check for words
 
 Defer skip? ' false IS skip?
@@ -2102,12 +2147,12 @@ Variable last-prim-ghost
 
 Defer setup-prim-semantics
 
-: aprim   ( -- ) 
+: mapprim   ( "forthname" "asmlabel" -- ) 
   THeader -1 aprim-nr +! aprim-nr @ T A, H
   asmprimname, 
   setup-prim-semantics ;
 
-: aprim:   ( -- ) 
+: mapprim:   ( "forthname" "asmlabel" -- ) 
   -1 aprim-nr +! aprim-nr @
   Ghost tuck swap resolve <do:> swap tuck >magic !
   asmprimname, ;
@@ -2167,8 +2212,7 @@ Comment (       Comment \
 \ compile                                              10may93jaw
 
 : compile  ( "name" -- ) \ name
-\  bl word gfind 0= ABORT" CROSS: Can't compile "
-  ghost
+  findghost
   dup >exec-compile @ ?dup
   IF    nip compile,
   ELSE  postpone literal postpone gexecute  THEN ;  immediate restrict
@@ -2190,7 +2234,8 @@ Cond: [']  T ' H alit, ;Cond
 
 : [T']
 \ returns the target-cfa of a ghost, or compiles it as literal
-  postpone [G'] state @ IF postpone g>xt ELSE g>xt THEN ; immediate
+  postpone [G'] 
+  state @ IF postpone g>xt ELSE g>xt THEN ; immediate
 
 \ \ threading modell					13dec92py
 \ modularized						14jun97jaw
@@ -2315,6 +2360,7 @@ Cond: MAXI
  ;Cond
 
 >CROSS
+
 \ Target compiling loop                                12dec92py
 \ ">tib trick thrown out                               10may93jaw
 \ number? defined at the top                           11may93jaw
@@ -2335,10 +2381,11 @@ Cond: MAXI
   IF	0> IF swap lit,  THEN  lit, discard
   ELSE	2drop restore-input throw Ghost gexecute THEN  ;
 
->TARGET
 \ : ; DOES>                                            13dec92py
 \ ]                                                     9may93py/jaw
 
+>CROSS
+
 : compiling-state ( -- )
 \G set states to compililng
     Compiling comp-state !
@@ -2353,6 +2400,8 @@ Cond: MAXI
    IF >ghost-xt @ execute X off ELSE drop THEN
    Interpreting comp-state ! ;
 
+>TARGET
+
 : ] 
     compiling-state
     BEGIN
@@ -3004,7 +3053,7 @@ magic 7 + c!
 : save-cross ( "image-name" "binary-name" -- )
   bl parse ." Saving to " 2dup type cr
   w/o bin create-file throw >r
-  TNIL IF
+  s" header" X $has? IF
       s" #! "           r@ write-file throw
       bl parse          r@ write-file throw
       s"  --image-file" r@ write-file throw
@@ -3020,7 +3069,7 @@ magic 7 + c!
   THEN
   image @ there 
   r@ write-file throw \ write image
-  TNIL IF
+  s" relocate" X $has? IF
       bit$  @ there 1- tcell>bit rshift 1+
                 r@ write-file throw \ write tags
   THEN
@@ -3507,6 +3556,3 @@ UNLOCK >CROSS
 [IFDEF] extend-cross extend-cross [THEN]
 
 LOCK
-
-
-