Merge branch 'master' of git://factorcode.org/git/factor

basis/cpu/ppc/bootstrap.factor

@@ -64,7 +64,7 @@ CONSTANT: ctx-reg 16
     nv-fp-regs [ 8 * 80 + save-fp ] each-index
     nv-vec-regs [ 16 * 224 + save-vec ] each-index
 
-    0 vm-reg LOAD32 rt-vm rc-absolute-ppc-2/2 jit-rel
+    0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
 
     0 2 LOAD32 rc-absolute-ppc-2/2 rt-xt jit-rel
     2 MTLR
@@ -88,7 +88,7 @@ CONSTANT: ctx-reg 16
 
 : jit-save-context ( -- )
     jit-load-context
-    1 2 context-callstack-top-offset STW
+    1 ctx-reg context-callstack-top-offset STW
     ds-reg ctx-reg context-datastack-offset STW
     rs-reg ctx-reg context-retainstack-offset STW ;
 
@@ -109,12 +109,12 @@ CONSTANT: ctx-reg 16
 ] jit-profiling jit-define
 
 [
-    0 3 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel
+    0 2 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel
     0 MFLR
     1 1 stack-frame SUBI
-    3 1 xt-save STW
+    2 1 xt-save STW
-    stack-frame 3 LI
+    stack-frame 2 LI
-    3 1 next-save STW
+    2 1 next-save STW
     0 1 lr-save stack-frame + STW
 ] jit-prolog jit-define
 
@@ -384,7 +384,7 @@ CONSTANT: ctx-reg 16
     5 6 callstack-length-offset LWZ
     5 5 tag-bits get SRAWI
     ! Compute new stack pointer -- 'dst' for memcpy
-    3 3 5 SUBF
+    3 5 3 SUBF
     ! Install new stack pointer
     1 3 MR
     ! Call memcpy; arguments are now in the correct registers
@@ -394,7 +394,7 @@ CONSTANT: ctx-reg 16
     BLRL
     1 1 0 LWZ
     ! Return with new callstack
-    0 1 lr-save stack-frame + LWZ
+    0 1 lr-save LWZ
     0 MTLR
     BLR
 ] \ set-callstack define-sub-primitive
@@ -402,7 +402,7 @@ CONSTANT: ctx-reg 16
 [
     jit-save-context
     4 vm-reg MR
-    2 0 LOAD32 "lazy_jit_compile" f rc-absolute-ppc-2/2 jit-dlsym
+    0 2 LOAD32 "lazy_jit_compile" f rc-absolute-ppc-2/2 jit-dlsym
     2 MTLR
     BLRL
     5 3 quot-xt-offset LWZ

basis/cpu/x86/32/32.factor

@@ -8,7 +8,8 @@ compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
 compiler.cfg.intrinsics compiler.cfg.stack-frame
 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
-cpu.architecture ;
+cpu.architecture vm ;
+FROM: layouts => cell ;
 IN: cpu.x86.32
 
 M: x86.32 machine-registers
@@ -23,6 +24,12 @@ M: x86.32 stack-reg ESP ;
 M: x86.32 frame-reg EBP ;
 M: x86.32 temp-reg ECX ;
 
+M: x86.32 %mov-vm-ptr ( reg -- )
+    0 MOV 0 rc-absolute-cell rel-vm ;
+
+M: x86.32 %vm-field-ptr ( dst field -- )
+    [ 0 MOV ] dip vm-field-offset rc-absolute-cell rel-vm ;
+
 : local@ ( n -- op )
     stack-frame get extra-stack-space dup 16 assert= + stack@ ;
 

basis/cpu/x86/32/bootstrap.factor

@@ -19,8 +19,8 @@ IN: bootstrap.x86
 : safe-reg ( -- reg ) EAX ;
 : stack-reg ( -- reg ) ESP ;
 : frame-reg ( -- reg ) EBP ;
-: vm-reg ( -- reg ) EBP ;
+: vm-reg ( -- reg ) ECX ;
-: ctx-reg ( -- reg ) ECX ;
+: ctx-reg ( -- reg ) EBP ;
 : nv-regs ( -- seq ) { ESI EDI EBX } ;
 : ds-reg ( -- reg ) ESI ;
 : rs-reg ( -- reg ) EDI ;
@@ -44,19 +44,18 @@ IN: bootstrap.x86
     ctx-reg vm-reg vm-context-offset [+] MOV ;
 
 : jit-save-context ( -- )
-    jit-load-context
     EDX RSP -4 [+] LEA
     ctx-reg context-callstack-top-offset [+] EDX MOV
     ctx-reg context-datastack-offset [+] ds-reg MOV
     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
 
 : jit-restore-context ( -- )
-    jit-load-context
     ds-reg ctx-reg context-datastack-offset [+] MOV
     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
 
 [
     jit-load-vm
+    jit-load-context
     jit-save-context
     ! call the primitive
     ESP [] vm-reg MOV
@@ -70,13 +69,13 @@ IN: bootstrap.x86
     EAX EBP 8 [+] MOV
     ! save ctx->callstack_bottom, load ds, rs registers
     jit-load-vm
+    jit-load-context
     jit-restore-context
     EDX stack-reg stack-frame-size 4 - [+] LEA
     ctx-reg context-callstack-bottom-offset [+] EDX MOV
     ! call the quotation
     EAX quot-xt-offset [+] CALL
     ! save ds, rs registers
-    jit-load-vm
     jit-save-context
 ] \ c-to-factor define-sub-primitive
 
@@ -105,6 +104,7 @@ IN: bootstrap.x86
 
     ! Load ds and rs registers
     jit-load-vm
+    jit-load-context
     jit-restore-context
 
     ! Call quotation
@@ -140,6 +140,7 @@ IN: bootstrap.x86
 
 [
     jit-load-vm
+    jit-load-context
     jit-save-context
 
     ! Store arguments
@@ -161,6 +162,7 @@ IN: bootstrap.x86
 ! frame, and the stack. The frame setup takes this into account.
 : jit-inline-cache-miss ( -- )
     jit-load-vm
+    jit-load-context
     jit-save-context
     ESP 4 [+] vm-reg MOV
     ESP [] EBX MOV
@@ -181,17 +183,18 @@ IN: bootstrap.x86
 : jit-overflow ( insn func -- )
     ds-reg 4 SUB
     jit-load-vm
+    jit-load-context
     jit-save-context
     EAX ds-reg [] MOV
     EDX ds-reg 4 [+] MOV
-    ECX EAX MOV
+    EBX EAX MOV
-    [ [ ECX EDX ] dip call( dst src -- ) ] dip
+    [ [ EBX EDX ] dip call( dst src -- ) ] dip
-    ds-reg [] ECX MOV
+    ds-reg [] EBX MOV
     [ JNO ]
     [
         ESP [] EAX MOV
         ESP 4 [+] EDX MOV
-        ESP 8 [+] EBP MOV
+        ESP 8 [+] vm-reg MOV
         [ 0 CALL ] dip f rc-relative jit-dlsym
     ]
     jit-conditional ;
@@ -203,19 +206,20 @@ IN: bootstrap.x86
 [
     ds-reg 4 SUB
     jit-load-vm
+    jit-load-context
     jit-save-context
-    ECX ds-reg [] MOV
+    EBX ds-reg [] MOV
-    EAX ECX MOV
+    EAX EBX MOV
-    EBX ds-reg 4 [+] MOV
+    EBP ds-reg 4 [+] MOV
-    EBX tag-bits get SAR
+    EBP tag-bits get SAR
-    EBX IMUL
+    EBP IMUL
     ds-reg [] EAX MOV
     [ JNO ]
     [
-        ECX tag-bits get SAR
+        EBX tag-bits get SAR
-        ESP [] ECX MOV
+        ESP [] EBX MOV
-        ESP 4 [+] EBX MOV
+        ESP 4 [+] EBP MOV
-        ESP 8 [+] EBP MOV
+        ESP 8 [+] vm-reg MOV
         0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym
     ]
     jit-conditional

basis/cpu/x86/64/64.factor

@@ -7,7 +7,8 @@ compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
 compiler.cfg.intrinsics compiler.cfg.stack-frame
 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
-cpu.architecture ;
+cpu.architecture vm ;
+FROM: layouts => cell cells ;
 IN: cpu.x86.64
 
 : param-reg-0 ( -- reg ) 0 int-regs param-reg ; inline
@@ -29,13 +30,21 @@ M: x86.64 extra-stack-space drop 0 ;
 
 M: x86.64 machine-registers
     {
-        { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
+        { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 } }
         { float-regs {
             XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
             XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
         } }
     } ;
 
+: vm-reg ( -- reg ) R13 ; inline
+
+M: x86.64 %mov-vm-ptr ( reg -- )
+    vm-reg MOV ;
+
+M: x86.64 %vm-field-ptr ( dst field -- )
+    [ vm-reg ] dip vm-field-offset [+] LEA ;
+
 : param@ ( n -- op ) reserved-stack-space + stack@ ;
 
 M: x86.64 %prologue ( n -- )

basis/cpu/x86/64/bootstrap.factor

@@ -19,8 +19,8 @@ IN: bootstrap.x86
 : safe-reg ( -- reg ) RAX ;
 : stack-reg ( -- reg ) RSP ;
 : frame-reg ( -- reg ) RBP ;
-: vm-reg ( -- reg ) R12 ;
+: ctx-reg ( -- reg ) R12 ;
-: ctx-reg ( -- reg ) R13 ;
+: vm-reg ( -- reg ) R13 ;
 : ds-reg ( -- reg ) R14 ;
 : rs-reg ( -- reg ) R15 ;
 : fixnum>slot@ ( -- ) temp0 1 SAR ;
@@ -37,11 +37,7 @@ IN: bootstrap.x86
     RSP stack-frame-size 3 bootstrap-cells - SUB
 ] jit-prolog jit-define
 
-: jit-load-vm ( -- )
-    vm-reg 0 MOV 0 rc-absolute-cell jit-vm ;
-
 : jit-load-context ( -- )
-    ! VM pointer must be in vm-reg already
     ctx-reg vm-reg vm-context-offset [+] MOV ;
 
 : jit-save-context ( -- )
@@ -57,7 +53,6 @@ IN: bootstrap.x86
     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
 
 [
-    jit-load-vm
     jit-save-context
     ! call the primitive
     arg1 vm-reg MOV
@@ -67,14 +62,12 @@ IN: bootstrap.x86
 ] jit-primitive jit-define
 
 [
-    jit-load-vm
     jit-restore-context
     ! save ctx->callstack_bottom
     safe-reg stack-reg stack-frame-size 8 - [+] LEA
     ctx-reg context-callstack-bottom-offset [+] safe-reg MOV
     ! call the quotation
     arg1 quot-xt-offset [+] CALL
-    jit-load-vm
     jit-save-context
 ] \ c-to-factor define-sub-primitive
 
@@ -97,7 +90,6 @@ IN: bootstrap.x86
     RSP arg2 MOV
 
     ! Load ds and rs registers
-    jit-load-vm
     jit-restore-context
 
     ! Call quotation
@@ -109,7 +101,6 @@ IN: bootstrap.x86
     arg4 ds-reg [] MOV
     ds-reg bootstrap-cell SUB
     ! Get ctx->callstack_bottom
-    jit-load-vm
     jit-load-context
     arg1 ctx-reg context-callstack-bottom-offset [+] MOV
     ! Get top of callstack object -- 'src' for memcpy
@@ -133,7 +124,6 @@ IN: bootstrap.x86
 ] \ set-callstack define-sub-primitive
 
 [
-    jit-load-vm
     jit-save-context
     arg2 vm-reg MOV
     safe-reg 0 MOV "lazy_jit_compile" f rc-absolute-cell jit-dlsym
@@ -150,7 +140,6 @@ IN: bootstrap.x86
 ! These are always in tail position with an existing stack
 ! frame, and the stack. The frame setup takes this into account.
 : jit-inline-cache-miss ( -- )
-    jit-load-vm
     jit-save-context
     arg1 RBX MOV
     arg2 vm-reg MOV
@@ -171,7 +160,6 @@ IN: bootstrap.x86
 ! Overflowing fixnum arithmetic
 : jit-overflow ( insn func -- )
     ds-reg 8 SUB
-    jit-load-vm
     jit-save-context
     arg1 ds-reg [] MOV
     arg2 ds-reg 8 [+] MOV
@@ -192,7 +180,6 @@ IN: bootstrap.x86
 
 [
     ds-reg 8 SUB
-    jit-load-vm
     jit-save-context
     RCX ds-reg [] MOV
     RBX ds-reg 8 [+] MOV

basis/cpu/x86/bootstrap.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: bootstrap.image.private compiler.constants
 compiler.units cpu.x86.assembler cpu.x86.assembler.operands
@@ -30,6 +30,9 @@ big-endian off
     ! hurt on other platforms
     stack-reg 32 SUB
 
+    ! Load VM into vm-reg
+    vm-reg 0 MOV rc-absolute-cell rt-vm jit-rel
+
     ! Call into Factor code
     safe-reg 0 MOV rc-absolute-cell rt-xt jit-rel
     safe-reg CALL

basis/cpu/x86/x86.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs alien alien.c-types arrays strings
 cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
@@ -419,11 +419,7 @@ M: x86 %shl int-rep two-operand [ SHL ] emit-shift ;
 M: x86 %shr int-rep two-operand [ SHR ] emit-shift ;
 M: x86 %sar int-rep two-operand [ SAR ] emit-shift ;
 
-: %mov-vm-ptr ( reg -- )
+HOOK: %mov-vm-ptr cpu ( reg -- )
-    0 MOV 0 rc-absolute-cell rel-vm ;
-
-M: x86 %vm-field-ptr ( dst field -- )
-    [ 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 ;

vm/callbacks.cpp

@@ -19,13 +19,13 @@ void factor_vm::init_callbacks(cell size)
 	callbacks = new callback_heap(size,this);
 }
 
-void callback_heap::update(code_block *stub)
+void callback_heap::store_callback_operand(code_block *stub, cell index, cell value)
 {
 	tagged<array> code_template(parent->special_objects[CALLBACK_STUB]);
 
-	cell rel_class = untag_fixnum(array_nth(code_template.untagged(),1));
+	cell rel_class = untag_fixnum(array_nth(code_template.untagged(),3 * index + 1));
-	cell rel_type = untag_fixnum(array_nth(code_template.untagged(),2));
+	cell rel_type  = untag_fixnum(array_nth(code_template.untagged(),3 * index + 2));
-	cell offset = untag_fixnum(array_nth(code_template.untagged(),3));
+	cell offset    = untag_fixnum(array_nth(code_template.untagged(),3 * index + 3));
 
 	relocation_entry rel(
 		(relocation_type)rel_type,
@@ -33,8 +33,12 @@ void callback_heap::update(code_block *stub)
 		offset);
 
 	instruction_operand op(rel,stub,0);
-	op.store_value((cell)callback_xt(stub));
+	op.store_value(value);
+}
 
+void callback_heap::update(code_block *stub)
+{
+	store_callback_operand(stub,1,(cell)callback_xt(stub));
 	stub->flush_icache();
 }
 
@@ -58,22 +62,14 @@ code_block *callback_heap::add(cell owner, cell return_rewind)
 
 	memcpy(stub->xt(),insns->data<void>(),size);
 
+	/* Store VM pointer */
+	store_callback_operand(stub,0,(cell)parent);
+
 	/* On x86, the RET instruction takes an argument which depends on
 	the callback's calling convention */
-	if(array_capacity(code_template.untagged()) == 7)
+#if defined(FACTOR_X86) || defined(FACTOR_AMD64)
-	{
+	store_callback_operand(stub,2,return_rewind);
-		cell rel_class = untag_fixnum(array_nth(code_template.untagged(),4));
+#endif
-		cell rel_type = untag_fixnum(array_nth(code_template.untagged(),5));
-		cell offset = untag_fixnum(array_nth(code_template.untagged(),6));
-
-		relocation_entry rel(
-			(relocation_type)rel_type,
-			(relocation_class)rel_class,
-			offset);
-
-		instruction_operand op(rel,stub,0);
-		op.store_value(return_rewind);
-	}
 
 	update(stub);
 

vm/callbacks.hpp

@@ -38,7 +38,10 @@ struct callback_heap {
 		return w->xt;
 	}
 
+	void store_callback_operand(code_block *stub, cell index, cell value);
+
 	void update(code_block *stub);
+
 	code_block *add(cell owner, cell return_rewind);
 
 	void update();

vm/quotations.cpp

@@ -182,10 +182,10 @@ void quotation_jit::iterate_quotation()
 			/* Primitive calls */
 			if(primitive_call_p(i,length))
 			{
-				/* On PowerPC, the VM pointer is stored as a register; on other
+				/* On x86-64 and PowerPC, the VM pointer is stored in
-				   platforms, the RT_VM relocation is used and it needs an offset
+				a register; on other platforms, the RT_VM relocation
-				   parameter */
+				is used and it needs an offset parameter */
-#ifndef FACTOR_PPC
+#ifdef FACTOR_X86
 				parameter(tag_fixnum(0));
 #endif
 				parameter(obj.value());