Fix label handling in compiler

library/compiler/generator/generator.factor

@@ -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.

library/compiler/generator/xt.factor

@@ -14,8 +14,7 @@ SYMBOL: label-table
 : push-label ( label -- )
     label-table get dup length pick set-label-# push ;
 
-C: label ( -- label )
+C: label ( -- label ) dup push-label ;
-    compiled-offset over set-label-offset 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
+    pick rel-absolute-cell = cell 4 ? -
-    compiled-offset r> rel-absolute-cell = cell 4 ? - 2array ;
+    >r >r >r 16 shift r> 8 shift bitor r> bitor r>
+    2array ;
 
 : rel, ( arg class type -- )
-    (rel) relocation-table get swap nappend ;
+    compiled-offset (rel) relocation-table get swap nappend ;
-
-: label, ( arg class type -- )
-    (rel) label-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

library/compiler/inference/known-words.factor

@@ -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

library/compiler/x86/architecture.factor

@@ -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

vm/compiler.c

@@ -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,
+	CELL code_start, CELL literal_start)
-	F_VECTOR *labels)
 {
 	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)
+		return code_start + REL_ARGUMENT(rel);
-			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;
 	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,
+void apply_relocation(F_REL *rel, CELL code_start, CELL literal_start)
-	F_VECTOR *labels)
 {
 	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,
+void add_compiled_block(CELL code_format, F_VECTOR *code,
-	F_VECTOR *labels)
+	F_VECTOR *literals, F_VECTOR *rel)
-{
-	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)
 {
 	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)

vm/compiler.h

@@ -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);
 

vm/math.c

@@ -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) \

vm/memory.c

@@ -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);
 }