Fix label handling in compiler
parent
40fdffe7fb
commit
2b2b4a9f22
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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) \
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue