Simplify JIT, fix tuples unit tests

core/bootstrap/image/image.factor

@@ -61,7 +61,6 @@ SYMBOL: bootstrap-boot-quot
 
 ! JIT parameters
 SYMBOL: jit-code-format
-SYMBOL: jit-setup
 SYMBOL: jit-prolog
 SYMBOL: jit-word-primitive-jump
 SYMBOL: jit-word-primitive-call
@@ -80,7 +79,6 @@ SYMBOL: jit-return
         { bootstrap-boot-quot 20 }
         { bootstrap-global 21 }
         { jit-code-format 22 }
-        { jit-setup 23 }
         { jit-prolog 24 }
         { jit-word-primitive-jump 25 }
         { jit-word-primitive-call 26 }
@@ -368,7 +366,6 @@ M: curry '
     \ dispatch jit-dispatch-word set
     {
         jit-code-format
-        jit-setup
         jit-prolog
         jit-word-primitive-jump
         jit-word-primitive-call

core/bootstrap/primitives.factor

@@ -602,7 +602,6 @@ builtins get num-tags get tail f union-class define-class
     { "innermost-frame-scan" "kernel.private" }
     { "set-innermost-frame-quot" "kernel.private" }
     { "call-clear" "kernel" }
-    { "strip-compiled-quotations" "quotations" }
     { "(os-envs)" "system" }
 }
 dup length [ >r first2 r> make-primitive ] 2each

core/cpu/x86/32/bootstrap.factor

@@ -10,7 +10,6 @@ IN: bootstrap.x86
 : arg1 EDX ;
 : stack-reg ESP ;
 : ds-reg ESI ;
-: scan-reg EBX ;
 : fixnum>slot@ arg0 1 SAR ;
 
 "resource:core/cpu/x86/bootstrap.factor" run-file

core/cpu/x86/bootstrap.factor

@@ -8,30 +8,18 @@ big-endian off
 
 1 jit-code-format set
 
-: stack-frame-size 8 bootstrap-cells ;
+: stack-frame-size 4 bootstrap-cells ;
-
-: scan-save stack-reg 3 bootstrap-cells [+] ;
 
 [
     arg0 0 [] MOV                              ! load quotation
     arg1 arg0 quot-xt@ [+] MOV                 ! load XT
-    arg0 arg0 quot-array@ [+] MOV              ! load array
-    scan-reg arg0 scan@ [+] LEA                ! initialize scan pointer
-] rc-absolute-cell rt-literal 2 jit-setup jit-define
-
-[
     stack-frame-size PUSH                      ! save stack frame size
     arg1 PUSH                                  ! save XT
-    arg0 PUSH                                  ! save array
+    arg1 PUSH                                  ! alignment
-    scan-reg PUSH                              ! initial scan
+] rc-absolute-cell rt-literal 2 jit-prolog jit-define
-    stack-reg 3 bootstrap-cells SUB            ! reserved
-] f f f jit-prolog jit-define
-
-: advance-scan scan-reg bootstrap-cell ADD ;
 
 [
     arg0 0 [] MOV                              ! load literal
-    advance-scan
     ds-reg bootstrap-cell ADD                  ! increment datastack pointer
     ds-reg [] arg0 MOV                         ! store literal on datastack
 ] rc-absolute-cell rt-literal 2 jit-push-literal jit-define
@@ -42,23 +30,17 @@ big-endian off
 ] rc-relative rt-primitive 3 jit-word-primitive-jump jit-define
 
 [
-    advance-scan
     arg1 stack-reg bootstrap-cell neg [+] LEA  ! pass callstack pointer as arg 2
-    scan-save scan-reg MOV                     ! save scan pointer
     (CALL) drop                                ! go
-    scan-reg scan-save MOV                     ! restore scan pointer
+] rc-relative rt-primitive 5 jit-word-primitive-call jit-define
-] rc-relative rt-primitive 12 jit-word-primitive-call jit-define
 
 [
     (JMP) drop
 ] rc-relative rt-xt 1 jit-word-jump jit-define
 
 [
-    advance-scan
-    scan-save scan-reg MOV                     ! save scan pointer
     (CALL) drop
-    scan-reg scan-save MOV                     ! restore scan pointer
+] rc-relative rt-xt 1 jit-word-call jit-define
-] rc-relative rt-xt 8 jit-word-call jit-define
 
 [
     arg1 0 MOV                                 ! load addr of true quotation

core/tuples/tuples-tests.factor

@@ -78,8 +78,6 @@ M: circle area circle-radius sq pi * ;
 
 [ 200 ] [ T{ rect f 0 0 10 20 } area ] unit-test
 
-[ ] [ "IN: temporary  SYMBOL: #x  TUPLE: #x ;" eval ] unit-test
-
 ! Hashcode breakage
 TUPLE: empty ;
 
@@ -216,25 +214,10 @@ SYMBOL: not-a-tuple-class
 [ not-a-tuple-class construct-boa ] unit-test-fails
 [ not-a-tuple-class construct-empty ] unit-test-fails
 
-TUPLE: erg's-reshape-problem a b c ;
+TUPLE: erg's-reshape-problem a b c d ;
 
 C: <erg's-reshape-problem> erg's-reshape-problem
 
-[ ] [
-    ! <erg's-reshape-problem> hasn't been recompiled yet, so
-    ! we just created a tuple using an obsolete layout
-    "IN: temporary USE: namespaces TUPLE: erg's-reshape-problem a b c d ; 1 2 3 <erg's-reshape-problem> \"a\" set" eval
-] unit-test
-
-[ 1 2 ] [
-    ! that's ok, but... this shouldn't fail:
-    "IN: temporary TUPLE: erg's-reshape-problem a b d c ;" eval
-
-    "a" get
-    { erg's-reshape-problem-a erg's-reshape-problem-b }
-    get-slots
-] unit-test
-
 ! We want to make sure constructors are recompiled when
 ! tuples are reshaped
 : cons-test-1 \ erg's-reshape-problem construct-empty ;

extra/tools/deploy/shaker/shaker.factor

@@ -90,8 +90,6 @@ IN: tools.deploy.shaker
     { } set-retainstack
     V{ } set-namestack
     V{ } set-catchstack
-    "Stripping compiled quotations" show
-    strip-compiled-quotations
     "Saving final image" show
     [ save-image-and-exit ] call-clear ;
 

vm/callstack.c

@@ -123,8 +123,9 @@ F_STACK_FRAME *frame_successor(F_STACK_FRAME *frame)
 
 CELL frame_scan(F_STACK_FRAME *frame)
 {
+	//XXX
 	if(frame_type(frame) == QUOTATION_TYPE)
-		return tag_fixnum(UNAREF(UNTAG(frame->array),frame->scan));
+		return tag_fixnum(0); //UNAREF(UNTAG(frame->array),frame->scan));
 	else
 		return F;
 }
@@ -213,11 +214,13 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
 	F_STACK_FRAME *inner = innermost_stack_frame(callstack);
 	type_check(QUOTATION_TYPE,frame_executing(inner));
 
-	CELL scan = inner->scan - inner->array;
+	//XXX
+
+	//CELL scan = inner->scan - inner->array;
 	CELL offset = FRAME_RETURN_ADDRESS(inner) - inner->xt;
 
-	inner->array = quot->array;
+	//inner->array = quot->array;
-	inner->scan = quot->array + scan;
+	//inner->scan = quot->array + scan;
 
 	inner->xt = quot->xt;
 

vm/data_gc.c

@@ -380,25 +380,20 @@ void collect_stack(F_SEGMENT *region, CELL top)
 
 void collect_stack_frame(F_STACK_FRAME *frame)
 {
-	if(frame_type(frame) == QUOTATION_TYPE)
-	{
-		CELL scan = frame->scan - frame->array;
-		copy_handle(&frame->array);
-		frame->scan = scan + frame->array;
-	}
-
-	if(collecting_code)
 	recursive_mark(compiled_to_block(frame_code(frame)));
 }
 
 /* The base parameter allows us to adjust for a heap-allocated
 callstack snapshot */
 void collect_callstack(F_CONTEXT *stacks)
+{
+	if(collecting_code)
 	{
 		CELL top = (CELL)stacks->callstack_top;
 		CELL bottom = (CELL)stacks->callstack_bottom;
 		iterate_callstack(top,bottom,collect_stack_frame);
 	}
+}
 
 void collect_gc_locals(void)
 {
@@ -541,6 +536,7 @@ CELL binary_payload_start(CELL pointer)
 
 void collect_callstack_object(F_CALLSTACK *callstack)
 {
+	if(collecting_code)
 		iterate_callstack_object(callstack,collect_stack_frame);
 }
 

vm/image.c

@@ -218,14 +218,6 @@ void fixup_alien(F_ALIEN *d)
 void fixup_stack_frame(F_STACK_FRAME *frame)
 {
 	code_fixup((CELL)&frame->xt);
-
-	if(frame_type(frame) == QUOTATION_TYPE)
-	{
-		CELL scan = frame->scan - frame->array;
-		data_fixup(&frame->array);
-		frame->scan = scan + frame->array;
-	}
-
 	code_fixup((CELL)&FRAME_RETURN_ADDRESS(frame));
 }
 

vm/layouts.h

@@ -258,17 +258,7 @@ typedef struct {
 
 typedef struct
 {
-	/* In compiled quotation frames, position within the array.
-	In compiled word frames, unused. */
-	CELL scan;
-
-	/* In compiled quotation frames, the quot->array slot.
-	In compiled word frames, unused. */
-	CELL array;
-
-	/* In all compiled frames, the XT on entry. */
 	XT xt;
-
 	/* Frame size in bytes */
 	CELL size;
 } F_STACK_FRAME;

vm/primitives.c

@@ -192,6 +192,5 @@ void *primitives[] = {
 	primitive_innermost_stack_frame_scan,
 	primitive_set_innermost_stack_frame_quot,
 	primitive_call_clear,
-	primitive_strip_compiled_quotations,
 	primitive_os_envs,
 };

vm/quotations.c

@@ -116,8 +116,6 @@ void jit_compile(CELL quot)
 
 	bool stack_frame = jit_stack_frame_p(untag_object(array));
 
-	EMIT(JIT_SETUP,0);
-
 	if(stack_frame)
 		EMIT(JIT_PROLOG,0);
 
@@ -316,23 +314,3 @@ DEFINE_PRIMITIVE(quotation_xt)
 	F_QUOTATION *quot = untag_quotation(dpeek());
 	drepl(allot_cell((CELL)quot->xt));
 }
-
-DEFINE_PRIMITIVE(strip_compiled_quotations)
-{
-	data_gc();
-	begin_scan();
-
-	CELL obj;
-	while((obj = next_object()) != F)
-	{
-		if(type_of(obj) == QUOTATION_TYPE)
-		{
-			F_QUOTATION *quot = untag_object(obj);
-			quot->compiledp = F;
-			quot->xt = lazy_jit_compile;
-		}
-	}
-
-	/* end scan */
-	gc_off = false;
-}

vm/quotations.h

@@ -6,4 +6,3 @@ DECLARE_PRIMITIVE(curry);
 DECLARE_PRIMITIVE(array_to_quotation);
 DECLARE_PRIMITIVE(quotation_xt);
 DECLARE_PRIMITIVE(uncurry);
-DECLARE_PRIMITIVE(strip_compiled_quotations);

vm/run.h

@@ -34,7 +34,7 @@ typedef enum {
 
 	/* Used by the JIT compiler */
 	JIT_CODE_FORMAT     = 22,
-	JIT_SETUP,
+	UNUSED_0,
 	JIT_PROLOG,
 	JIT_WORD_PRIMITIVE_JUMP,
 	JIT_WORD_PRIMITIVE_CALL,