Fix label handling in compiler

slava 2006-08-10 04:14:43 +00:00
parent 40fdffe7fb
commit 2b2b4a9f22
8 changed files with 27 additions and 63 deletions

View File

@ -47,16 +47,15 @@ UNION: #terminal
V{ } clone label-relocation-table set ;
: generate-1 ( word node quot -- | quot: node -- )
#! Generate the code, then dump five vectors to pass to
#! Generate the code, then dump three vectors to pass to
#! add-compiled-block.
pick f save-xt [
init-generator
init-templates
generate-code
generate-labels
relocation-table get
literal-table get
label-table get [ label-offset ] map
label-relocation-table get
] V{ } make
code-format add-compiled-block save-xt ;
@ -157,8 +156,6 @@ M: #call-label generate-node ( node -- next )
node-param generate-call ;
! #dispatch
: target-label ( label -- ) 0 , rel-absolute-cell rel-label ;
: dispatch-head ( node -- label/node )
#! Output the jump table insn and return a list of
#! label/branch pairs.

View File

@ -14,8 +14,7 @@ SYMBOL: label-table
: push-label ( label -- )
label-table get dup length pick set-label-# push ;
C: label ( -- label )
compiled-offset over set-label-offset dup push-label ;
C: label ( -- label ) dup push-label ;
: define-label ( name -- ) <label> swap set ;
@ -47,17 +46,15 @@ SYMBOL: label-relocation-table
: rel-relative-2 5 ;
: rel-relative-3 6 ;
: (rel) ( arg class type -- { m n } )
: (rel) ( arg class type offset -- { type offset } )
#! Write a relocation instruction for the runtime image
#! loader.
over >r >r >r 16 shift r> 8 shift bitor r> bitor
compiled-offset r> rel-absolute-cell = cell 4 ? - 2array ;
pick rel-absolute-cell = cell 4 ? -
>r >r >r 16 shift r> 8 shift bitor r> bitor r>
2array ;
: rel, ( arg class type -- )
(rel) relocation-table get swap nappend ;
: label, ( arg class type -- )
(rel) label-relocation-table get swap nappend ;
compiled-offset (rel) relocation-table get swap nappend ;
: rel-dlsym ( name dll class -- )
>r 2array add-literal r> 1 rel, ;
@ -76,7 +73,13 @@ SYMBOL: label-relocation-table
>r add-literal r> 4 rel, ;
: rel-label ( label class -- )
>r label-# r> 6 label, ;
compiled-offset 3array label-relocation-table get push ;
: generate-labels ( -- )
label-relocation-table get [
first3 >r >r label-offset r> 6 r> (rel)
relocation-table get swap nappend
] each ;
! When a word is encountered that has not been previously
! compiled, it is pushed onto this vector. Compilation stops

View File

@ -289,7 +289,7 @@ sequences strings vectors words prettyprint ;
\ cwd [ [ ] [ string ] ] "infer-effect" set-word-prop
\ cd [ [ string ] [ ] ] "infer-effect" set-word-prop
\ add-compiled-block [ [ vector vector vector vector integer ] [ integer ] ] "infer-effect" set-word-prop
\ add-compiled-block [ [ vector vector vector integer ] [ integer ] ] "infer-effect" set-word-prop
\ dlopen [ [ string ] [ dll ] ] "infer-effect" set-word-prop
\ dlsym [ [ string object ] [ integer ] ] "infer-effect" set-word-prop

View File

@ -114,7 +114,6 @@ M: object load-literal ( literal vreg -- )
#! Compile a piece of code that jumps to an offset in a
#! jump table indexed by the fixnum at the top of the stack.
#! The jump table must immediately follow this macro.
"end" define-label
! Untag and multiply to get a jump table offset
"n" operand fixnum>slot@
! Add to jump table base. We use a temporary register since

View File

@ -26,9 +26,6 @@ void undefined_symbol(void)
INLINE CELL get_literal(CELL literal_start, CELL num)
{
if(!literal_start)
critical_error("Only RT_LABEL relocations can appear in the label-relocation-table",0);
return get(LITERAL_REF(literal_start,num));
}
@ -59,11 +56,9 @@ CELL get_rel_word(F_REL *rel, CELL literal_start)
}
INLINE CELL compute_code_rel(F_REL *rel,
CELL code_start, CELL literal_start,
F_VECTOR *labels)
CELL code_start, CELL literal_start)
{
CELL offset = code_start + rel->offset;
F_ARRAY *array;
switch(REL_TYPE(rel))
{
@ -80,12 +75,7 @@ INLINE CELL compute_code_rel(F_REL *rel,
case RT_WORD:
return get_rel_word(rel,literal_start);
case RT_LABEL:
if(labels == NULL)
critical_error("RT_LABEL can only appear in label-relocation-table",0);
array = untag_array_fast(labels->array);
return to_cell(get(AREF(array,REL_ARGUMENT(rel))))
+ code_start;
return code_start + REL_ARGUMENT(rel);
default:
critical_error("Unsupported rel type",rel->type);
return -1;
@ -105,8 +95,7 @@ INLINE void reloc_set_masked(CELL cell, CELL value, CELL mask)
*(u32*)cell = (original | (value & mask));
}
void apply_relocation(F_REL *rel, CELL code_start, CELL literal_start,
F_VECTOR *labels)
void apply_relocation(F_REL *rel, CELL code_start, CELL literal_start)
{
CELL absolute_value;
CELL relative_value;
@ -114,7 +103,7 @@ void apply_relocation(F_REL *rel, CELL code_start, CELL literal_start,
/* to_c_string can fill up the heap */
maybe_gc(0);
absolute_value = compute_code_rel(rel,code_start,literal_start,labels);
absolute_value = compute_code_rel(rel,code_start,literal_start);
relative_value = absolute_value - offset;
switch(REL_CLASS(rel))
@ -154,7 +143,7 @@ void finalize_code_block(F_COMPILED *relocating, CELL code_start,
/* apply relocations */
while(rel < rel_end)
apply_relocation(rel++,code_start,literal_start,NULL);
apply_relocation(rel++,code_start,literal_start);
}
void collect_literals_step(F_COMPILED *relocating, CELL code_start,
@ -212,24 +201,8 @@ void deposit_objects(F_VECTOR *vector, CELL literal_length)
memcpy((void*)compiling.here,array + 1,literal_length);
}
void fixup_labels(F_VECTOR *label_rel, CELL code_start, CELL literal_start,
F_VECTOR *labels)
{
F_ARRAY *array = untag_array_fast(label_rel->array);
CELL length = untag_fixnum_fast(label_rel->top);
CELL i;
for(i = 0; i < length; i += 2)
{
F_REL rel;
rel.type = to_cell(get(AREF(array,i)));
rel.offset = to_cell(get(AREF(array,i + 1)));
apply_relocation(&rel,code_start,literal_start,labels);
}
}
void add_compiled_block(CELL code_format, F_VECTOR *code, F_VECTOR *label_rel,
F_VECTOR *labels, F_VECTOR *literals, F_VECTOR *rel)
void add_compiled_block(CELL code_format, F_VECTOR *code,
F_VECTOR *literals, F_VECTOR *rel)
{
CELL start = compiling.here;
CELL code_length = align8(untag_fixnum_fast(code->top) * code_format);
@ -256,9 +229,6 @@ void add_compiled_block(CELL code_format, F_VECTOR *code, F_VECTOR *label_rel,
deposit_objects(literals,literal_length);
compiling.here += literal_length;
/* labels */
fixup_labels(label_rel,start + sizeof(F_COMPILED),0,labels);
/* push the XT of the new word on the stack */
box_unsigned_cell(start + sizeof(F_COMPILED));
}
@ -267,12 +237,10 @@ void primitive_add_compiled_block(void)
{
CELL code_format = to_cell(dpop());
F_VECTOR *code = untag_vector(dpop());
F_VECTOR *label_rel = untag_vector(dpop());
F_VECTOR *labels = untag_vector(dpop());
F_VECTOR *literals = untag_vector(dpop());
F_VECTOR *rel = untag_vector(dpop());
add_compiled_block(code_format,code,label_rel,labels,literals,rel);
add_compiled_block(code_format,code,literals,rel);
}
void primitive_finalize_compile(void)

View File

@ -51,9 +51,6 @@ typedef struct {
CELL offset;
} F_REL;
void apply_relocation(F_REL *rel, CELL code_start, CELL literal_start,
F_VECTOR *labels);
void finalize_code_block(F_COMPILED *relocating, CELL code_start,
CELL reloc_start, CELL literal_start, CELL literal_end);

View File

@ -203,7 +203,7 @@ void primitive_fixnum_not(void)
#define INT_DEFBOX(name,type) \
void name (type integer) \
{ \
dpush(tag_integer(integer)); \
dpush(tag_fixnum(integer)); \
}
#define INT_DEFUNBOX(name,type) \

View File

@ -129,14 +129,14 @@ void primitive_integer_slot(void)
{
F_FIXNUM slot = untag_fixnum_fast(dpop());
CELL obj = UNTAG(dpop());
dpush(tag_integer(get(SLOT(obj,slot))));
dpush(tag_cell(get(SLOT(obj,slot))));
}
void primitive_set_integer_slot(void)
{
F_FIXNUM slot = untag_fixnum_fast(dpop());
CELL obj = UNTAG(dpop());
F_FIXNUM value = to_fixnum(dpop());
F_FIXNUM value = to_cell(dpop());
put(SLOT(obj,slot),value);
}