64-bit relocation
Slava Pestov
parent
07f98e9dc6
commit
1086f8b3e3
|
|
@ -21,7 +21,8 @@ sequences ;
|
|||
: param-regs { RDI RSI RDX RCX R8 R9 } ; inline
|
||||
|
||||
: compile-c-call ( symbol dll -- )
|
||||
2dup dlsym 0 scratch swap MOV 0 0 rel-dlsym 0 scratch CALL ;
|
||||
2dup dlsym 0 scratch swap MOV
|
||||
rel-absolute-cell rel-dlsym 0 scratch CALL ;
|
||||
|
||||
: compile-c-call* ( symbol dll -- operands )
|
||||
param-regs swap [ MOV ] 2each compile-c-call ;
|
||||
|
|
|
|||
|
|
@ -4,6 +4,8 @@ IN: assembler
|
|||
USING: alien generic hashtables kernel kernel-internals lists
|
||||
math memory namespaces ;
|
||||
|
||||
: compiled-base 18 getenv ; inline
|
||||
|
||||
: compiled-header HEX: 01c3babe ; inline
|
||||
|
||||
: set-compiled-1 ( n a -- ) f swap set-alien-signed-1 ; inline
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ USING: alien assembler compiler inference kernel
|
|||
kernel-internals lists math memory namespaces words ;
|
||||
|
||||
: compile-dlsym ( symbol dll register -- )
|
||||
>r 2dup dlsym r> LOAD32 0 1 rel-dlsym ;
|
||||
>r 2dup dlsym r> LOAD32 rel-2-2 rel-dlsym ;
|
||||
|
||||
: compile-c-call ( symbol dll -- )
|
||||
11 [ compile-dlsym ] keep MTLR BLRL ;
|
||||
|
|
@ -31,14 +31,14 @@ M: %call-label generate-node ( vop -- )
|
|||
#! Near calling convention for inlined recursive combinators
|
||||
#! Note: length of instruction sequence is hard-coded.
|
||||
vop-label
|
||||
compiled-offset 20 + 18 LOAD32 0 1 rel-address
|
||||
compiled-offset 20 + 18 LOAD32 rel-2/2 rel-address
|
||||
1 1 stack-increment neg STWU
|
||||
18 1 stack-increment lr@ STW
|
||||
B ;
|
||||
|
||||
: word-addr ( word -- )
|
||||
#! Load a word address into r3.
|
||||
dup word-xt 3 LOAD32 0 1 rel-word ;
|
||||
dup word-xt 3 LOAD32 rel-2/2 rel-word ;
|
||||
|
||||
: compile-call ( label -- )
|
||||
#! Far C call for primitives, near C call for compiled defs.
|
||||
|
|
@ -84,7 +84,7 @@ M: %dispatch generate-node ( vop -- )
|
|||
0 input-operand dup 1 SRAWI
|
||||
! The value 24 is a magic number. It is the length of the
|
||||
! instruction sequence that follows to be generated.
|
||||
compiled-offset 24 + 0 scratch LOAD32 0 1 rel-address
|
||||
compiled-offset 24 + 0 scratch LOAD32 rel-2/2 rel-address
|
||||
0 input-operand dup 0 scratch ADD
|
||||
0 input-operand dup 0 LWZ
|
||||
0 input-operand MTLR
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ M: %set-char-slot generate-node ( vop -- )
|
|||
|
||||
: userenv ( reg -- )
|
||||
#! Load the userenv pointer in a virtual register.
|
||||
"userenv" f dlsym swap LOAD32 0 1 rel-userenv ;
|
||||
"userenv" f dlsym swap LOAD32 rel-2/2 rel-userenv ;
|
||||
|
||||
M: %getenv generate-node ( vop -- )
|
||||
drop 0 output-operand dup dup userenv 0 input cell * LWZ ;
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ M: %immediate generate-node ( vop -- )
|
|||
drop 0 input address 0 output-operand LOAD ;
|
||||
|
||||
: load-indirect ( dest literal -- )
|
||||
add-literal over LOAD32 0 1 rel-address dup 0 LWZ ;
|
||||
add-literal over LOAD32 rel-2/2 rel-address dup 0 LWZ ;
|
||||
|
||||
M: %indirect generate-node ( vop -- )
|
||||
drop 0 output-operand 0 input load-indirect ;
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ sequences ;
|
|||
: vregs { EAX ECX EDX } ; inline
|
||||
|
||||
: compile-c-call ( symbol dll -- )
|
||||
2dup dlsym CALL 1 0 rel-dlsym ;
|
||||
2dup dlsym CALL rel-relative rel-dlsym ;
|
||||
|
||||
: compile-c-call* ( symbol dll args -- operands )
|
||||
reverse-slice
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ M: %write-barrier generate-node ( vop -- )
|
|||
#! sacrificing a few bytes of generated code size.
|
||||
drop
|
||||
0 input-operand card-bits SHR
|
||||
0 scratch card-offset MOV 0 rel-cards
|
||||
0 scratch card-offset MOV rel-absolute-cell rel-cards
|
||||
0 scratch 0 input-operand ADD
|
||||
0 scratch 1array card-mark OR ;
|
||||
|
||||
|
|
@ -47,11 +47,11 @@ M: %fast-set-slot generate-node ( vop -- )
|
|||
M: %getenv generate-node ( vop -- )
|
||||
drop
|
||||
0 output-operand 0 input userenv@ MOV
|
||||
0 input 0 rel-userenv
|
||||
0 input rel-absolute-cell rel-userenv
|
||||
0 output-operand dup 1array MOV ;
|
||||
|
||||
M: %setenv generate-node ( vop -- )
|
||||
drop
|
||||
0 scratch 1 input userenv@ MOV
|
||||
1 input 0 rel-userenv
|
||||
1 input rel-absolute-cell rel-userenv
|
||||
0 scratch 1array 0 input-operand MOV ;
|
||||
|
|
|
|||
|
|
@ -26,7 +26,8 @@ M: %immediate generate-node ( vop -- )
|
|||
drop 0 output-operand 0 input address MOV ;
|
||||
|
||||
: load-indirect ( dest literal -- )
|
||||
add-literal address-operand 1array MOV 0 0 rel-address ;
|
||||
add-literal address-operand 1array MOV
|
||||
rel-absolute-cell rel-address ;
|
||||
|
||||
M: %indirect generate-node ( vop -- )
|
||||
#! indirect load of a literal through a table
|
||||
|
|
|
|||
|
|
@ -38,29 +38,34 @@ SYMBOL: relocation-table
|
|||
|
||||
: 4-just-compiled compiled-offset 4 - ;
|
||||
|
||||
: relocating cell-just-compiled rel, ;
|
||||
: rel-absolute-cell 0 ;
|
||||
: rel-absolute 1 ;
|
||||
: rel-relative 2 ;
|
||||
: rel-2/2 3 ;
|
||||
|
||||
: rel-type, ( rel/abs 16/16 type -- )
|
||||
swap 8 shift bitor swap 16 shift bitor rel, ;
|
||||
: rel-type, ( arg class type -- )
|
||||
#! Write a relocation instruction for the runtime image
|
||||
#! loader.
|
||||
>r >r 16 shift r> 8 shift bitor r> bitor rel,
|
||||
cell-just-compiled rel, ;
|
||||
|
||||
: rel-primitive ( word relative 16/16 -- )
|
||||
0 rel-type, relocating word-primitive rel, ;
|
||||
: rel-dlsym ( name dll class -- )
|
||||
>r cons add-literal compiled-base - cell / r> 1 rel-type, ;
|
||||
|
||||
: rel-dlsym ( name dll rel/abs 16/16 -- )
|
||||
1 rel-type, relocating cons add-literal rel, ;
|
||||
|
||||
: rel-address ( rel/abs 16/16 -- )
|
||||
: rel-address ( class -- )
|
||||
#! Relocate address just compiled.
|
||||
over 1 = [ 2drop ] [ 2 rel-type, relocating 0 rel, ] if ;
|
||||
dup rel-relative = [ 2drop ] [ 0 -rot 2 rel-type, ] if ;
|
||||
|
||||
: rel-word ( word rel/abs 16/16 -- )
|
||||
pick primitive? [ rel-primitive ] [ rel-address drop ] if ;
|
||||
: rel-word ( word class -- )
|
||||
over primitive? [
|
||||
>r word-primitive r> 0 rel-type,
|
||||
] [
|
||||
rel-address drop
|
||||
] if ;
|
||||
|
||||
: rel-userenv ( n 16/16 -- )
|
||||
0 swap 3 rel-type, relocating rel, ;
|
||||
: rel-userenv ( n class -- ) 3 rel-type, ;
|
||||
|
||||
: rel-cards ( 16/16 -- )
|
||||
0 swap 4 rel-type, relocating 0 rel, ;
|
||||
: rel-cards ( class -- ) 4 rel-type, ;
|
||||
|
||||
! This is for fixing up forward references
|
||||
GENERIC: resolve ( fixup -- addr )
|
||||
|
|
@ -123,32 +128,35 @@ M: fixup-2/2 fixup ( addr fixup -- )
|
|||
fixup-2/2-at >r w>h/h r> tuck 4 - or-compiled or-compiled ;
|
||||
|
||||
: relative-4 ( word -- )
|
||||
dup 1 0 rel-word ( FIXME)
|
||||
dup rel-relative rel-word
|
||||
compiled-offset <relative>
|
||||
4-just-compiled <fixup-4> deferred-xt ;
|
||||
|
||||
: relative-3 ( word -- )
|
||||
#! Labels only -- no image relocation information saved
|
||||
4-just-compiled <relative>
|
||||
4-just-compiled <fixup-3> deferred-xt ;
|
||||
|
||||
: relative-2 ( word -- )
|
||||
#! Labels only -- no image relocation information saved
|
||||
4-just-compiled <relative>
|
||||
4-just-compiled <fixup-2> deferred-xt ;
|
||||
|
||||
: relative-2/2 ( word -- )
|
||||
#! Labels only -- no image relocation information saved
|
||||
compiled-offset <relative>
|
||||
4-just-compiled <fixup-2/2> deferred-xt ;
|
||||
|
||||
: absolute-4 ( word -- )
|
||||
dup 0 0 rel-word ( FIXME)
|
||||
dup rel-absolute rel-word
|
||||
<absolute> 4-just-compiled <fixup-4> deferred-xt ;
|
||||
|
||||
: absolute-2/2 ( word -- )
|
||||
dup 0 1 rel-word
|
||||
dup rel-2/2 rel-word
|
||||
<absolute> cell-just-compiled <fixup-2/2> deferred-xt ;
|
||||
|
||||
: absolute-cell ( word -- )
|
||||
dup 0 0 rel-word
|
||||
dup rel-absolute-cell rel-word
|
||||
<absolute> cell-just-compiled <fixup-cell> deferred-xt ;
|
||||
|
||||
! When a word is encountered that has not been previously
|
||||
|
|
|
|||
|
|
@ -17,10 +17,10 @@ USING: errors io kernel lists math namespaces sequences words ;
|
|||
: parse-stream ( stream name -- quot )
|
||||
[ file set file-vocabs lines parse-lines ] with-scope ;
|
||||
|
||||
: parsing-file ( file -- ) "! " write dup print ;
|
||||
: parsing-file ( file -- ) "! Loading " write print ;
|
||||
|
||||
: parse-file ( file -- quot )
|
||||
parsing-file
|
||||
dup parsing-file
|
||||
[ <file-reader> ] keep parse-stream ;
|
||||
|
||||
: run-file ( file -- )
|
||||
|
|
@ -33,7 +33,7 @@ USING: errors io kernel lists math namespaces sequences words ;
|
|||
#! resource:. This allows words that operate on source
|
||||
#! files, like "jedit", to use a different resource path
|
||||
#! at run time than was used at parse time.
|
||||
parsing-file
|
||||
dup parsing-file
|
||||
[ <resource-stream> "resource:" ] keep append parse-stream ;
|
||||
|
||||
: run-resource ( file -- )
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@ void init_factor(char* image, CELL ds_size, CELL cs_size,
|
|||
userenv[CARD_OFF_ENV] = tag_cell(cards_offset);
|
||||
userenv[IMAGE_ENV] = tag_object(from_c_string(image));
|
||||
userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
|
||||
userenv[COMPILED_BASE_ENV] = tag_cell(compiling.base);
|
||||
}
|
||||
|
||||
INLINE bool factor_arg(const char* str, const char* arg, CELL* value)
|
||||
|
|
@ -59,7 +60,6 @@ int main(int argc, char** argv)
|
|||
printf(" +Yn Size of n-1 youngest generations, megabytes\n");
|
||||
printf(" +An Size of tenured and semi-spaces, megabytes\n");
|
||||
printf(" +Xn Code heap size, megabytes\n");
|
||||
printf(" +Ln Literal table size, kilobytes. Only for bootstrapping\n");
|
||||
printf("Other options are handled by the Factor library.\n");
|
||||
printf("See the documentation for details.\n");
|
||||
printf("Send bug reports to Slava Pestov <slava@jedit.org>.\n");
|
||||
|
|
@ -74,7 +74,6 @@ int main(int argc, char** argv)
|
|||
if(factor_arg(argv[i],"+Y%d",&young_size)) continue;
|
||||
if(factor_arg(argv[i],"+A%d",&aging_size)) continue;
|
||||
if(factor_arg(argv[i],"+X%d",&code_size)) continue;
|
||||
if(factor_arg(argv[i],"+L%d",&literal_size)) continue;
|
||||
|
||||
if(strncmp(argv[i],"+",1) == 0)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -92,7 +92,8 @@ void undefined_symbol(void)
|
|||
|
||||
CELL get_rel_symbol(F_REL* rel)
|
||||
{
|
||||
F_CONS* cons = untag_cons(get(rel->argument));
|
||||
CELL arg = REL_ARGUMENT(rel);
|
||||
F_CONS* cons = untag_cons(compiling.base + arg * sizeof(CELL));
|
||||
F_STRING* symbol = untag_string(cons->car);
|
||||
DLL* dll = (cons->cdr == F ? NULL : untag_dll(cons->cdr));
|
||||
CELL sym;
|
||||
|
|
@ -113,18 +114,17 @@ INLINE CELL compute_code_rel(F_REL *rel, CELL original)
|
|||
switch(REL_TYPE(rel))
|
||||
{
|
||||
case F_PRIMITIVE:
|
||||
return primitive_to_xt(rel->argument);
|
||||
return primitive_to_xt(REL_ARGUMENT(rel));
|
||||
case F_DLSYM:
|
||||
code_fixup(&rel->argument);
|
||||
return get_rel_symbol(rel);
|
||||
case F_ABSOLUTE:
|
||||
return original + (compiling.base - code_relocation_base);
|
||||
case F_USERENV:
|
||||
return (CELL)&userenv[rel->argument];
|
||||
return (CELL)&userenv[REL_ARGUMENT(rel)];
|
||||
case F_CARDS:
|
||||
return cards_offset;
|
||||
default:
|
||||
critical_error("Unsupported rel",rel->type);
|
||||
critical_error("Unsupported rel type",rel->type);
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
|
@ -152,22 +152,47 @@ INLINE CELL relocate_code_next(CELL relocating)
|
|||
|
||||
code_fixup(&rel->offset);
|
||||
|
||||
if(REL_16_16(rel))
|
||||
original = reloc_get_16_16(rel->offset);
|
||||
else
|
||||
switch(REL_CLASS(rel))
|
||||
{
|
||||
case REL_ABSOLUTE_CELL:
|
||||
original = get(rel->offset);
|
||||
break;
|
||||
case REL_ABSOLUTE:
|
||||
original = *(u32*)rel->offset;
|
||||
break;
|
||||
case REL_RELATIVE:
|
||||
original = *(u32*)rel->offset - (rel->offset + sizeof(u32));
|
||||
break;
|
||||
case REL_2_2:
|
||||
original = reloc_get_2_2(rel->offset);
|
||||
break;
|
||||
default:
|
||||
critical_error("Unsupported rel class",REL_CLASS(rel));
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* to_c_string can fill up the heap */
|
||||
maybe_gc(0);
|
||||
new_value = compute_code_rel(rel,original);
|
||||
|
||||
if(REL_RELATIVE(rel))
|
||||
new_value -= (rel->offset + CELLS);
|
||||
|
||||
if(REL_16_16(rel))
|
||||
reloc_set_16_16(rel->offset,new_value);
|
||||
else
|
||||
switch(REL_CLASS(rel))
|
||||
{
|
||||
case REL_ABSOLUTE_CELL:
|
||||
put(rel->offset,new_value);
|
||||
break;
|
||||
case REL_ABSOLUTE:
|
||||
*(u32*)rel->offset = new_value;
|
||||
break;
|
||||
case REL_RELATIVE:
|
||||
*(u32*)rel->offset = new_value - (rel->offset + CELLS);
|
||||
break;
|
||||
case REL_2_2:
|
||||
reloc_set_2_2(rel->offset,new_value);
|
||||
break;
|
||||
default:
|
||||
critical_error("Unsupported rel class",REL_CLASS(rel));
|
||||
return -1;
|
||||
}
|
||||
|
||||
rel++;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -21,19 +21,21 @@ typedef enum {
|
|||
F_CARDS
|
||||
} F_RELTYPE;
|
||||
|
||||
#define REL_ABSOLUTE_CELL 0
|
||||
#define REL_ABSOLUTE 1
|
||||
#define REL_RELATIVE 2
|
||||
#define REL_2_2 3
|
||||
|
||||
/* the rel type is built like a cell to avoid endian-specific code in
|
||||
the compiler */
|
||||
#define REL_TYPE(r) ((r)->type & 0xff)
|
||||
/* on PowerPC, some values are stored in the high 16 bits of a pair
|
||||
of consecutive cells */
|
||||
#define REL_16_16(r) ((r)->type & 0xff00)
|
||||
#define REL_RELATIVE(r) ((r)->type & 0xff0000)
|
||||
#define REL_TYPE(r) ((r)->type & 0x000000ff)
|
||||
#define REL_CLASS(r) (((r)->type & 0x0000ff00) >> 8)
|
||||
#define REL_ARGUMENT(r) (((r)->type & 0xffff0000) >> 16)
|
||||
|
||||
/* code relocation consists of a table of entries for each fixup */
|
||||
typedef struct {
|
||||
CELL type;
|
||||
CELL offset;
|
||||
CELL argument;
|
||||
} F_REL;
|
||||
|
||||
CELL code_relocation_base;
|
||||
|
|
@ -48,12 +50,12 @@ void relocate_code();
|
|||
|
||||
/* on PowerPC, return the 32-bit literal being loaded at the code at the
|
||||
given address */
|
||||
INLINE CELL reloc_get_16_16(CELL cell)
|
||||
INLINE CELL reloc_get_2_2(CELL cell)
|
||||
{
|
||||
return ((get(cell - CELLS) & 0xffff) << 16) | (get(cell) & 0xffff);
|
||||
}
|
||||
|
||||
INLINE void reloc_set_16_16(CELL cell, CELL value)
|
||||
INLINE void reloc_set_2_2(CELL cell, CELL value)
|
||||
{
|
||||
put(cell - CELLS,((get(cell - CELLS) & ~0xffff) | ((value >> 16) & 0xffff)));
|
||||
put(cell,((get(cell) & ~0xffff) | (value & 0xffff)));
|
||||
|
|
|
|||
35
native/run.h
35
native/run.h
|
|
@ -1,22 +1,23 @@
|
|||
#define USER_ENV 32
|
||||
|
||||
#define CARD_OFF_ENV 1 /* for compiling set-slot */
|
||||
/* 2 is unused */
|
||||
#define NAMESTACK_ENV 3 /* used by library only */
|
||||
#define GLOBAL_ENV 4
|
||||
#define BREAK_ENV 5
|
||||
#define CATCHSTACK_ENV 6 /* used by library only */
|
||||
#define CPU_ENV 7
|
||||
#define BOOT_ENV 8
|
||||
#define CALLCC_1_ENV 9 /* used by library only */
|
||||
#define ARGS_ENV 10
|
||||
#define OS_ENV 11
|
||||
#define ERROR_ENV 12 /* a marker consed onto kernel errors */
|
||||
#define IN_ENV 13
|
||||
#define OUT_ENV 14
|
||||
#define GEN_ENV 15 /* set to gen_count */
|
||||
#define IMAGE_ENV 16 /* image name */
|
||||
#define CELL_SIZE_ENV 17 /* sizeof(CELL) */
|
||||
#define CARD_OFF_ENV 1 /* for compiling set-slot */
|
||||
/* 2 is unused */
|
||||
#define NAMESTACK_ENV 3 /* used by library only */
|
||||
#define GLOBAL_ENV 4
|
||||
#define BREAK_ENV 5
|
||||
#define CATCHSTACK_ENV 6 /* used by library only */
|
||||
#define CPU_ENV 7
|
||||
#define BOOT_ENV 8
|
||||
#define CALLCC_1_ENV 9 /* used by library only */
|
||||
#define ARGS_ENV 10
|
||||
#define OS_ENV 11
|
||||
#define ERROR_ENV 12 /* a marker consed onto kernel errors */
|
||||
#define IN_ENV 13
|
||||
#define OUT_ENV 14
|
||||
#define GEN_ENV 15 /* set to gen_count */
|
||||
#define IMAGE_ENV 16 /* image name */
|
||||
#define CELL_SIZE_ENV 17 /* sizeof(CELL) */
|
||||
#define COMPILED_BASE_ENV 18 /* base of code heap */
|
||||
|
||||
/* TAGGED user environment data; see getenv/setenv prims */
|
||||
DLLEXPORT CELL userenv[USER_ENV];
|
||||
|
|
|
|||
Loading…
Reference in New Issue