Commit f102f886 authored by jwilke's avatar jwilke

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.
parent 3527351f
......@@ -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
......
......@@ -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) {
......
......@@ -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] ]
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment