version 1.69, 2002/11/10 11:24:08
|
version 1.70, 2002/11/24 13:54:01
|
Line 193 void relocate(Cell *image, const char *b
|
Line 193 void relocate(Cell *image, const char *b
|
image[i]=(Cell)CFA(CF(token)); |
image[i]=(Cell)CFA(CF(token)); |
#ifdef DIRECT_THREADED |
#ifdef DIRECT_THREADED |
if ((token & 0x4000) == 0) /* threade code, no CFA */ |
if ((token & 0x4000) == 0) /* threade code, no CFA */ |
image[i] = (Cell)compile_prim((Label)image[i]); |
compile_prim1(&image[i]); |
#endif |
#endif |
} 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],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],VERSION); |
Line 207 void relocate(Cell *image, const char *b
|
Line 207 void relocate(Cell *image, const char *b
|
} |
} |
} |
} |
} |
} |
|
finish_code(); |
((ImageHeader*)(image))->base = (Address) image; |
((ImageHeader*)(image))->base = (Address) image; |
} |
} |
|
|
Line 441 void print_sizes(Cell sizebyte)
|
Line 442 void print_sizes(Cell sizebyte)
|
1 << ((sizebyte >> 5) & 3)); |
1 << ((sizebyte >> 5) & 3)); |
} |
} |
|
|
|
#define MAX_IMMARGS 2 |
|
|
#ifndef NO_DYNAMIC |
#ifndef NO_DYNAMIC |
typedef struct { |
typedef struct { |
Label start; |
Label start; |
Cell length; /* excluding the jump */ |
Cell length; /* excluding the jump */ |
char super_end; /* true if primitive ends superinstruction, i.e., |
char superend; /* true if primitive ends superinstruction, i.e., |
unconditional branch, execute, etc. */ |
unconditional branch, execute, etc. */ |
|
Cell nimmargs; |
|
struct immarg { |
|
Cell offset; /* offset of immarg within prim */ |
|
char rel; /* true if immarg is relative */ |
|
} immargs[MAX_IMMARGS]; |
} PrimInfo; |
} PrimInfo; |
|
|
PrimInfo *priminfos; |
PrimInfo *priminfos; |
#endif /* defined(NO_DYNAMIC) */ |
#endif /* defined(NO_DYNAMIC) */ |
Cell npriminfos=0; |
Cell npriminfos=0; |
|
|
|
|
void check_prims(Label symbols1[]) |
void check_prims(Label symbols1[]) |
{ |
{ |
int i; |
int i; |
Label *symbols2; |
Label *symbols2, *symbols3, *ends1; |
static char superend[]={ |
static char superend[]={ |
#include "prim_superend.i" |
#include "prim_superend.i" |
}; |
}; |
Line 473 void check_prims(Label symbols1[])
|
Line 480 void check_prims(Label symbols1[])
|
for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) |
for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) |
; |
; |
npriminfos = i; |
npriminfos = i; |
|
|
#if defined(IS_NEXT_JUMP) && !defined(NO_DYNAMIC) |
#ifndef NO_DYNAMIC |
if (no_dynamic) |
if (no_dynamic) |
return; |
return; |
symbols2=engine2(0,0,0,0,0); |
symbols2=engine2(0,0,0,0,0); |
|
#if NO_IP |
|
symbols3=engine3(0,0,0,0,0); |
|
#else |
|
symbols3=symbols1; |
|
#endif |
|
ends1 = symbols1+i+1-DOESJUMP; |
priminfos = calloc(i,sizeof(PrimInfo)); |
priminfos = calloc(i,sizeof(PrimInfo)); |
for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) { |
for (i=DOESJUMP+1; symbols1[i+1]!=0; i++) { |
int prim_len=symbols1[i+1]-symbols1[i]; |
int prim_len = ends1[i]-symbols1[i]; |
PrimInfo *pi=&priminfos[i]; |
PrimInfo *pi=&priminfos[i]; |
int j; |
int j=0; |
pi->super_end = superend[i-DOESJUMP-1]|no_super; |
char *s1 = (char *)symbols1[i]; |
for (j=prim_len-IND_JUMP_LENGTH; ; j--) { |
char *s2 = (char *)symbols2[i]; |
if (IS_NEXT_JUMP(symbols1[i]+j)) { |
char *s3 = (char *)symbols3[i]; |
prim_len = j; |
|
if (pi->super_end) |
pi->start = s1; |
prim_len += IND_JUMP_LENGTH; /* include the jump */ |
pi->superend = superend[i-DOESJUMP-1]|no_super; |
break; |
if (pi->superend) |
} |
pi->length = symbols1[i+1]-symbols1[i]; |
if (j==0) { /* NEXT jump not found, e.g., execute */ |
else |
if (!pi->super_end && debug) |
pi->length = prim_len; |
fprintf(stderr, "NEXT jump not found for primitive %d, making it super_end\n", i); |
pi->nimmargs = 0; |
pi->super_end = 1; |
if (debug) |
break; |
fprintf(stderr, "Prim %3d @ %p %p %p, length=%3d superend=%1d", |
|
i, s1, s2, s3, prim_len, pi->superend); |
|
assert(prim_len>=0); |
|
while (j<prim_len) { |
|
if (s1[j]==s3[j]) { |
|
if (s1[j] != s2[j]) { |
|
pi->start = NULL; /* not relocatable */ |
|
if (debug) |
|
fprintf(stderr,"\n non_reloc: engine1!=engine2 offset %3d",j); |
|
break; |
|
} |
|
j++; |
|
} else { |
|
struct immarg *ia=&pi->immargs[pi->nimmargs]; |
|
|
|
pi->nimmargs++; |
|
ia->offset=j; |
|
if ((~*(Cell *)&(s1[j]))==*(Cell *)&(s3[j])) { |
|
ia->rel=0; |
|
if (debug) |
|
fprintf(stderr,"\n absolute immarg: offset %3d",j); |
|
} else if ((&(s1[j]))+(*(Cell *)&(s1[j]))+4 == |
|
symbols1[DOESJUMP+1]) { |
|
ia->rel=1; |
|
if (debug) |
|
fprintf(stderr,"\n relative immarg: offset %3d",j); |
|
} else { |
|
pi->start = NULL; /* not relocatable */ |
|
if (debug) |
|
fprintf(stderr,"\n non_reloc: engine1!=engine3 offset %3d",j); |
|
break; |
|
} |
|
j+=4; |
} |
} |
} |
} |
pi->length = prim_len; |
if (debug) |
/* fprintf(stderr,"checking primitive %d: memcmp(%p, %p, %d)\n", |
fprintf(stderr,"\n"); |
i, symbols1[i], symbols2[i], prim_len);*/ |
} |
if (memcmp(symbols1[i],symbols2[i],prim_len)!=0) { |
|
if (debug) |
|
fprintf(stderr,"Primitive %d not relocatable: memcmp(%p, %p, %d)\n", |
|
i, symbols1[i], symbols2[i], prim_len); |
|
} else { |
|
pi->start = symbols1[i]; |
|
if (debug) |
|
fprintf(stderr,"Primitive %d relocatable: start %p, length %ld, super_end %d\n", |
|
i, pi->start, pi->length, pi->super_end); |
|
} |
|
} |
|
#endif |
#endif |
} |
} |
|
|
Label compile_prim(Label prim) |
#ifdef NO_IP |
|
int nbranchinfos=0; |
|
|
|
struct branchinfo { |
|
Label *targetptr; /* *(bi->targetptr) is the target */ |
|
Cell *addressptr; /* store the target here */ |
|
} branchinfos[100000]; |
|
|
|
int ndoesexecinfos=0; |
|
struct doesexecinfo { |
|
int branchinfo; /* fix the targetptr of branchinfos[...->branchinfo] */ |
|
Cell *xt; /* cfa of word whose does-code needs calling */ |
|
} doesexecinfos[10000]; |
|
|
|
#define N_EXECUTE 10 |
|
#define N_PERFORM 11 |
|
#define N_LIT_PERFORM 337 |
|
#define N_CALL 333 |
|
#define N_DOES_EXEC 339 |
|
#define N_LIT 9 |
|
#define N_CALL2 362 |
|
#define N_ABRANCH 341 |
|
#define N_SET_NEXT_CODE 361 |
|
|
|
void set_rel_target(Cell *source, Label target) |
|
{ |
|
*source = ((Cell)target)-(((Cell)source)+4); |
|
} |
|
|
|
void register_branchinfo(Label source, Cell targetptr) |
|
{ |
|
struct branchinfo *bi = &(branchinfos[nbranchinfos]); |
|
bi->targetptr = (Label *)targetptr; |
|
bi->addressptr = (Cell *)source; |
|
nbranchinfos++; |
|
} |
|
|
|
Cell *compile_prim1arg(Cell p) |
|
{ |
|
int l = priminfos[p].length; |
|
Address old_code_here=code_here; |
|
|
|
memcpy(code_here, vm_prims[p], l); |
|
code_here+=l; |
|
return (Cell*)(old_code_here+priminfos[p].immargs[0].offset); |
|
} |
|
|
|
Cell *compile_call2(Cell targetptr) |
|
{ |
|
Cell *next_code_target; |
|
PrimInfo *pi = &priminfos[N_CALL2]; |
|
|
|
memcpy(code_here, pi->start, pi->length); |
|
next_code_target = (Cell *)(code_here + pi->immargs[0].offset); |
|
register_branchinfo(code_here + pi->immargs[1].offset, targetptr); |
|
code_here += pi->length; |
|
return next_code_target; |
|
} |
|
#endif |
|
|
|
void finish_code(void) |
|
{ |
|
#ifdef NO_IP |
|
Cell i; |
|
|
|
compile_prim1(NULL); |
|
for (i=0; i<ndoesexecinfos; i++) { |
|
struct doesexecinfo *dei = &doesexecinfos[i]; |
|
branchinfos[dei->branchinfo].targetptr = DOES_CODE1((dei->xt)); |
|
} |
|
ndoesexecinfos = 0; |
|
for (i=0; i<nbranchinfos; i++) { |
|
struct branchinfo *bi=&branchinfos[i]; |
|
set_rel_target(bi->addressptr, *(bi->targetptr)); |
|
} |
|
nbranchinfos = 0; |
|
FLUSH_ICACHE(start_flush, code_here-start_flush); |
|
start_flush=code_here; |
|
#endif |
|
} |
|
|
|
void compile_prim1(Cell *start) |
{ |
{ |
#if defined(DOUBLY_INDIRECT) |
#if defined(DOUBLY_INDIRECT) |
|
Label prim=(Label)*start; |
if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) { |
if (prim<((Label)(xts+DOESJUMP)) || prim>((Label)(xts+npriminfos))) { |
fprintf(stderr,"compile_prim encountered xt %p\n", prim); |
fprintf(stderr,"compile_prim encountered xt %p\n", prim); |
return prim; |
*start=(Cell)prim; |
} else |
return; |
return prim-((Label)xts)+((Label)vm_prims); |
} else { |
#elif defined(IND_JUMP_LENGTH) && !defined(NO_DYNAMIC) |
*start = prim-((Label)xts)+((Label)vm_prims); |
|
return; |
|
} |
|
#elif defined(NO_IP) |
|
static Cell *last_start=NULL; |
|
static Xt last_prim=NULL; |
|
/* delay work by one call in order to get relocated immargs */ |
|
|
|
if (last_start) { |
|
unsigned i = last_prim-vm_prims; |
|
PrimInfo *pi=&priminfos[i]; |
|
Cell *next_code_target=NULL; |
|
|
|
assert(i<npriminfos); |
|
if (i==N_EXECUTE||i==N_PERFORM||i==N_LIT_PERFORM) { |
|
next_code_target = compile_prim1arg(N_SET_NEXT_CODE); |
|
} |
|
if (i==N_CALL) { |
|
next_code_target = compile_call2(last_start[1]); |
|
} else if (i==N_DOES_EXEC) { |
|
struct doesexecinfo *dei = &doesexecinfos[ndoesexecinfos++]; |
|
*compile_prim1arg(N_LIT) = (Cell)PFA(last_start[1]); |
|
/* we cannot determine the callee now (last_start[1] may be a |
|
forward reference), so just register an arbitrary target, and |
|
register in dei that we need to fix this before resolving |
|
branches */ |
|
dei->branchinfo = nbranchinfos; |
|
dei->xt = (Cell *)(last_start[1]); |
|
next_code_target = compile_call2(NULL); |
|
} else if (pi->start == NULL) { /* non-reloc */ |
|
next_code_target = compile_prim1arg(N_SET_NEXT_CODE); |
|
set_rel_target(compile_prim1arg(N_ABRANCH),*(Xt)last_prim); |
|
} else { |
|
unsigned j; |
|
|
|
memcpy(code_here, *last_prim, pi->length); |
|
for (j=0; j<pi->nimmargs; j++) { |
|
struct immarg *ia = &(pi->immargs[j]); |
|
Cell argval = last_start[pi->nimmargs - j]; /* !! specific to prims */ |
|
if (ia->rel) { /* !! assumption: relative refs are branches */ |
|
register_branchinfo(code_here + ia->offset, argval); |
|
} else /* plain argument */ |
|
*(Cell *)(code_here + ia->offset) = argval; |
|
} |
|
code_here += pi->length; |
|
} |
|
if (next_code_target!=NULL) |
|
*next_code_target = (Cell)code_here; |
|
} |
|
if (start) { |
|
last_prim = (Xt)*start; |
|
*start = (Cell)code_here; |
|
} |
|
last_start = start; |
|
return; |
|
#elif !defined(NO_DYNAMIC) |
|
Label prim=(Label)*start; |
unsigned i; |
unsigned i; |
Address old_code_here=code_here; |
Address old_code_here=code_here; |
static Address last_jump=0; |
static Address last_jump=0; |
|
|
i = ((Xt)prim)-vm_prims; |
i = ((Xt)prim)-vm_prims; |
prim = *(Xt)prim; |
prim = *(Xt)prim; |
if (no_dynamic) |
if (no_dynamic) { |
return prim; |
*start = (Cell)prim; |
|
return; |
|
} |
if (i>=npriminfos || priminfos[i].start == 0) { /* not a relocatable prim */ |
if (i>=npriminfos || priminfos[i].start == 0) { /* not a relocatable prim */ |
if (last_jump) { /* make sure the last sequence is complete */ |
if (last_jump) { /* make sure the last sequence is complete */ |
memcpy(code_here, last_jump, IND_JUMP_LENGTH); |
memcpy(code_here, last_jump, IND_JUMP_LENGTH); |
Line 540 Label compile_prim(Label prim)
|
Line 714 Label compile_prim(Label prim)
|
FLUSH_ICACHE(start_flush, code_here-start_flush); |
FLUSH_ICACHE(start_flush, code_here-start_flush); |
start_flush=code_here; |
start_flush=code_here; |
} |
} |
return prim; |
*start = (Cell)prim; |
|
return; |
} |
} |
assert(priminfos[i].start = prim); |
assert(priminfos[i].start = prim); |
#ifdef ALIGN_CODE |
#ifdef ALIGN_CODE |
Line 548 Label compile_prim(Label prim)
|
Line 723 Label compile_prim(Label prim)
|
#endif |
#endif |
memcpy(code_here, (Address)prim, priminfos[i].length); |
memcpy(code_here, (Address)prim, priminfos[i].length); |
code_here += priminfos[i].length; |
code_here += priminfos[i].length; |
last_jump = (priminfos[i].super_end) ? 0 : (prim+priminfos[i].length); |
last_jump = (priminfos[i].superend) ? 0 : (prim+priminfos[i].length); |
if (last_jump == 0) { |
if (last_jump == 0) { |
FLUSH_ICACHE(start_flush, code_here-start_flush); |
FLUSH_ICACHE(start_flush, code_here-start_flush); |
start_flush=code_here; |
start_flush=code_here; |
} |
} |
return (Label)old_code_here; |
*start = (Cell)old_code_here; |
|
return; |
#else /* !defined(DOUBLY_INDIRECT), no code replication */ |
#else /* !defined(DOUBLY_INDIRECT), no code replication */ |
|
Label prim=(Label)*start; |
#if !defined(INDIRECT_THREADED) |
#if !defined(INDIRECT_THREADED) |
prim = *(Xt)prim; |
prim = *(Xt)prim; |
#endif |
#endif |
return prim; |
*start = (Cell)prim; |
|
return; |
#endif /* !defined(DOUBLY_INDIRECT) */ |
#endif /* !defined(DOUBLY_INDIRECT) */ |
} |
} |
|
|
|
Label compile_prim(Label prim) |
|
{ |
|
Cell x=(Cell)prim; |
|
compile_prim1(&x); |
|
return (Label)x; |
|
} |
|
|
#if defined(PRINT_SUPER_LENGTHS) && !defined(NO_DYNAMIC) |
#if defined(PRINT_SUPER_LENGTHS) && !defined(NO_DYNAMIC) |
Cell prim_length(Cell prim) |
Cell prim_length(Cell prim) |
{ |
{ |