Image starts at $100 for cross-compilation now. A NULL-reference

is really a reference to address 0 and NIL is 0.
In the kernel image-header to get the headers address.
Image loading is only changed minimal: The stuff with fixed
addressed images is thrown out, because every image is relocatable.
No header change. Old images should work.

cross.fs

@@ -1142,8 +1142,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 +1227,10 @@ Variable mirrored-link          \ linked list for mirrored regions
 : >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 +1244,7 @@ Variable mirrored-link          \ linked list for mirrored regions
 	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 +1362,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 ;
@@ -3004,7 +3013,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 +3029,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

engine/main.c

@@ -126,14 +126,16 @@ int gforth_memcmp(const char * s1, const char * s2, size_t n)
  * If the word is <CF(DOESJUMP), it's a primitive
  */
 
-void relocate(Cell *image, const char *bitstring, int size, Label symbols[])
+void relocate(Cell *image, const char *bitstring, int size, int base, Label symbols[])
 {
   int i=0, j, k, steps=(size/sizeof(Cell))/RELINFOBITS;
   Cell token;
   char bits;
   Cell max_symbols;
+  /** A virtial start address that's the real start address minus the one in the image */
+  Cell *start = (Cell * ) (((void *) image) - ((void *) base));
 
-/*  printf("relocating %x[%x]\n", image, size); */
+  /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */
   
   for (max_symbols=DOESJUMP+1; symbols[max_symbols]!=0; max_symbols++)
     ;
@@ -144,7 +146,8 @@ void relocate(Cell *image, const char *bitstring, int size, Label symbols[])
       /*      fprintf(stderr,"relocate: image[%d]\n", i);*/
       if((i < size) && (bits & (1U << (RELINFOBITS-1)))) {
 	/* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */
-	if((token=image[i])<0)
+        token=image[i];
+	if(token<0)
 	  switch(token)
 	    {
 	    case CF_NIL      : image[i]=0; break;
@@ -158,7 +161,7 @@ void relocate(Cell *image, const char *bitstring, int size, Label symbols[])
 	    case CF(DOESJUMP): MAKE_DOES_HANDLER(image+i); break;
 #endif /* !defined(DOUBLY_INDIRECT) */
 	    case CF(DODOES)  :
-	      MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)image)));
+	      MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start)));
 	      break;
 	    default          :
 /*	      printf("Code field generation image[%x]:=CA(%x)\n",
@@ -169,7 +172,10 @@ void relocate(Cell *image, const char *bitstring, int size, Label symbols[])
 		fprintf(stderr,"Primitive %d used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n",CF(token),(long)&image[i],VERSION);
 	    }
 	else
-	  image[i]+=(Cell)image;
+          // if base is > 0: 0 is a null reference so don't adjust
+          if (token>=base) {
+            image[i]+=(Cell)start;
+          }
       }
     }
   }
@@ -493,12 +499,12 @@ Address loader(FILE *imagefile, char* filename)
   imp=image+preamblesize;
   if (clear_dictionary)
     memset(imp+header.image_size, 0, dictsize-header.image_size);
-  if(header.base==0) {
+  {
     Cell reloc_size=((header.image_size-1)/sizeof(Cell))/8+1;
     char reloc_bits[reloc_size];
     fseek(imagefile, preamblesize+header.image_size, SEEK_SET);
     fread(reloc_bits, 1, reloc_size, imagefile);
-    relocate((Cell *)imp, reloc_bits, header.image_size, vm_prims);
+    relocate((Cell *)imp, reloc_bits, header.image_size, header.base, vm_prims);
 #if 0
     { /* let's see what the relocator did */
       FILE *snapshot=fopen("snapshot.fi","wb");
@@ -507,11 +513,6 @@ Address loader(FILE *imagefile, char* filename)
     }
 #endif
   }
-  else if(header.base!=imp) {
-    fprintf(stderr,"%s: Cannot load nonrelocatable image (compiled for address $%lx) at address $%lx\n",
-	    progname, (unsigned long)header.base, (unsigned long)imp);
-    exit(1);
-  }
   if (header.checksum==0)
     ((ImageHeader *)imp)->checksum=check_sum;
   else if (header.checksum != check_sum) {

kernel/basics.fs

@@ -67,7 +67,7 @@ unlock ram-dictionary borders nip lock
 AConstant dictionary-end
 [ELSE]
 : dictionary-end ( -- addr )
-    forthstart [ 3 cells ] Aliteral @ + ;
+    forthstart [ 3 cells image-header + ] Aliteral @ + ;
 [THEN]
 
 : usable-dictionary-end ( -- addr )
@@ -221,7 +221,7 @@ defer throw ( y1 .. ym nerror -- y1 .. ym / z1 .. zn error ) \ exception
 
 :noname ( y1 .. ym error -- y1 .. ym / z1 .. zn error )
     ?dup if
-	[ has? ec 0= [IF] here forthstart 9 cells + ! [THEN] ]
+	[ has? ec 0= [IF] here image-header 9 cells + ! [THEN] ]
 	cr .error cr
 	[ has? file [IF] ] script? IF  1 (bye)  ELSE  quit  THEN
 	[ [ELSE] ] quit [ [THEN] ]

kernel/main.fs

@@ -57,13 +57,15 @@ include ./../cross.fs              \ cross-compiler
 
 decimal
 
-has? kernel-size makekernel ( size )
+has? kernel-size makekernel
 \ create image-header
 has? header [IF]
-    0 A,                \ base address
+here dup 
+    A,                  \ base address
     0 ,                 \ checksum
     0 ,                 \ image size (without tags)
-    >address ,          \ dict size
+has? kernel-size
+    ,                   \ dict size
     has? stack-size ,   \ data stack size
     has? fstack-size ,  \ FP stack size
     has? rstack-size ,  \ return stack size
@@ -76,6 +78,8 @@ has? header [IF]
     0 ,                 \ fp stack base
     0 ,                 \ return stack base
     0 ,                 \ locals stack base
+AConstant image-header
+: forthstart image-header @ ;
 [THEN]
 
 UNLOCK ghost - drop \ need a ghost otherwise "-" would be treated as a number
@@ -92,7 +96,7 @@ has? prims [IF]
 [THEN]
 doc-on
 
-0 AConstant forthstart
+\ 0 AConstant forthstart
 
 \ include ./vars.fs                  \ variables and other stuff
 \ include kernel/version.fs          \ is in $(build)/kernel
@@ -126,8 +130,8 @@ include ./getdoers.fs
 
 has? header [IF]
     \    UNLOCK
-    here >address 2 cells  !         \ image size
-    ' boot >body  8 cells A!         \ image entry point
+    here image-header 2 cells + !         \ image size
+    ' boot >body  image-header 8 cells + A!         \ image entry point
     \    LOCK
 [ELSE]
     >boot

machpc.fs

@@ -18,10 +18,11 @@
 \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 
-true DefaultValue NIL  \ relocating
 
 >ENVIRON
 
+true DefaultValue relocate
+
 true DefaultValue file		\ controls the presence of the
 				\ file access wordset
 true DefaultValue OS		\ flag to indicate a operating system