| * If the word is <CF(DOESJUMP) and bit 14 is set, it's the xt of a primitive |
* If the word is <CF(DOESJUMP) and bit 14 is set, it's the xt of a primitive |
| * If the word is <CF(DOESJUMP) and bit 14 is clear, |
* If the word is <CF(DOESJUMP) and bit 14 is clear, |
| * it's the threaded code of a primitive |
* it's the threaded code of a primitive |
| |
* bits 13..9 of a primitive token state which group the primitive belongs to, |
| |
* bits 8..0 of a primitive token index into the group |
| */ |
*/ |
| |
|
| |
static Cell groups[32] = { |
| |
0, |
| |
#define INST_ADDR(name) |
| |
#define GROUP(x, n) DOESJUMP+1+n, |
| |
#include "prim_lab.i" |
| |
#define GROUP(x, n) |
| |
}; |
| |
|
| void relocate(Cell *image, const char *bitstring, |
void relocate(Cell *image, const char *bitstring, |
| int size, int base, Label symbols[]) |
int size, int base, Label symbols[]) |
| { |
{ |
| char bits; |
char bits; |
| Cell max_symbols; |
Cell max_symbols; |
| /* |
/* |
| * A virtial start address that's the real start address minus |
* A virtual start address that's the real start address minus |
| * the one in the image |
* the one in the image |
| */ |
*/ |
| Cell *start = (Cell * ) (((void *) image) - ((void *) base)); |
Cell *start = (Cell * ) (((void *) image) - ((void *) base)); |
| |
|
| |
/* group index into table */ |
| |
|
| /* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */ |
/* printf("relocating to %x[%x] start=%x base=%x\n", image, size, start, base); */ |
| |
|
| if((i < size) && (bits & (1U << (RELINFOBITS-1)))) { |
if((i < size) && (bits & (1U << (RELINFOBITS-1)))) { |
| /* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */ |
/* fprintf(stderr,"relocate: image[%d]=%d of %d\n", i, image[i], size/sizeof(Cell)); */ |
| token=image[i]; |
token=image[i]; |
| if(token<0) |
if(token<0) { |
| switch(token|0x4000) |
int group = (-token & 0x3E00) >> 9; |
| { |
if(group == 0) { |
| |
switch(token|0x4000) { |
| case CF_NIL : image[i]=0; break; |
case CF_NIL : image[i]=0; break; |
| #if !defined(DOUBLY_INDIRECT) |
#if !defined(DOUBLY_INDIRECT) |
| case CF(DOCOL) : |
case CF(DOCOL) : |
| case CF(DODOES) : |
case CF(DODOES) : |
| MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start))); |
MAKE_DOES_CF(image+i,(Xt *)(image[i+1]+((Cell)start))); |
| break; |
break; |
| default : |
default : /* backward compatibility */ |
| /* printf("Code field generation image[%x]:=CFA(%x)\n", |
/* printf("Code field generation image[%x]:=CFA(%x)\n", |
| i, CF(image[i])); */ |
i, CF(image[i])); */ |
| if (CF((token | 0x4000))<max_symbols) { |
if (CF((token | 0x4000))<max_symbols) { |
| } else |
} else |
| 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],PACKAGE_VERSION); |
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],PACKAGE_VERSION); |
| } |
} |
| else { |
} else { |
| |
int tok = -token & 0x1FF; |
| |
if (tok < (groups[group+1]-groups[group])) { |
| |
#if defined(DOUBLY_INDIRECT) |
| |
image[i]=(Cell)CFA(((groups[group]+tok) | (CF(token) & 0x4000))); |
| |
#else |
| |
image[i]=(Cell)CFA((groups[group]+tok)); |
| |
#endif |
| |
#ifdef DIRECT_THREADED |
| |
if ((token & 0x4000) == 0) /* threade code, no CFA */ |
| |
compile_prim1(&image[i]); |
| |
#endif |
| |
} else |
| |
fprintf(stderr,"Primitive %x, %d of group %d used in this image at $%lx is not implemented by this\n engine (%s); executing this code will crash.\n", -token, tok, group, (long)&image[i],PACKAGE_VERSION); |
| |
} |
| |
} else { |
| // if base is > 0: 0 is a null reference so don't adjust |
// if base is > 0: 0 is a null reference so don't adjust |
| if (token>=base) { |
if (token>=base) { |
| image[i]+=(Cell)start; |
image[i]+=(Cell)start; |
