vm: rt-vm relocation now supports accessing a field directly

basis/bootstrap/image/image.factor

@@ -111,18 +111,25 @@ SYMBOL: jit-relocations
 : jit-rel ( rc rt -- )
     over compute-offset 3array jit-relocations get push-all ;
 
-: make-jit ( quot -- jit-data )
+SYMBOL: jit-literals
+
+: jit-literal ( literal -- )
+    jit-literals get push ;
+
+: make-jit ( quot -- jit-literals jit-data )
     [
+        V{ } clone jit-literals set
         V{ } clone jit-relocations set
         call( -- )
+        jit-literals get >array
         jit-relocations get >array
     ] B{ } make prefix ;
 
 : jit-define ( quot name -- )
-    [ make-jit ] dip set ;
+    [ make-jit nip ] dip set ;
 
 : define-sub-primitive ( quot word -- )
-    [ make-jit ] dip sub-primitives get set-at ;
+    [ make-jit 2array ] dip sub-primitives get set-at ;
 
 ! The image being constructed; a vector of word-size integers
 SYMBOL: image

basis/compiler/codegen/codegen.factor

@@ -63,7 +63,7 @@ M: ##no-tco generate-insn drop ;
 
 M: ##call generate-insn
     word>> dup sub-primitive>>
-    [ first % ] [ [ add-call ] [ %call ] bi ] ?if ;
+    [ second first % ] [ [ add-call ] [ %call ] bi ] ?if ;
 
 M: ##jump generate-insn word>> [ add-call ] [ %jump ] bi ;
 

basis/compiler/codegen/fixup/fixup.factor

@@ -77,8 +77,8 @@ SYMBOL: relocation-table
 : rel-here ( offset class -- )
     [ add-literal ] dip rt-here rel-fixup ;
 
-: rel-vm ( class -- )
+: rel-vm ( offset class -- )
-    rt-vm rel-fixup ;
+    [ add-literal ] dip rt-vm rel-fixup ;
 
 : rel-cards-offset ( class -- )
     rt-cards-offset rel-fixup ;

basis/cpu/x86/32/32.factor

@@ -50,7 +50,7 @@ M: x86.32 reserved-area-size 0 ;
 M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
 
 : push-vm-ptr ( -- )
-    0 PUSH rc-absolute-cell rel-vm ; ! push the vm ptr as an argument
+    0 PUSH 0 rc-absolute-cell rel-vm ; ! push the vm ptr as an argument
 
 M: x86.32 return-struct-in-registers? ( c-type -- ? )
     c-type

basis/cpu/x86/64/bootstrap.factor

@@ -26,10 +26,10 @@ IN: bootstrap.x86
     temp0 temp0 [] MOV
     ! save stack pointer
     temp0 [] stack-reg MOV
-    ! load XT
-    temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
     ! load vm ptr
     arg1 0 MOV rc-absolute-cell rt-vm jit-rel
+    ! load XT
+    temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
     ! go
     temp1 JMP
 ] jit-primitive jit-define

basis/cpu/x86/bootstrap.factor

@@ -252,7 +252,7 @@ big-endian off
     ! pop stack
     ds-reg bootstrap-cell SUB
     ! pass vm pointer
-    arg2 0 MOV rc-absolute-cell rt-vm jit-rel
+    arg2 0 MOV 0 jit-literal rc-absolute-cell rt-vm jit-rel
     ! call quotation
     arg1 quot-xt-offset [+] JMP
 ] \ (call) define-sub-primitive
@@ -402,6 +402,7 @@ big-endian off
 ! Comparisons
 : jit-compare ( insn -- )
     ! load t
+    t jit-literal
     temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
     ! load f
     temp1 \ f tag-number MOV

basis/cpu/x86/x86.factor

@@ -370,10 +370,10 @@ M: x86 %shr int-rep two-operand [ SHR ] emit-shift ;
 M: x86 %sar int-rep two-operand [ SAR ] emit-shift ;
 
 : %mov-vm-ptr ( reg -- )
-    0 MOV rc-absolute-cell rel-vm ;
+    0 MOV 0 rc-absolute-cell rel-vm ;
 
 M: x86 %vm-field-ptr ( dst field -- )
-    [ drop %mov-vm-ptr ] [ vm-field-offset ADD ] 2bi ;
+    [ 0 MOV ] dip vm-field-offset rc-absolute-cell rel-vm ;
 
 : load-allot-ptr ( nursery-ptr allot-ptr -- )
     [ drop "nursery" %vm-field-ptr ] [ swap [] MOV ] 2bi ;

core/quotations/quotations.factor

@@ -8,10 +8,10 @@ IN: quotations
 <PRIVATE
 
 : uncurry ( curry -- obj quot )
-    dup 2 slot swap 3 slot ; inline
+    { curry } declare dup 2 slot swap 3 slot ; inline
 
 : uncompose ( compose -- quot quot2 )
-    dup 2 slot swap 3 slot ; inline
+    { compose } declare dup 2 slot swap 3 slot ; inline
 
 PRIVATE>
 

vm/arrays.cpp

@@ -64,14 +64,14 @@ cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
 
 void factor_vm::primitive_resize_array()
 {
-	array* a = untag_check<array>(dpop());
+	array *a = untag_check<array>(dpop());
 	cell capacity = unbox_array_size();
 	dpush(tag<array>(reallot_array(a,capacity)));
 }
 
 void growable_array::add(cell elt_)
 {
-	factor_vm* parent_vm = elements.parent_vm;
+	factor_vm *parent_vm = elements.parent_vm;
 	gc_root<object> elt(elt_,parent_vm);
 	if(count == array_capacity(elements.untagged()))
 		elements = parent_vm->reallot_array(elements.untagged(),count * 2);
@@ -79,6 +79,21 @@ void growable_array::add(cell elt_)
 	parent_vm->set_array_nth(elements.untagged(),count++,elt.value());
 }
 
+void growable_array::append(array *elts_)
+{
+	factor_vm *parent_vm = elements.parent_vm;
+	gc_root<array> elts(elts_,parent_vm);
+	cell capacity = array_capacity(elts.untagged());
+	if(count + capacity > array_capacity(elements.untagged()))
+	{
+		elements = parent_vm->reallot_array(elements.untagged(),
+			(count + capacity) * 2);
+	}
+
+	for(cell index = 0; index < capacity; index++)
+		parent_vm->set_array_nth(elements.untagged(),count++,array_nth(elts.untagged(),index));
+}
+
 void growable_array::trim()
 {
 	factor_vm *parent_vm = elements.parent_vm;

vm/arrays.hpp

@@ -29,6 +29,7 @@ struct growable_array {
 	explicit growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
 
 	void add(cell elt);
+	void append(array *elts);
 	void trim();
 };
 

vm/code_block.cpp

@@ -34,13 +34,13 @@ int factor_vm::number_of_parameters(relocation_type type)
 	case RT_IMMEDIATE:
 	case RT_HERE:
 	case RT_UNTAGGED:
+	case RT_VM:
 		return 1;
 	case RT_DLSYM:
 		return 2;
 	case RT_THIS:
 	case RT_STACK_CHAIN:
 	case RT_MEGAMORPHIC_CACHE_HITS:
-	case RT_VM:
 	case RT_CARDS_OFFSET:
 	case RT_DECKS_OFFSET:
 		return 0;
@@ -181,7 +181,7 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
 	case RT_MEGAMORPHIC_CACHE_HITS:
 		return (cell)&megamorphic_cache_hits;
 	case RT_VM:
-		return (cell)this;
+		return (cell)this + untag_fixnum(ARG);
 	case RT_CARDS_OFFSET:
 		return cards_offset;
 	case RT_DECKS_OFFSET:

vm/jit.hpp

@@ -41,9 +41,9 @@ struct jit {
 
 	void emit_subprimitive(cell word_) {
 		gc_root<word> word(word_,parent_vm);
-		gc_root<array> code_template(word->subprimitive,parent_vm);
+		gc_root<array> code_pair(word->subprimitive,parent_vm);
-		if(array_capacity(code_template.untagged()) > 1) literal(parent_vm->T);
+		literals.append(parent_vm->untag<array>(array_nth(code_pair.untagged(),0)));
-		emit(code_template.value());
+		emit(array_nth(code_pair.untagged(),1));
 	}
 
 	void emit_class_lookup(fixnum index, cell type);

vm/layouts.hpp

@@ -199,9 +199,6 @@ struct string : public object {
 /* The compiled code heap is structured into blocks. */
 struct heap_block
 {
-	/* Bit 0: mark
-	   Bit 1-7: type
-	   Bit 8-...: size */
 	cell header;
 
 	bool marked_p() { return header & 1; }

vm/quotations.cpp

@@ -199,7 +199,9 @@ void quotation_jit::iterate_quotation()
 			/* Primitive calls */
 			if(primitive_call_p(i,length))
 			{
-				emit_with(parent_vm->userenv[JIT_PRIMITIVE],obj.value());
+				literal(tag_fixnum(0));
+				literal(obj.value());
+				emit(parent_vm->userenv[JIT_PRIMITIVE]);
 
 				i++;