finalize-compile now takes an alist of xts; fix ppc %dispatch

TODO.FACTOR.txt

@@ -104,6 +104,8 @@
 
 + misc:
 
+- growable data heap
+- incremental GC
 - UDP
 - faster I/O
 - buffer-ptr should be an alien

library/compiler/generator/xt.factor

@@ -27,9 +27,6 @@ SYMBOL: compiled-xts
 : save-xt ( word xt -- )
     swap compiled-xts get set-hash ;
 
-: commit-xts ( -- )
-    compiled-xts get [ swap set-word-xt ] hash-each ;
-
 SYMBOL: literal-table
 
 : add-literal ( obj -- n )
@@ -98,8 +95,7 @@ SYMBOL: compile-words
         H{ } clone compiled-xts set
         V{ } clone compile-words set
         call
-        finalize-compile
+        compiled-xts get hash>alist finalize-compile
-        commit-xts
     ] with-scope ;
 
 : postpone-word ( word -- )

library/compiler/inference/known-words.factor

@@ -395,7 +395,7 @@ sequences strings vectors words prettyprint ;
 
 \ array>vector [ [ array ] [ vector ] ] "infer-effect" set-word-prop
 
-\ finalize-compile [ [ ] [ ] ] "infer-effect" set-word-prop
+\ finalize-compile [ [ array ] [ ] ] "infer-effect" set-word-prop
 
 \ <string> [ [ integer integer ] [ string ] ] "infer-effect" set-word-prop
 

library/compiler/ppc/architecture.factor

@@ -34,7 +34,8 @@ M: immediate load-literal ( literal vreg -- )
     [ v>operand ] 2apply LOAD ;
 
 M: object load-literal ( literal vreg -- )
-    v>operand [ 0 LOAD32 rel-absolute-2/2 rel-literal ] keep
+    v>operand
+    [ 0 swap LOAD32 rel-absolute-2/2 rel-literal ] keep
     dup 0 LWZ ;
 
 : stack-increment \ stack-reserve get 32 max stack@ 16 align ;
@@ -74,12 +75,12 @@ M: object load-literal ( literal vreg -- )
     0 "flag" operand object-tag CMPI BNE ;
 
 : %dispatch ( -- )
+    #! The value 20 is a magic number. It is the length of the
+    #! instruction sequence that follows
     "n" operand dup 1 SRAWI
-    ! The value 24 is a magic number. It is the length of the
-    ! instruction sequence that follows to be generated.
     0 "scratch" operand LOAD32 rel-absolute-2/2 rel-here
     "n" operand dup "scratch" operand ADD
-    "n" operand dup 24 LWZ
+    "n" operand dup 20 LWZ
     "n" operand MTLR
     BLR ;
 

library/test/compiler/optimizer.factor

@@ -241,6 +241,6 @@ GENERIC: void-generic
 [ 10 ] [ branch-fold-regression-1 ] unit-test
 
 ! another regression
-: bar "hey" ; foldable
+: constant-branch-fold-0 "hey" ; foldable
-: foo bar "hey" = ; inline
+: constant-branch-fold-1 constant-branch-fold-0 "hey" = ; inline
-[ 1 ] [ [ foo [ 1 ] [ 2 ] if ] compile-1 ] unit-test
+[ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-1 ] unit-test

vm/compiler.c

@@ -62,7 +62,7 @@ INLINE CELL compute_code_rel(F_REL *rel,
 	CELL code_start, CELL literal_start,
 	F_VECTOR *labels)
 {
-	CELL offset = rel->offset + code_start;
+	CELL offset = code_start + rel->offset;
 	F_ARRAY *array;
 
 	switch(REL_TYPE(rel))
@@ -277,6 +277,16 @@ void primitive_add_compiled_block(void)
 
 void primitive_finalize_compile(void)
 {
+	F_ARRAY *array = untag_array(dpop());
+	CELL count = untag_fixnum_fast(array->capacity);
+	CELL i;
+	for(i = 0; i < count; i++)
+	{
+		F_ARRAY *pair = untag_array(get(AREF(array,i)));
+		F_WORD *word = untag_word(get(AREF(pair,0)));
+		word->xt = to_cell(get(AREF(pair,1)));
+	}
+	
 	flush_icache((void*)last_flush,compiling.here - last_flush);
 	iterate_code_heap(last_flush,compiling.here,finalize_code_block);
 	last_flush = compiling.here;

vm/image.c

@@ -59,7 +59,7 @@ void load_image(const char* filename)
 			&& size != fread((void*)compiling.base,1,size,file))
 			fatal_error("Wrong code heap length",h.code_size);
 
-		compiling.here = compiling.base + h.code_size;
+		last_flush = compiling.here = compiling.base + h.code_size;
 		code_relocation_base = h.code_relocation_base;
 	}