From 4552e02624c22d7f6935e519a14a22a4a4bb65f4 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 18:29:07 +0100 Subject: [PATCH 01/20] made inline_gc a VM_C_API function --- basis/cpu/x86/32/32.factor | 13 +++++++++++++ basis/cpu/x86/64/64.factor | 10 ++++++++++ basis/cpu/x86/x86.factor | 10 ---------- vm/data_gc.cpp | 2 +- vm/data_gc.hpp | 2 +- 5 files changed, 25 insertions(+), 12 deletions(-) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 34d508fcf2..a687c9d6b0 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -311,6 +311,19 @@ M: x86.32 %callback-return ( n -- ) [ drop 0 ] } cond RET ; +M:: x86.32 %call-gc ( gc-root-count -- ) + EAX gc-root-base param@ LEA + 12 [ + push-vm-ptr + ! Pass number of roots as second parameter + temp-reg gc-root-count MOV + temp-reg PUSH + ! Pass pointer to start of GC roots as first parameter + EAX PUSH + ! Call GC + "inline_gc" f %alien-invoke + ] with-aligned-stack ; + M: x86.32 dummy-stack-params? f ; M: x86.32 dummy-int-params? f ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 8363f7a18b..cf90a47c0f 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -233,6 +233,16 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- ) func f %alien-invoke dst float-function-return ; +M:: x86.64 %call-gc ( gc-root-count -- ) + ! Pass pointer to start of GC roots as first parameter + param-reg-1 gc-root-base param@ LEA + ! Pass number of roots as second parameter + param-reg-2 gc-root-count MOV + ! Pass vm as third parameter + param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup + ! Call GC + "inline_gc" f %alien-invoke ; + ! The result of reading 4 bytes from memory is a fixnum on ! x86-64. enable-alien-4-intrinsics diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 25dca527f6..1d3125d997 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -828,16 +828,6 @@ M: x86 %save-gc-root ( gc-root register -- ) [ gc-root@ ] dip MOV ; M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ; -M:: x86 %call-gc ( gc-root-count -- ) - ! Pass pointer to start of GC roots as first parameter - param-reg-1 gc-root-base param@ LEA - ! Pass number of roots as second parameter - param-reg-2 gc-root-count MOV - ! Pass vm as third argument - param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup - ! Call GC - "inline_gc" f %alien-invoke ; - M: x86 %alien-global ( dst symbol library -- ) [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ; diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp index 590000611a..0c0b995732 100755 --- a/vm/data_gc.cpp +++ b/vm/data_gc.cpp @@ -681,7 +681,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size) gc_locals.pop_back(); } -VM_ASM_API_OVERFLOW void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm) +VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm) { ASSERTVM(); VM_PTR->inline_gc(gc_roots_base,gc_roots_size); diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp index 4ef89c2327..87c66f2433 100755 --- a/vm/data_gc.hpp +++ b/vm/data_gc.hpp @@ -20,6 +20,6 @@ PRIMITIVE(gc_stats); PRIMITIVE(clear_gc_stats); PRIMITIVE(become); struct factor_vm; -VM_ASM_API_OVERFLOW void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm); +VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm); } From a07a2f7496e2cbe7bd3146359461accb94d68de0 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 18:48:13 +0100 Subject: [PATCH 02/20] compiler.codegen passes temp reg to %call-gc --- basis/compiler/codegen/codegen.factor | 2 +- basis/cpu/architecture/architecture.factor | 2 +- basis/cpu/x86/32/32.factor | 12 ++++++------ basis/cpu/x86/64/64.factor | 2 +- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 150e65db3f..b2c1eed819 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -271,7 +271,7 @@ M: _gc generate-insn [ data-values>> save-data-regs ] [ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ] [ [ temp1>> ] [ temp2>> ] bi t %save-context ] - [ tagged-values>> length %call-gc ] + [ [ tagged-values>> length ] [ temp1>> ] bi %call-gc ] [ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ] [ data-values>> load-data-regs ] } cleave diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 3c5abf668a..066c445366 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -296,7 +296,7 @@ HOOK: %write-barrier cpu ( src card# table -- ) HOOK: %check-nursery cpu ( label temp1 temp2 -- ) HOOK: %save-gc-root cpu ( gc-root register -- ) HOOK: %load-gc-root cpu ( gc-root register -- ) -HOOK: %call-gc cpu ( gc-root-count -- ) +HOOK: %call-gc cpu ( gc-root-count temp1 -- ) HOOK: %prologue cpu ( n -- ) HOOK: %epilogue cpu ( n -- ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index a687c9d6b0..a2b089d90e 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -311,15 +311,15 @@ M: x86.32 %callback-return ( n -- ) [ drop 0 ] } cond RET ; -M:: x86.32 %call-gc ( gc-root-count -- ) - EAX gc-root-base param@ LEA +M:: x86.32 %call-gc ( gc-root-count temp1 -- ) + ! USE: prettyprint "PHIL" pprint temp1 pprint temp2 pprint + temp1 gc-root-base param@ LEA 12 [ - push-vm-ptr + 0 PUSH rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument ! Pass number of roots as second parameter - temp-reg gc-root-count MOV - temp-reg PUSH + gc-root-count PUSH ! Pass pointer to start of GC roots as first parameter - EAX PUSH + temp1 PUSH ! Call GC "inline_gc" f %alien-invoke ] with-aligned-stack ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index cf90a47c0f..e7ce0282af 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -233,7 +233,7 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- ) func f %alien-invoke dst float-function-return ; -M:: x86.64 %call-gc ( gc-root-count -- ) +M:: x86.64 %call-gc ( gc-root-count temp1 -- ) ! Pass pointer to start of GC roots as first parameter param-reg-1 gc-root-base param@ LEA ! Pass number of roots as second parameter From 68f85a69b33c13d0a0c495a689bd2dc620c54307 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 18:58:55 +0100 Subject: [PATCH 03/20] removed param-reg-* HOOKs --- basis/cpu/x86/32/32.factor | 5 ++--- basis/cpu/x86/64/64.factor | 6 +++--- basis/cpu/x86/x86.factor | 5 ----- 3 files changed, 5 insertions(+), 11 deletions(-) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index a2b089d90e..1b0170d14d 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -38,9 +38,8 @@ M:: x86.32 %dispatch ( src temp -- ) bi ; ! Registers for fastcall -M: x86.32 param-reg-1 EAX ; -M: x86.32 param-reg-2 EDX ; -M: x86.32 param-reg-3 ECX ; +: param-reg-1 ( -- reg ) EAX ; +: param-reg-2 ( -- reg ) EDX ; M: x86.32 pic-tail-reg EBX ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index e7ce0282af..c373b29a09 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -36,9 +36,9 @@ M:: x86.64 %dispatch ( src temp -- ) [ align-code ] bi ; -M: x86.64 param-reg-1 int-regs param-regs first ; -M: x86.64 param-reg-2 int-regs param-regs second ; -M: x86.64 param-reg-3 int-regs param-regs third ; +: param-reg-1 ( -- reg ) int-regs param-regs first ; inline +: param-reg-2 ( -- reg ) int-regs param-regs second ; inline +: param-reg-3 ( -- reg ) int-regs param-regs third ; inline M: x86.64 pic-tail-reg RBX ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 1d3125d997..d6bf8feaa1 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -52,11 +52,6 @@ M: x86 stack-frame-size ( stack-frame -- i ) ! use in calls in and out of C HOOK: temp-reg cpu ( -- reg ) -! Fastcall calling convention -HOOK: param-reg-1 cpu ( -- reg ) -HOOK: param-reg-2 cpu ( -- reg ) -HOOK: param-reg-3 cpu ( -- reg ) - HOOK: pic-tail-reg cpu ( -- reg ) M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ; From 28420c587a4e21993d191eef1d4a258224a85456 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 19:02:41 +0100 Subject: [PATCH 04/20] isolated %vm-invoke-blah-arg crap to 64.factor --- basis/cpu/architecture/architecture.factor | 3 --- basis/cpu/ppc/ppc.factor | 3 --- basis/cpu/x86/32/32.factor | 8 -------- basis/cpu/x86/64/64.factor | 4 ++-- 4 files changed, 2 insertions(+), 16 deletions(-) diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 066c445366..27677f2072 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -383,9 +383,6 @@ M: object %prepare-var-args ; HOOK: %alien-invoke cpu ( function library -- ) -HOOK: %vm-invoke-1st-arg cpu ( function -- ) -HOOK: %vm-invoke-3rd-arg cpu ( function -- ) - HOOK: %cleanup cpu ( params -- ) M: object %cleanup ( params -- ) drop ; diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 7e1060cbb9..3b46899659 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -40,9 +40,6 @@ enable-float-intrinsics M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ; -M: ppc %vm-invoke-1st-arg ( function -- ) f %alien-invoke ; -M: ppc %vm-invoke-3rd-arg ( function -- ) f %alien-invoke ; - M: ppc machine-registers { { int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] } diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 1b0170d14d..bcd11b9c40 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -51,14 +51,6 @@ M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument temp-reg PUSH ; -M: x86.32 %vm-invoke-1st-arg ( function -- ) - push-vm-ptr - f %alien-invoke - temp-reg POP ; - -M: x86.32 %vm-invoke-3rd-arg ( function -- ) - %vm-invoke-1st-arg ; ! first 2 args are regs, 3rd is stack so vm-invoke-1st-arg works here - M: x86.32 return-struct-in-registers? ( c-type -- ? ) c-type [ return-in-registers?>> ] diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index c373b29a09..9522f5b31c 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -74,7 +74,7 @@ M: x86.64 %prepare-unbox ( -- ) param-reg-1 R14 [] MOV R14 cell SUB ; -M: x86.64 %vm-invoke-1st-arg ( function -- ) +: %vm-invoke-1st-arg ( function -- ) param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup f %alien-invoke ; @@ -82,7 +82,7 @@ M: x86.64 %vm-invoke-1st-arg ( function -- ) param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup f %alien-invoke ; -M: x86.64 %vm-invoke-3rd-arg ( function -- ) +: %vm-invoke-3rd-arg ( function -- ) param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup f %alien-invoke ; From d457df1fbfd478833cf48b5020c138fd05575fcf Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 19:32:08 +0100 Subject: [PATCH 05/20] moved %(un)nest-stacks out to cpu specific files to eliminate %vm-invoke from compiler.codegen --- basis/compiler/codegen/codegen.factor | 4 +--- basis/cpu/architecture/architecture.factor | 4 ++++ basis/cpu/ppc/ppc.factor | 6 ++++++ basis/cpu/x86/32/32.factor | 16 ++++++++++++++-- basis/cpu/x86/64/64.factor | 7 +++++++ 5 files changed, 32 insertions(+), 5 deletions(-) diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index b2c1eed819..9ac6a87b37 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -447,7 +447,7 @@ M: ##alien-indirect generate-insn ! Generate code for boxing input parameters in a callback. [ dup \ %save-param-reg move-parameters - "nest_stacks" %vm-invoke-1st-arg + %nest-stacks box-parameters ] with-param-regs ; @@ -485,8 +485,6 @@ TUPLE: callback-context ; [ callback-context new do-callback ] % ] [ ] make ; -: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke-1st-arg ; - M: ##callback-return generate-insn #! All the extra book-keeping for %unwind is only for x86. #! On other platforms its an alias for %return. diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 27677f2072..eb3c432101 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -395,6 +395,10 @@ HOOK: %alien-callback cpu ( quot -- ) HOOK: %callback-value cpu ( ctype -- ) +HOOK: %nest-stacks cpu ( -- ) + +HOOK: %unnest-stacks cpu ( -- ) + ! Return to caller with stdcall unwinding (only for x86) HOOK: %callback-return cpu ( params -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 3b46899659..eabac51db5 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -778,6 +778,12 @@ M: ppc %box-small-struct ( c-type -- ) 4 3 4 LWZ 3 3 0 LWZ ; +M: ppc %nest-stacks ( -- ) + "nest_stacks" f %alien-invoke ; + +M: ppc %unnest-stacks ( -- ) + "unnest_stacks" f %alien-invoke ; + M: ppc %unbox-small-struct ( size -- ) #! Alien must be in EAX. heap-size cell align cell /i { diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index bcd11b9c40..84294b4912 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -48,8 +48,7 @@ M: x86.32 reserved-area-size 0 ; M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; : push-vm-ptr ( -- ) - temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument - temp-reg PUSH ; + 0 PUSH rc-absolute-cell rt-vm rel-fixup ; ! push the vm ptr as an argument M: x86.32 return-struct-in-registers? ( c-type -- ? ) c-type @@ -238,6 +237,18 @@ M:: x86.32 %unbox-large-struct ( n c-type -- ) "to_value_struct" f %alien-invoke ] with-aligned-stack ; +M: x86.32 %nest-stacks ( -- ) + 4 [ + push-vm-ptr + "nest_stacks" f %alien-invoke + ] with-aligned-stack ; + +M: x86.32 %unnest-stacks ( -- ) + 4 [ + push-vm-ptr + "unnest_stacks" f %alien-invoke + ] with-aligned-stack ; + M: x86.32 %prepare-alien-indirect ( -- ) push-vm-ptr "unbox_alien" f %alien-invoke temp-reg POP @@ -271,6 +282,7 @@ M: x86.32 %callback-value ( ctype -- ) ! Unbox EAX unbox-return ; + M: x86.32 %cleanup ( params -- ) #! a) If we just called an stdcall function in Windows, it #! cleaned up the stack frame for us. But we don't want that diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 9522f5b31c..cd410780b5 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -190,6 +190,13 @@ M: x86.64 %alien-invoke rc-absolute-cell rel-dlsym R11 CALL ; +M: x86.64 %nest-stacks ( -- ) + param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup + "nest_stacks" f %alien-invoke ; + +M: x86.64 %unnest-stacks ( -- ) + param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup + "unnest_stacks" f %alien-invoke ; M: x86.64 %prepare-alien-indirect ( -- ) "unbox_alien" %vm-invoke-1st-arg From 46f90c75880d03dc490e20b5db5e39a50926a154 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 20:03:03 +0100 Subject: [PATCH 06/20] removed %vm-invoke-*-arg completely --- basis/cpu/x86/64/64.factor | 49 +++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 27 deletions(-) diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index cd410780b5..dfe537baa3 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -39,6 +39,7 @@ M:: x86.64 %dispatch ( src temp -- ) : param-reg-1 ( -- reg ) int-regs param-regs first ; inline : param-reg-2 ( -- reg ) int-regs param-regs second ; inline : param-reg-3 ( -- reg ) int-regs param-regs third ; inline +: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline M: x86.64 pic-tail-reg RBX ; @@ -74,26 +75,13 @@ M: x86.64 %prepare-unbox ( -- ) param-reg-1 R14 [] MOV R14 cell SUB ; -: %vm-invoke-1st-arg ( function -- ) - param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup - f %alien-invoke ; - -: %vm-invoke-2nd-arg ( function -- ) - param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup - f %alien-invoke ; - -: %vm-invoke-3rd-arg ( function -- ) - param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup - f %alien-invoke ; - -: %vm-invoke-4th-arg ( function -- ) - int-regs param-regs fourth 0 MOV rc-absolute-cell rt-vm rel-fixup - f %alien-invoke ; - +: %mov-vm-ptr ( reg -- ) + 0 MOV rc-absolute-cell rt-vm rel-fixup ; M:: x86.64 %unbox ( n rep func -- ) + param-reg-2 %mov-vm-ptr ! Call the unboxer - func %vm-invoke-2nd-arg + func f %alien-invoke ! Store the return value on the C stack if this is an ! alien-invoke, otherwise leave it the return register if ! this is the end of alien-callback @@ -109,10 +97,10 @@ M: x86.64 %unbox-long-long ( n func -- ) { float-regs [ float-regs get pop swap MOVSD ] } } case ; - M: x86.64 %unbox-small-struct ( c-type -- ) ! Alien must be in param-reg-1. - "alien_offset" %vm-invoke-2nd-arg + param-reg-2 %mov-vm-ptr + "alien_offset" f %alien-invoke ! Move alien_offset() return value to R11 so that we don't ! clobber it. R11 RAX MOV @@ -126,8 +114,9 @@ M:: x86.64 %unbox-large-struct ( n c-type -- ) param-reg-2 n param@ LEA ! Load structure size into param-reg-3 param-reg-3 c-type heap-size MOV + param-reg-4 %mov-vm-ptr ! Copy the struct to the C stack - "to_value_struct" %vm-invoke-4th-arg ; + "to_value_struct" f %alien-invoke ; : load-return-value ( rep -- ) [ [ 0 ] dip reg-class-of param-reg ] @@ -143,7 +132,8 @@ M:: x86.64 %box ( n rep func -- ) ] [ rep load-return-value ] if - rep int-rep? [ func %vm-invoke-2nd-arg ] [ func %vm-invoke-1st-arg ] if ; + rep int-rep? [ param-reg-2 ] [ param-reg-1 ] if %mov-vm-ptr + func f %alien-invoke ; M: x86.64 %box-long-long ( n func -- ) [ int-rep ] dip %box ; @@ -163,7 +153,8 @@ M: x86.64 %box-small-struct ( c-type -- ) [ param-reg-3 swap heap-size MOV ] bi param-reg-1 0 box-struct-field@ MOV param-reg-2 1 box-struct-field@ MOV - "box_small_struct" %vm-invoke-4th-arg + param-reg-4 %mov-vm-ptr + "box_small_struct" f %alien-invoke ] with-return-regs ; : struct-return@ ( n -- operand ) @@ -174,8 +165,9 @@ M: x86.64 %box-large-struct ( n c-type -- ) param-reg-2 swap heap-size MOV ! Compute destination address param-reg-1 swap struct-return@ LEA + param-reg-3 %mov-vm-ptr ! Copy the struct from the C stack - "box_value_struct" %vm-invoke-3rd-arg ; + "box_value_struct" f %alien-invoke ; M: x86.64 %prepare-box-struct ( -- ) ! Compute target address for value struct return @@ -199,7 +191,8 @@ M: x86.64 %unnest-stacks ( -- ) "unnest_stacks" f %alien-invoke ; M: x86.64 %prepare-alien-indirect ( -- ) - "unbox_alien" %vm-invoke-1st-arg + param-reg-1 %mov-vm-ptr + "unbox_alien" f %alien-invoke RBP RAX MOV ; M: x86.64 %alien-indirect ( -- ) @@ -207,7 +200,8 @@ M: x86.64 %alien-indirect ( -- ) M: x86.64 %alien-callback ( quot -- ) param-reg-1 swap %load-reference - "c_to_factor" %vm-invoke-2nd-arg ; + param-reg-2 %mov-vm-ptr + "c_to_factor" f %alien-invoke ; M: x86.64 %callback-value ( ctype -- ) ! Save top of data stack @@ -215,8 +209,9 @@ M: x86.64 %callback-value ( ctype -- ) ! Save top of data stack RSP 8 SUB param-reg-1 PUSH + param-reg-1 %mov-vm-ptr ! Restore data/call/retain stacks - "unnest_stacks" %vm-invoke-1st-arg + "unnest_stacks" f %alien-invoke ! Put former top of data stack in param-reg-1 param-reg-1 POP RSP 8 ADD @@ -246,7 +241,7 @@ M:: x86.64 %call-gc ( gc-root-count temp1 -- ) ! Pass number of roots as second parameter param-reg-2 gc-root-count MOV ! Pass vm as third parameter - param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup + param-reg-3 %mov-vm-ptr ! Call GC "inline_gc" f %alien-invoke ; From e26bbbe9a0931f5284c1816b60d9da5691b21ea3 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 20:33:38 +0100 Subject: [PATCH 07/20] removed VM_ASM_API_OVERFLOW (VM_ASM_API now regparm(3)) --- vm/callstack.hpp | 2 +- vm/cpu-ppc.hpp | 1 - vm/cpu-x86.32.S | 2 +- vm/cpu-x86.32.hpp | 3 +-- vm/cpu-x86.64.hpp | 1 - vm/cpu-x86.hpp | 2 +- vm/math.cpp | 6 +++--- vm/math.hpp | 6 +++--- vm/quotations.cpp | 2 +- vm/quotations.hpp | 2 +- 10 files changed, 12 insertions(+), 15 deletions(-) diff --git a/vm/callstack.hpp b/vm/callstack.hpp index ae1e80ca9a..1ea98f883c 100755 --- a/vm/callstack.hpp +++ b/vm/callstack.hpp @@ -13,7 +13,7 @@ PRIMITIVE(innermost_stack_frame_executing); PRIMITIVE(innermost_stack_frame_scan); PRIMITIVE(set_innermost_stack_frame_quot); -VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom,factor_vm *vm); +VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *vm); } diff --git a/vm/cpu-ppc.hpp b/vm/cpu-ppc.hpp index d0036fb84f..495eb375ec 100644 --- a/vm/cpu-ppc.hpp +++ b/vm/cpu-ppc.hpp @@ -3,7 +3,6 @@ namespace factor #define FACTOR_CPU_STRING "ppc" #define VM_ASM_API VM_C_API -#define VM_ASM_API_OVERFLOW VM_C_API register cell ds asm("r13"); register cell rs asm("r14"); diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S index 3eeb798093..4f06de1ce7 100644 --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -82,7 +82,7 @@ DEF(void,set_x87_env,(const void*)): ret DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)): - mov CELL_SIZE(STACK_REG),NV_TEMP_REG /* get vm ptr in case quot_xt = lazy_jit_compile */ + mov ARG2,NV_TEMP_REG /* remember vm ptr in case quot_xt = lazy_jit_compile */ /* clear x87 stack, but preserve rounding mode and exception flags */ sub $2,STACK_REG fnstcw (STACK_REG) diff --git a/vm/cpu-x86.32.hpp b/vm/cpu-x86.32.hpp index a95179a49b..e740771470 100644 --- a/vm/cpu-x86.32.hpp +++ b/vm/cpu-x86.32.hpp @@ -6,6 +6,5 @@ namespace factor register cell ds asm("esi"); register cell rs asm("edi"); -#define VM_ASM_API VM_C_API __attribute__ ((regparm (2))) -#define VM_ASM_API_OVERFLOW VM_C_API __attribute__ ((regparm (3))) +#define VM_ASM_API VM_C_API __attribute__ ((regparm (3))) } diff --git a/vm/cpu-x86.64.hpp b/vm/cpu-x86.64.hpp index 841705c171..75d432ee13 100644 --- a/vm/cpu-x86.64.hpp +++ b/vm/cpu-x86.64.hpp @@ -7,5 +7,4 @@ register cell ds asm("r14"); register cell rs asm("r15"); #define VM_ASM_API VM_C_API -#define VM_ASM_API_OVERFLOW VM_C_API } diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp index 8fe0cc4b10..9074bc1a71 100644 --- a/vm/cpu-x86.hpp +++ b/vm/cpu-x86.hpp @@ -69,7 +69,7 @@ inline static unsigned int fpu_status(unsigned int status) } /* Defined in assembly */ -VM_ASM_API void c_to_factor(cell quot,void *vm); +VM_ASM_API void c_to_factor(cell quot, void *vm); VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to, void *vm); VM_ASM_API void lazy_jit_compile(cell quot, void *vm); diff --git a/vm/math.cpp b/vm/math.cpp index 61ec096c59..638d9fa85c 100755 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -838,7 +838,7 @@ inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y) untag_fixnum(x) + untag_fixnum(y)))); } -VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *myvm) +VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *myvm) { PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y); } @@ -849,7 +849,7 @@ inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y) untag_fixnum(x) - untag_fixnum(y)))); } -VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *myvm) +VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *myvm) { PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y); } @@ -863,7 +863,7 @@ inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y) drepl(tag(bignum_multiply(bx,by))); } -VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *myvm) +VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *myvm) { PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y); } diff --git a/vm/math.hpp b/vm/math.hpp index a82a9a9580..f81de37650 100644 --- a/vm/math.hpp +++ b/vm/math.hpp @@ -83,8 +83,8 @@ VM_C_API u64 to_unsigned_8(cell obj, factor_vm *vm); VM_C_API fixnum to_fixnum(cell tagged, factor_vm *vm); VM_C_API cell to_cell(cell tagged, factor_vm *vm); -VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *vm); -VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *vm); -VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *vm); +VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *vm); +VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *vm); +VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *vm); } diff --git a/vm/quotations.cpp b/vm/quotations.cpp index e5a2a53f86..1bc6240481 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -368,7 +368,7 @@ cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack) return quot.value(); } -VM_ASM_API_OVERFLOW cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm) +VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm) { ASSERTVM(); return VM_PTR->lazy_jit_compile_impl(quot_,stack); diff --git a/vm/quotations.hpp b/vm/quotations.hpp index 43beb05112..b21884a35b 100755 --- a/vm/quotations.hpp +++ b/vm/quotations.hpp @@ -27,7 +27,7 @@ PRIMITIVE(jit_compile); PRIMITIVE(array_to_quotation); PRIMITIVE(quotation_xt); -VM_ASM_API_OVERFLOW cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm); +VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm); PRIMITIVE(quot_compiled_p); From 6b7717bf3729775538be433ac750b31b22cfcade Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Sep 2009 20:43:01 +0100 Subject: [PATCH 08/20] forwarding functions replaced with PRIMITIVE_FORWARD() macro --- vm/alien.cpp | 35 ++----- vm/arrays.cpp | 10 +- vm/byte_arrays.cpp | 15 +-- vm/callstack.cpp | 30 ++---- vm/code_heap.cpp | 10 +- vm/contexts.cpp | 25 +---- vm/data_gc.cpp | 20 +--- vm/data_heap.cpp | 25 +---- vm/debug.cpp | 5 +- vm/dispatch.cpp | 20 +--- vm/errors.cpp | 10 +- vm/image.cpp | 10 +- vm/inline_cache.cpp | 10 +- vm/io.cpp | 40 ++------ vm/math.cpp | 220 +++++++++---------------------------------- vm/os-unix.cpp | 5 +- vm/os-windows-ce.cpp | 5 +- vm/os-windows.cpp | 5 +- vm/primitives.hpp | 9 +- vm/profiler.cpp | 5 +- vm/quotations.cpp | 20 +--- vm/run.cpp | 40 ++------ vm/strings.cpp | 25 +---- vm/tuples.cpp | 10 +- vm/words.cpp | 20 +--- 25 files changed, 132 insertions(+), 497 deletions(-) diff --git a/vm/alien.cpp b/vm/alien.cpp index 0242c12c9e..2f82071aa8 100755 --- a/vm/alien.cpp +++ b/vm/alien.cpp @@ -69,10 +69,7 @@ inline void factor_vm::primitive_displaced_alien() } } -PRIMITIVE(displaced_alien) -{ - PRIMITIVE_GETVM()->primitive_displaced_alien(); -} +PRIMITIVE_FORWARD(displaced_alien) /* address of an object representing a C pointer. Explicitly throw an error if the object is a byte array, as a sanity check. */ @@ -81,10 +78,7 @@ inline void factor_vm::primitive_alien_address() box_unsigned_cell((cell)pinned_alien_offset(dpop())); } -PRIMITIVE(alien_address) -{ - PRIMITIVE_GETVM()->primitive_alien_address(); -} +PRIMITIVE_FORWARD(alien_address) /* pop ( alien n ) from datastack, return alien's address plus n */ void *factor_vm::alien_pointer() @@ -131,10 +125,7 @@ inline void factor_vm::primitive_dlopen() dpush(library.value()); } -PRIMITIVE(dlopen) -{ - PRIMITIVE_GETVM()->primitive_dlopen(); -} +PRIMITIVE_FORWARD(dlopen) /* look up a symbol in a native library */ inline void factor_vm::primitive_dlsym() @@ -158,10 +149,7 @@ inline void factor_vm::primitive_dlsym() } } -PRIMITIVE(dlsym) -{ - PRIMITIVE_GETVM()->primitive_dlsym(); -} +PRIMITIVE_FORWARD(dlsym) /* close a native library handle */ inline void factor_vm::primitive_dlclose() @@ -171,10 +159,7 @@ inline void factor_vm::primitive_dlclose() ffi_dlclose(d); } -PRIMITIVE(dlclose) -{ - PRIMITIVE_GETVM()->primitive_dlclose(); -} +PRIMITIVE_FORWARD(dlclose) inline void factor_vm::primitive_dll_validp() { @@ -185,10 +170,7 @@ inline void factor_vm::primitive_dll_validp() dpush(untag_check(library)->dll == NULL ? F : T); } -PRIMITIVE(dll_validp) -{ - PRIMITIVE_GETVM()->primitive_dll_validp(); -} +PRIMITIVE_FORWARD(dll_validp) /* gets the address of an object representing a C pointer */ char *factor_vm::alien_offset(cell obj) @@ -308,9 +290,6 @@ inline void factor_vm::primitive_vm_ptr() box_alien(this); } -PRIMITIVE(vm_ptr) -{ - PRIMITIVE_GETVM()->primitive_vm_ptr(); -} +PRIMITIVE_FORWARD(vm_ptr) } diff --git a/vm/arrays.cpp b/vm/arrays.cpp index a50500a2db..4188c8bf0b 100644 --- a/vm/arrays.cpp +++ b/vm/arrays.cpp @@ -31,10 +31,7 @@ inline void factor_vm::primitive_array() dpush(tag(allot_array(size,initial))); } -PRIMITIVE(array) -{ - PRIMITIVE_GETVM()->primitive_array(); -} +PRIMITIVE_FORWARD(array) cell factor_vm::allot_array_1(cell obj_) { @@ -75,10 +72,7 @@ inline void factor_vm::primitive_resize_array() dpush(tag(reallot_array(a,capacity))); } -PRIMITIVE(resize_array) -{ - PRIMITIVE_GETVM()->primitive_resize_array(); -} +PRIMITIVE_FORWARD(resize_array) void growable_array::add(cell elt_) { diff --git a/vm/byte_arrays.cpp b/vm/byte_arrays.cpp index 4213ed45a8..9af981e61e 100644 --- a/vm/byte_arrays.cpp +++ b/vm/byte_arrays.cpp @@ -16,10 +16,7 @@ inline void factor_vm::primitive_byte_array() dpush(tag(allot_byte_array(size))); } -PRIMITIVE(byte_array) -{ - PRIMITIVE_GETVM()->primitive_byte_array(); -} +PRIMITIVE_FORWARD(byte_array) inline void factor_vm::primitive_uninitialized_byte_array() { @@ -27,10 +24,7 @@ inline void factor_vm::primitive_uninitialized_byte_array() dpush(tag(allot_array_internal(size))); } -PRIMITIVE(uninitialized_byte_array) -{ - PRIMITIVE_GETVM()->primitive_uninitialized_byte_array(); -} +PRIMITIVE_FORWARD(uninitialized_byte_array) inline void factor_vm::primitive_resize_byte_array() { @@ -39,10 +33,7 @@ inline void factor_vm::primitive_resize_byte_array() dpush(tag(reallot_array(array,capacity))); } -PRIMITIVE(resize_byte_array) -{ - PRIMITIVE_GETVM()->primitive_resize_byte_array(); -} +PRIMITIVE_FORWARD(resize_byte_array) void growable_byte_array::append_bytes(void *elts, cell len) { diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 445ebf88ee..3518feafc1 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -60,10 +60,7 @@ inline void factor_vm::primitive_callstack() dpush(tag(stack)); } -PRIMITIVE(callstack) -{ - PRIMITIVE_GETVM()->primitive_callstack(); -} +PRIMITIVE_FORWARD(callstack) inline void factor_vm::primitive_set_callstack() { @@ -78,10 +75,7 @@ inline void factor_vm::primitive_set_callstack() critical_error("Bug in set_callstack()",0); } -PRIMITIVE(set_callstack) -{ - PRIMITIVE_GETVM()->primitive_set_callstack(); -} +PRIMITIVE_FORWARD(set_callstack) code_block *factor_vm::frame_code(stack_frame *frame) { @@ -172,10 +166,7 @@ inline void factor_vm::primitive_callstack_to_array() dpush(accum.frames.elements.value()); } -PRIMITIVE(callstack_to_array) -{ - PRIMITIVE_GETVM()->primitive_callstack_to_array(); -} +PRIMITIVE_FORWARD(callstack_to_array) stack_frame *factor_vm::innermost_stack_frame(callstack *stack) { @@ -203,20 +194,14 @@ inline void factor_vm::primitive_innermost_stack_frame_executing() dpush(frame_executing(innermost_stack_frame(untag_check(dpop())))); } -PRIMITIVE(innermost_stack_frame_executing) -{ - PRIMITIVE_GETVM()->primitive_innermost_stack_frame_executing(); -} +PRIMITIVE_FORWARD(innermost_stack_frame_executing) inline void factor_vm::primitive_innermost_stack_frame_scan() { dpush(frame_scan(innermost_stack_frame_quot(untag_check(dpop())))); } -PRIMITIVE(innermost_stack_frame_scan) -{ - PRIMITIVE_GETVM()->primitive_innermost_stack_frame_scan(); -} +PRIMITIVE_FORWARD(innermost_stack_frame_scan) inline void factor_vm::primitive_set_innermost_stack_frame_quot() { @@ -234,10 +219,7 @@ inline void factor_vm::primitive_set_innermost_stack_frame_quot() FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset; } -PRIMITIVE(set_innermost_stack_frame_quot) -{ - PRIMITIVE_GETVM()->primitive_set_innermost_stack_frame_quot(); -} +PRIMITIVE_FORWARD(set_innermost_stack_frame_quot) /* called before entry into Factor code. */ void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom) diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index b2361d94ce..7d70b4c254 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -106,10 +106,7 @@ inline void factor_vm::primitive_modify_code_heap() update_code_heap_words(); } -PRIMITIVE(modify_code_heap) -{ - PRIMITIVE_GETVM()->primitive_modify_code_heap(); -} +PRIMITIVE_FORWARD(modify_code_heap) /* Push the free space and total size of the code heap */ inline void factor_vm::primitive_code_room() @@ -122,10 +119,7 @@ inline void factor_vm::primitive_code_room() dpush(tag_fixnum(max_free / 1024)); } -PRIMITIVE(code_room) -{ - PRIMITIVE_GETVM()->primitive_code_room(); -} +PRIMITIVE_FORWARD(code_room) code_block *factor_vm::forward_xt(code_block *compiled) { diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 6e821552ed..6e51ed8ba9 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -146,10 +146,7 @@ inline void factor_vm::primitive_datastack() general_error(ERROR_DS_UNDERFLOW,F,F,NULL); } -PRIMITIVE(datastack) -{ - PRIMITIVE_GETVM()->primitive_datastack(); -} +PRIMITIVE_FORWARD(datastack) inline void factor_vm::primitive_retainstack() { @@ -157,10 +154,7 @@ inline void factor_vm::primitive_retainstack() general_error(ERROR_RS_UNDERFLOW,F,F,NULL); } -PRIMITIVE(retainstack) -{ - PRIMITIVE_GETVM()->primitive_retainstack(); -} +PRIMITIVE_FORWARD(retainstack) /* returns pointer to top of stack */ cell factor_vm::array_to_stack(array *array, cell bottom) @@ -175,20 +169,14 @@ inline void factor_vm::primitive_set_datastack() ds = array_to_stack(untag_check(dpop()),ds_bot); } -PRIMITIVE(set_datastack) -{ - PRIMITIVE_GETVM()->primitive_set_datastack(); -} +PRIMITIVE_FORWARD(set_datastack) inline void factor_vm::primitive_set_retainstack() { rs = array_to_stack(untag_check(dpop()),rs_bot); } -PRIMITIVE(set_retainstack) -{ - PRIMITIVE_GETVM()->primitive_set_retainstack(); -} +PRIMITIVE_FORWARD(set_retainstack) /* Used to implement call( */ inline void factor_vm::primitive_check_datastack() @@ -216,9 +204,6 @@ inline void factor_vm::primitive_check_datastack() } } -PRIMITIVE(check_datastack) -{ - PRIMITIVE_GETVM()->primitive_check_datastack(); -} +PRIMITIVE_FORWARD(check_datastack) } diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp index 0c0b995732..18c38cade3 100755 --- a/vm/data_gc.cpp +++ b/vm/data_gc.cpp @@ -573,10 +573,7 @@ inline void factor_vm::primitive_gc() gc(); } -PRIMITIVE(gc) -{ - PRIMITIVE_GETVM()->primitive_gc(); -} +PRIMITIVE_FORWARD(gc) inline void factor_vm::primitive_gc_stats() { @@ -608,10 +605,7 @@ inline void factor_vm::primitive_gc_stats() dpush(result.elements.value()); } -PRIMITIVE(gc_stats) -{ - PRIMITIVE_GETVM()->primitive_gc_stats(); -} +PRIMITIVE_FORWARD(gc_stats) void factor_vm::clear_gc_stats() { @@ -629,10 +623,7 @@ inline void factor_vm::primitive_clear_gc_stats() clear_gc_stats(); } -PRIMITIVE(clear_gc_stats) -{ - PRIMITIVE_GETVM()->primitive_clear_gc_stats(); -} +PRIMITIVE_FORWARD(clear_gc_stats) /* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this to coalesce equal but distinct quotations and wrappers. */ @@ -665,10 +656,7 @@ inline void factor_vm::primitive_become() compile_all_words(); } -PRIMITIVE(become) -{ - PRIMITIVE_GETVM()->primitive_become(); -} +PRIMITIVE_FORWARD(become) void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size) { diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 72bc9c5d84..5eaa715e6c 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -222,10 +222,7 @@ inline void factor_vm::primitive_size() box_unsigned_cell(object_size(dpop())); } -PRIMITIVE(size) -{ - PRIMITIVE_GETVM()->primitive_size(); -} +PRIMITIVE_FORWARD(size) /* The number of cells from the start of the object which should be scanned by the GC. Some types have a binary payload at the end (string, word, DLL) which @@ -284,10 +281,7 @@ inline void factor_vm::primitive_data_room() dpush(a.elements.value()); } -PRIMITIVE(data_room) -{ - PRIMITIVE_GETVM()->primitive_data_room(); -} +PRIMITIVE_FORWARD(data_room) /* Disables GC and activates next-object ( -- obj ) primitive */ void factor_vm::begin_scan() @@ -306,10 +300,7 @@ inline void factor_vm::primitive_begin_scan() begin_scan(); } -PRIMITIVE(begin_scan) -{ - PRIMITIVE_GETVM()->primitive_begin_scan(); -} +PRIMITIVE_FORWARD(begin_scan) cell factor_vm::next_object() { @@ -330,10 +321,7 @@ inline void factor_vm::primitive_next_object() dpush(next_object()); } -PRIMITIVE(next_object) -{ - PRIMITIVE_GETVM()->primitive_next_object(); -} +PRIMITIVE_FORWARD(next_object) /* Re-enables GC */ inline void factor_vm::primitive_end_scan() @@ -341,10 +329,7 @@ inline void factor_vm::primitive_end_scan() gc_off = false; } -PRIMITIVE(end_scan) -{ - PRIMITIVE_GETVM()->primitive_end_scan(); -} +PRIMITIVE_FORWARD(end_scan) template void factor_vm::each_object(TYPE &functor) { diff --git a/vm/debug.cpp b/vm/debug.cpp index 2b8264ee41..1ec73760d3 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -484,9 +484,6 @@ inline void factor_vm::primitive_die() factorbug(); } -PRIMITIVE(die) -{ - PRIMITIVE_GETVM()->primitive_die(); -} +PRIMITIVE_FORWARD(die) } diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp index 1e13e90d5a..c283a3b9d7 100755 --- a/vm/dispatch.cpp +++ b/vm/dispatch.cpp @@ -120,10 +120,7 @@ inline void factor_vm::primitive_lookup_method() dpush(lookup_method(obj,methods)); } -PRIMITIVE(lookup_method) -{ - PRIMITIVE_GETVM()->primitive_lookup_method(); -} +PRIMITIVE_FORWARD(lookup_method) cell factor_vm::object_class(cell obj) { @@ -169,20 +166,14 @@ inline void factor_vm::primitive_mega_cache_miss() dpush(method); } -PRIMITIVE(mega_cache_miss) -{ - PRIMITIVE_GETVM()->primitive_mega_cache_miss(); -} +PRIMITIVE_FORWARD(mega_cache_miss) inline void factor_vm::primitive_reset_dispatch_stats() { megamorphic_cache_hits = megamorphic_cache_misses = 0; } -PRIMITIVE(reset_dispatch_stats) -{ - PRIMITIVE_GETVM()->primitive_reset_dispatch_stats(); -} +PRIMITIVE_FORWARD(reset_dispatch_stats) inline void factor_vm::primitive_dispatch_stats() { @@ -193,10 +184,7 @@ inline void factor_vm::primitive_dispatch_stats() dpush(stats.elements.value()); } -PRIMITIVE(dispatch_stats) -{ - PRIMITIVE_GETVM()->primitive_dispatch_stats(); -} +PRIMITIVE_FORWARD(dispatch_stats) void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_) { diff --git a/vm/errors.cpp b/vm/errors.cpp index 4d9d06f7e2..78a6652902 100755 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -133,10 +133,7 @@ inline void factor_vm::primitive_call_clear() throw_impl(dpop(),stack_chain->callstack_bottom,this); } -PRIMITIVE(call_clear) -{ - PRIMITIVE_GETVM()->primitive_call_clear(); -} +PRIMITIVE_FORWARD(call_clear) /* For testing purposes */ inline void factor_vm::primitive_unimplemented() @@ -144,10 +141,7 @@ inline void factor_vm::primitive_unimplemented() not_implemented_error(); } -PRIMITIVE(unimplemented) -{ - PRIMITIVE_GETVM()->primitive_unimplemented(); -} +PRIMITIVE_FORWARD(unimplemented) void factor_vm::memory_signal_handler_impl() { diff --git a/vm/image.cpp b/vm/image.cpp index 61b0de1b2a..ade654c2e2 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -128,10 +128,7 @@ inline void factor_vm::primitive_save_image() save_image((vm_char *)(path.untagged() + 1)); } -PRIMITIVE(save_image) -{ - PRIMITIVE_GETVM()->primitive_save_image(); -} +PRIMITIVE_FORWARD(save_image) inline void factor_vm::primitive_save_image_and_exit() { @@ -159,10 +156,7 @@ inline void factor_vm::primitive_save_image_and_exit() exit(1); } -PRIMITIVE(save_image_and_exit) -{ - PRIMITIVE_GETVM()->primitive_save_image_and_exit(); -} +PRIMITIVE_FORWARD(save_image_and_exit) void factor_vm::data_fixup(cell *cell) { diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 9bb1d1c2f1..71076821b5 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -257,10 +257,7 @@ inline void factor_vm::primitive_reset_inline_cache_stats() for(i = 0; i < 4; i++) pic_counts[i] = 0; } -PRIMITIVE(reset_inline_cache_stats) -{ - PRIMITIVE_GETVM()->primitive_reset_inline_cache_stats(); -} +PRIMITIVE_FORWARD(reset_inline_cache_stats) inline void factor_vm::primitive_inline_cache_stats() { @@ -275,9 +272,6 @@ inline void factor_vm::primitive_inline_cache_stats() dpush(stats.elements.value()); } -PRIMITIVE(inline_cache_stats) -{ - PRIMITIVE_GETVM()->primitive_inline_cache_stats(); -} +PRIMITIVE_FORWARD(inline_cache_stats) } diff --git a/vm/io.cpp b/vm/io.cpp index 1ec9cf2cb6..b907813fdb 100755 --- a/vm/io.cpp +++ b/vm/io.cpp @@ -52,10 +52,7 @@ inline void factor_vm::primitive_fopen() } } -PRIMITIVE(fopen) -{ - PRIMITIVE_GETVM()->primitive_fopen(); -} +PRIMITIVE_FORWARD(fopen) inline void factor_vm::primitive_fgetc() { @@ -82,10 +79,7 @@ inline void factor_vm::primitive_fgetc() } } -PRIMITIVE(fgetc) -{ - PRIMITIVE_GETVM()->primitive_fgetc(); -} +PRIMITIVE_FORWARD(fgetc) inline void factor_vm::primitive_fread() { @@ -127,10 +121,7 @@ inline void factor_vm::primitive_fread() } } -PRIMITIVE(fread) -{ - PRIMITIVE_GETVM()->primitive_fread(); -} +PRIMITIVE_FORWARD(fread) inline void factor_vm::primitive_fputc() { @@ -150,10 +141,7 @@ inline void factor_vm::primitive_fputc() } } -PRIMITIVE(fputc) -{ - PRIMITIVE_GETVM()->primitive_fputc(); -} +PRIMITIVE_FORWARD(fputc) inline void factor_vm::primitive_fwrite() { @@ -184,10 +172,7 @@ inline void factor_vm::primitive_fwrite() } } -PRIMITIVE(fwrite) -{ - PRIMITIVE_GETVM()->primitive_fwrite(); -} +PRIMITIVE_FORWARD(fwrite) inline void factor_vm::primitive_fseek() { @@ -214,10 +199,7 @@ inline void factor_vm::primitive_fseek() } } -PRIMITIVE(fseek) -{ - PRIMITIVE_GETVM()->primitive_fseek(); -} +PRIMITIVE_FORWARD(fseek) inline void factor_vm::primitive_fflush() { @@ -231,10 +213,7 @@ inline void factor_vm::primitive_fflush() } } -PRIMITIVE(fflush) -{ - PRIMITIVE_GETVM()->primitive_fflush(); -} +PRIMITIVE_FORWARD(fflush) inline void factor_vm::primitive_fclose() { @@ -248,10 +227,7 @@ inline void factor_vm::primitive_fclose() } } -PRIMITIVE(fclose) -{ - PRIMITIVE_GETVM()->primitive_fclose(); -} +PRIMITIVE_FORWARD(fclose) /* This function is used by FFI I/O. Accessing the errno global directly is not portable, since on some libc's errno is not a global but a funky macro that diff --git a/vm/math.cpp b/vm/math.cpp index 638d9fa85c..fde2bc6748 100755 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -8,20 +8,14 @@ inline void factor_vm::primitive_bignum_to_fixnum() drepl(tag_fixnum(bignum_to_fixnum(untag(dpeek())))); } -PRIMITIVE(bignum_to_fixnum) -{ - PRIMITIVE_GETVM()->primitive_bignum_to_fixnum(); -} +PRIMITIVE_FORWARD(bignum_to_fixnum) inline void factor_vm::primitive_float_to_fixnum() { drepl(tag_fixnum(float_to_fixnum(dpeek()))); } -PRIMITIVE(float_to_fixnum) -{ - PRIMITIVE_GETVM()->primitive_float_to_fixnum(); -} +PRIMITIVE_FORWARD(float_to_fixnum) /* Division can only overflow when we are dividing the most negative fixnum by -1. */ @@ -36,10 +30,7 @@ inline void factor_vm::primitive_fixnum_divint() drepl(tag_fixnum(result)); } -PRIMITIVE(fixnum_divint) -{ - PRIMITIVE_GETVM()->primitive_fixnum_divint(); -} +PRIMITIVE_FORWARD(fixnum_divint) inline void factor_vm::primitive_fixnum_divmod() { @@ -57,10 +48,7 @@ inline void factor_vm::primitive_fixnum_divmod() } } -PRIMITIVE(fixnum_divmod) -{ - PRIMITIVE_GETVM()->primitive_fixnum_divmod(); -} +PRIMITIVE_FORWARD(fixnum_divmod) /* * If we're shifting right by n bits, we won't overflow as long as none of the @@ -108,30 +96,21 @@ inline void factor_vm::primitive_fixnum_shift() fixnum_to_bignum(x),y))); } -PRIMITIVE(fixnum_shift) -{ - PRIMITIVE_GETVM()->primitive_fixnum_shift(); -} +PRIMITIVE_FORWARD(fixnum_shift) inline void factor_vm::primitive_fixnum_to_bignum() { drepl(tag(fixnum_to_bignum(untag_fixnum(dpeek())))); } -PRIMITIVE(fixnum_to_bignum) -{ - PRIMITIVE_GETVM()->primitive_fixnum_to_bignum(); -} +PRIMITIVE_FORWARD(fixnum_to_bignum) inline void factor_vm::primitive_float_to_bignum() { drepl(tag(float_to_bignum(dpeek()))); } -PRIMITIVE(float_to_bignum) -{ - PRIMITIVE_GETVM()->primitive_float_to_bignum(); -} +PRIMITIVE_FORWARD(float_to_bignum) #define POP_BIGNUMS(x,y) \ bignum * y = untag(dpop()); \ @@ -143,10 +122,7 @@ inline void factor_vm::primitive_bignum_eq() box_boolean(bignum_equal_p(x,y)); } -PRIMITIVE(bignum_eq) -{ - PRIMITIVE_GETVM()->primitive_bignum_eq(); -} +PRIMITIVE_FORWARD(bignum_eq) inline void factor_vm::primitive_bignum_add() { @@ -154,10 +130,7 @@ inline void factor_vm::primitive_bignum_add() dpush(tag(bignum_add(x,y))); } -PRIMITIVE(bignum_add) -{ - PRIMITIVE_GETVM()->primitive_bignum_add(); -} +PRIMITIVE_FORWARD(bignum_add) inline void factor_vm::primitive_bignum_subtract() { @@ -165,10 +138,7 @@ inline void factor_vm::primitive_bignum_subtract() dpush(tag(bignum_subtract(x,y))); } -PRIMITIVE(bignum_subtract) -{ - PRIMITIVE_GETVM()->primitive_bignum_subtract(); -} +PRIMITIVE_FORWARD(bignum_subtract) inline void factor_vm::primitive_bignum_multiply() { @@ -176,10 +146,7 @@ inline void factor_vm::primitive_bignum_multiply() dpush(tag(bignum_multiply(x,y))); } -PRIMITIVE(bignum_multiply) -{ - PRIMITIVE_GETVM()->primitive_bignum_multiply(); -} +PRIMITIVE_FORWARD(bignum_multiply) inline void factor_vm::primitive_bignum_divint() { @@ -187,10 +154,7 @@ inline void factor_vm::primitive_bignum_divint() dpush(tag(bignum_quotient(x,y))); } -PRIMITIVE(bignum_divint) -{ - PRIMITIVE_GETVM()->primitive_bignum_divint(); -} +PRIMITIVE_FORWARD(bignum_divint) inline void factor_vm::primitive_bignum_divmod() { @@ -201,10 +165,7 @@ inline void factor_vm::primitive_bignum_divmod() dpush(tag(r)); } -PRIMITIVE(bignum_divmod) -{ - PRIMITIVE_GETVM()->primitive_bignum_divmod(); -} +PRIMITIVE_FORWARD(bignum_divmod) inline void factor_vm::primitive_bignum_mod() { @@ -212,10 +173,7 @@ inline void factor_vm::primitive_bignum_mod() dpush(tag(bignum_remainder(x,y))); } -PRIMITIVE(bignum_mod) -{ - PRIMITIVE_GETVM()->primitive_bignum_mod(); -} +PRIMITIVE_FORWARD(bignum_mod) inline void factor_vm::primitive_bignum_and() { @@ -223,10 +181,7 @@ inline void factor_vm::primitive_bignum_and() dpush(tag(bignum_bitwise_and(x,y))); } -PRIMITIVE(bignum_and) -{ - PRIMITIVE_GETVM()->primitive_bignum_and(); -} +PRIMITIVE_FORWARD(bignum_and) inline void factor_vm::primitive_bignum_or() { @@ -234,10 +189,7 @@ inline void factor_vm::primitive_bignum_or() dpush(tag(bignum_bitwise_ior(x,y))); } -PRIMITIVE(bignum_or) -{ - PRIMITIVE_GETVM()->primitive_bignum_or(); -} +PRIMITIVE_FORWARD(bignum_or) inline void factor_vm::primitive_bignum_xor() { @@ -245,10 +197,7 @@ inline void factor_vm::primitive_bignum_xor() dpush(tag(bignum_bitwise_xor(x,y))); } -PRIMITIVE(bignum_xor) -{ - PRIMITIVE_GETVM()->primitive_bignum_xor(); -} +PRIMITIVE_FORWARD(bignum_xor) inline void factor_vm::primitive_bignum_shift() { @@ -257,10 +206,7 @@ inline void factor_vm::primitive_bignum_shift() dpush(tag(bignum_arithmetic_shift(x,y))); } -PRIMITIVE(bignum_shift) -{ - PRIMITIVE_GETVM()->primitive_bignum_shift(); -} +PRIMITIVE_FORWARD(bignum_shift) inline void factor_vm::primitive_bignum_less() { @@ -268,10 +214,7 @@ inline void factor_vm::primitive_bignum_less() box_boolean(bignum_compare(x,y) == bignum_comparison_less); } -PRIMITIVE(bignum_less) -{ - PRIMITIVE_GETVM()->primitive_bignum_less(); -} +PRIMITIVE_FORWARD(bignum_less) inline void factor_vm::primitive_bignum_lesseq() { @@ -279,10 +222,7 @@ inline void factor_vm::primitive_bignum_lesseq() box_boolean(bignum_compare(x,y) != bignum_comparison_greater); } -PRIMITIVE(bignum_lesseq) -{ - PRIMITIVE_GETVM()->primitive_bignum_lesseq(); -} +PRIMITIVE_FORWARD(bignum_lesseq) inline void factor_vm::primitive_bignum_greater() { @@ -290,10 +230,7 @@ inline void factor_vm::primitive_bignum_greater() box_boolean(bignum_compare(x,y) == bignum_comparison_greater); } -PRIMITIVE(bignum_greater) -{ - PRIMITIVE_GETVM()->primitive_bignum_greater(); -} +PRIMITIVE_FORWARD(bignum_greater) inline void factor_vm::primitive_bignum_greatereq() { @@ -301,20 +238,14 @@ inline void factor_vm::primitive_bignum_greatereq() box_boolean(bignum_compare(x,y) != bignum_comparison_less); } -PRIMITIVE(bignum_greatereq) -{ - PRIMITIVE_GETVM()->primitive_bignum_greatereq(); -} +PRIMITIVE_FORWARD(bignum_greatereq) inline void factor_vm::primitive_bignum_not() { drepl(tag(bignum_bitwise_not(untag(dpeek())))); } -PRIMITIVE(bignum_not) -{ - PRIMITIVE_GETVM()->primitive_bignum_not(); -} +PRIMITIVE_FORWARD(bignum_not) inline void factor_vm::primitive_bignum_bitp() { @@ -323,20 +254,14 @@ inline void factor_vm::primitive_bignum_bitp() box_boolean(bignum_logbitp(bit,x)); } -PRIMITIVE(bignum_bitp) -{ - PRIMITIVE_GETVM()->primitive_bignum_bitp(); -} +PRIMITIVE_FORWARD(bignum_bitp) inline void factor_vm::primitive_bignum_log2() { drepl(tag(bignum_integer_length(untag(dpeek())))); } -PRIMITIVE(bignum_log2) -{ - PRIMITIVE_GETVM()->primitive_bignum_log2(); -} +PRIMITIVE_FORWARD(bignum_log2) unsigned int factor_vm::bignum_producer(unsigned int digit) { @@ -356,10 +281,7 @@ inline void factor_vm::primitive_byte_array_to_bignum() drepl(tag(result)); } -PRIMITIVE(byte_array_to_bignum) -{ - PRIMITIVE_GETVM()->primitive_byte_array_to_bignum(); -} +PRIMITIVE_FORWARD(byte_array_to_bignum) cell factor_vm::unbox_array_size() { @@ -399,20 +321,14 @@ inline void factor_vm::primitive_fixnum_to_float() drepl(allot_float(fixnum_to_float(dpeek()))); } -PRIMITIVE(fixnum_to_float) -{ - PRIMITIVE_GETVM()->primitive_fixnum_to_float(); -} +PRIMITIVE_FORWARD(fixnum_to_float) inline void factor_vm::primitive_bignum_to_float() { drepl(allot_float(bignum_to_float(dpeek()))); } -PRIMITIVE(bignum_to_float) -{ - PRIMITIVE_GETVM()->primitive_bignum_to_float(); -} +PRIMITIVE_FORWARD(bignum_to_float) inline void factor_vm::primitive_str_to_float() { @@ -428,10 +344,7 @@ inline void factor_vm::primitive_str_to_float() drepl(F); } -PRIMITIVE(str_to_float) -{ - PRIMITIVE_GETVM()->primitive_str_to_float(); -} +PRIMITIVE_FORWARD(str_to_float) inline void factor_vm::primitive_float_to_str() { @@ -440,10 +353,7 @@ inline void factor_vm::primitive_float_to_str() dpush(tag(array)); } -PRIMITIVE(float_to_str) -{ - PRIMITIVE_GETVM()->primitive_float_to_str(); -} +PRIMITIVE_FORWARD(float_to_str) #define POP_FLOATS(x,y) \ double y = untag_float(dpop()); \ @@ -455,10 +365,7 @@ inline void factor_vm::primitive_float_eq() box_boolean(x == y); } -PRIMITIVE(float_eq) -{ - PRIMITIVE_GETVM()->primitive_float_eq(); -} +PRIMITIVE_FORWARD(float_eq) inline void factor_vm::primitive_float_add() { @@ -466,10 +373,7 @@ inline void factor_vm::primitive_float_add() box_double(x + y); } -PRIMITIVE(float_add) -{ - PRIMITIVE_GETVM()->primitive_float_add(); -} +PRIMITIVE_FORWARD(float_add) inline void factor_vm::primitive_float_subtract() { @@ -477,10 +381,7 @@ inline void factor_vm::primitive_float_subtract() box_double(x - y); } -PRIMITIVE(float_subtract) -{ - PRIMITIVE_GETVM()->primitive_float_subtract(); -} +PRIMITIVE_FORWARD(float_subtract) inline void factor_vm::primitive_float_multiply() { @@ -488,10 +389,7 @@ inline void factor_vm::primitive_float_multiply() box_double(x * y); } -PRIMITIVE(float_multiply) -{ - PRIMITIVE_GETVM()->primitive_float_multiply(); -} +PRIMITIVE_FORWARD(float_multiply) inline void factor_vm::primitive_float_divfloat() { @@ -499,10 +397,7 @@ inline void factor_vm::primitive_float_divfloat() box_double(x / y); } -PRIMITIVE(float_divfloat) -{ - PRIMITIVE_GETVM()->primitive_float_divfloat(); -} +PRIMITIVE_FORWARD(float_divfloat) inline void factor_vm::primitive_float_mod() { @@ -510,10 +405,7 @@ inline void factor_vm::primitive_float_mod() box_double(fmod(x,y)); } -PRIMITIVE(float_mod) -{ - PRIMITIVE_GETVM()->primitive_float_mod(); -} +PRIMITIVE_FORWARD(float_mod) inline void factor_vm::primitive_float_less() { @@ -521,10 +413,7 @@ inline void factor_vm::primitive_float_less() box_boolean(x < y); } -PRIMITIVE(float_less) -{ - PRIMITIVE_GETVM()->primitive_float_less(); -} +PRIMITIVE_FORWARD(float_less) inline void factor_vm::primitive_float_lesseq() { @@ -532,10 +421,7 @@ inline void factor_vm::primitive_float_lesseq() box_boolean(x <= y); } -PRIMITIVE(float_lesseq) -{ - PRIMITIVE_GETVM()->primitive_float_lesseq(); -} +PRIMITIVE_FORWARD(float_lesseq) inline void factor_vm::primitive_float_greater() { @@ -543,10 +429,7 @@ inline void factor_vm::primitive_float_greater() box_boolean(x > y); } -PRIMITIVE(float_greater) -{ - PRIMITIVE_GETVM()->primitive_float_greater(); -} +PRIMITIVE_FORWARD(float_greater) inline void factor_vm::primitive_float_greatereq() { @@ -554,50 +437,35 @@ inline void factor_vm::primitive_float_greatereq() box_boolean(x >= y); } -PRIMITIVE(float_greatereq) -{ - PRIMITIVE_GETVM()->primitive_float_greatereq(); -} +PRIMITIVE_FORWARD(float_greatereq) inline void factor_vm::primitive_float_bits() { box_unsigned_4(float_bits(untag_float_check(dpop()))); } -PRIMITIVE(float_bits) -{ - PRIMITIVE_GETVM()->primitive_float_bits(); -} +PRIMITIVE_FORWARD(float_bits) inline void factor_vm::primitive_bits_float() { box_float(bits_float(to_cell(dpop()))); } -PRIMITIVE(bits_float) -{ - PRIMITIVE_GETVM()->primitive_bits_float(); -} +PRIMITIVE_FORWARD(bits_float) inline void factor_vm::primitive_double_bits() { box_unsigned_8(double_bits(untag_float_check(dpop()))); } -PRIMITIVE(double_bits) -{ - PRIMITIVE_GETVM()->primitive_double_bits(); -} +PRIMITIVE_FORWARD(double_bits) inline void factor_vm::primitive_bits_double() { box_double(bits_double(to_unsigned_8(dpop()))); } -PRIMITIVE(bits_double) -{ - PRIMITIVE_GETVM()->primitive_bits_double(); -} +PRIMITIVE_FORWARD(bits_double) fixnum factor_vm::to_fixnum(cell tagged) { diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index e9e26240cd..5e8112bb5b 100644 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -84,10 +84,7 @@ inline void factor_vm::primitive_existsp() box_boolean(stat(path,&sb) >= 0); } -PRIMITIVE(existsp) -{ - PRIMITIVE_GETVM()->primitive_existsp(); -} +PRIMITIVE_FORWARD(existsp) segment *factor_vm::alloc_segment(cell size) { diff --git a/vm/os-windows-ce.cpp b/vm/os-windows-ce.cpp index 6454535f43..57e7cc69d0 100644 --- a/vm/os-windows-ce.cpp +++ b/vm/os-windows-ce.cpp @@ -30,10 +30,7 @@ char *getenv(char *name) return 0; /* unreachable */ } -PRIMITIVE(os_envs) -{ - vm->not_implemented_error(); -} +PRIMITIVE_FORWARD(os_envs) void c_to_factor_toplevel(cell quot) { diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index 4e06c0efb9..7d4b345da6 100644 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -96,10 +96,7 @@ inline void factor_vm::primitive_existsp() box_boolean(windows_stat(path)); } -PRIMITIVE(existsp) -{ - PRIMITIVE_GETVM()->primitive_existsp(); -} +PRIMITIVE_FORWARD(existsp) segment *factor_vm::alloc_segment(cell size) { diff --git a/vm/primitives.hpp b/vm/primitives.hpp index 4be190d4e6..d17ebe5833 100644 --- a/vm/primitives.hpp +++ b/vm/primitives.hpp @@ -4,10 +4,17 @@ namespace factor #if defined(FACTOR_X86) extern "C" __attribute__ ((regparm (1))) typedef void (*primitive_type)(void *myvm); #define PRIMITIVE(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm) + #define PRIMITIVE_FORWARD(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm) \ + { \ + PRIMITIVE_GETVM()->primitive_##name(); \ + } #else extern "C" typedef void (*primitive_type)(void *myvm); #define PRIMITIVE(name) extern "C" void primitive_##name(void *myvm) + #define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(void *myvm) \ + { \ + PRIMITIVE_GETVM()->primitive_##name(); \ + } #endif - extern const primitive_type primitives[]; } diff --git a/vm/profiler.cpp b/vm/profiler.cpp index cd99c9f27c..b054ed1222 100755 --- a/vm/profiler.cpp +++ b/vm/profiler.cpp @@ -52,9 +52,6 @@ inline void factor_vm::primitive_profiling() set_profiling(to_boolean(dpop())); } -PRIMITIVE(profiling) -{ - PRIMITIVE_GETVM()->primitive_profiling(); -} +PRIMITIVE_FORWARD(profiling) } diff --git a/vm/quotations.cpp b/vm/quotations.cpp index 1bc6240481..d58d1f1988 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -294,10 +294,7 @@ inline void factor_vm::primitive_jit_compile() jit_compile(dpop(),true); } -PRIMITIVE(jit_compile) -{ - PRIMITIVE_GETVM()->primitive_jit_compile(); -} +PRIMITIVE_FORWARD(jit_compile) /* push a new quotation on the stack */ inline void factor_vm::primitive_array_to_quotation() @@ -311,10 +308,7 @@ inline void factor_vm::primitive_array_to_quotation() drepl(tag(quot)); } -PRIMITIVE(array_to_quotation) -{ - PRIMITIVE_GETVM()->primitive_array_to_quotation(); -} +PRIMITIVE_FORWARD(array_to_quotation) inline void factor_vm::primitive_quotation_xt() { @@ -322,10 +316,7 @@ inline void factor_vm::primitive_quotation_xt() drepl(allot_cell((cell)quot->xt)); } -PRIMITIVE(quotation_xt) -{ - PRIMITIVE_GETVM()->primitive_quotation_xt(); -} +PRIMITIVE_FORWARD(quotation_xt) void factor_vm::compile_all_words() { @@ -381,9 +372,6 @@ inline void factor_vm::primitive_quot_compiled_p() dpush(tag_boolean(quot->code != NULL)); } -PRIMITIVE(quot_compiled_p) -{ - PRIMITIVE_GETVM()->primitive_quot_compiled_p(); -} +PRIMITIVE_FORWARD(quot_compiled_p) } diff --git a/vm/run.cpp b/vm/run.cpp index 2f162e3ace..d2170f4055 100755 --- a/vm/run.cpp +++ b/vm/run.cpp @@ -9,10 +9,7 @@ inline void factor_vm::primitive_getenv() drepl(userenv[e]); } -PRIMITIVE(getenv) -{ - PRIMITIVE_GETVM()->primitive_getenv(); -} +PRIMITIVE_FORWARD(getenv) inline void factor_vm::primitive_setenv() { @@ -21,40 +18,28 @@ inline void factor_vm::primitive_setenv() userenv[e] = value; } -PRIMITIVE(setenv) -{ - PRIMITIVE_GETVM()->primitive_setenv(); -} +PRIMITIVE_FORWARD(setenv) inline void factor_vm::primitive_exit() { exit(to_fixnum(dpop())); } -PRIMITIVE(exit) -{ - PRIMITIVE_GETVM()->primitive_exit(); -} +PRIMITIVE_FORWARD(exit) inline void factor_vm::primitive_micros() { box_unsigned_8(current_micros()); } -PRIMITIVE(micros) -{ - PRIMITIVE_GETVM()->primitive_micros(); -} +PRIMITIVE_FORWARD(micros) inline void factor_vm::primitive_sleep() { sleep_micros(to_cell(dpop())); } -PRIMITIVE(sleep) -{ - PRIMITIVE_GETVM()->primitive_sleep(); -} +PRIMITIVE_FORWARD(sleep) inline void factor_vm::primitive_set_slot() { @@ -66,10 +51,7 @@ inline void factor_vm::primitive_set_slot() write_barrier(obj); } -PRIMITIVE(set_slot) -{ - PRIMITIVE_GETVM()->primitive_set_slot(); -} +PRIMITIVE_FORWARD(set_slot) inline void factor_vm::primitive_load_locals() { @@ -79,10 +61,7 @@ inline void factor_vm::primitive_load_locals() rs += sizeof(cell) * count; } -PRIMITIVE(load_locals) -{ - PRIMITIVE_GETVM()->primitive_load_locals(); -} +PRIMITIVE_FORWARD(load_locals) cell factor_vm::clone_object(cell obj_) { @@ -104,9 +83,6 @@ inline void factor_vm::primitive_clone() drepl(clone_object(dpeek())); } -PRIMITIVE(clone) -{ - PRIMITIVE_GETVM()->primitive_clone(); -} +PRIMITIVE_FORWARD(clone) } diff --git a/vm/strings.cpp b/vm/strings.cpp index 912706024e..fb5eb1093d 100644 --- a/vm/strings.cpp +++ b/vm/strings.cpp @@ -106,10 +106,7 @@ inline void factor_vm::primitive_string() dpush(tag(allot_string(length,initial))); } -PRIMITIVE(string) -{ - PRIMITIVE_GETVM()->primitive_string(); -} +PRIMITIVE_FORWARD(string) bool factor_vm::reallot_string_in_place_p(string *str, cell capacity) { @@ -167,10 +164,7 @@ inline void factor_vm::primitive_resize_string() dpush(tag(reallot_string(str,capacity))); } -PRIMITIVE(resize_string) -{ - PRIMITIVE_GETVM()->primitive_resize_string(); -} +PRIMITIVE_FORWARD(resize_string) inline void factor_vm::primitive_string_nth() { @@ -179,10 +173,7 @@ inline void factor_vm::primitive_string_nth() dpush(tag_fixnum(string_nth(str,index))); } -PRIMITIVE(string_nth) -{ - PRIMITIVE_GETVM()->primitive_string_nth(); -} +PRIMITIVE_FORWARD(string_nth) inline void factor_vm::primitive_set_string_nth_fast() { @@ -192,10 +183,7 @@ inline void factor_vm::primitive_set_string_nth_fast() set_string_nth_fast(str,index,value); } -PRIMITIVE(set_string_nth_fast) -{ - PRIMITIVE_GETVM()->primitive_set_string_nth_fast(); -} +PRIMITIVE_FORWARD(set_string_nth_fast) inline void factor_vm::primitive_set_string_nth_slow() { @@ -205,9 +193,6 @@ inline void factor_vm::primitive_set_string_nth_slow() set_string_nth_slow(str,index,value); } -PRIMITIVE(set_string_nth_slow) -{ - PRIMITIVE_GETVM()->primitive_set_string_nth_slow(); -} +PRIMITIVE_FORWARD(set_string_nth_slow) } diff --git a/vm/tuples.cpp b/vm/tuples.cpp index a89265f709..d2734d3dfb 100644 --- a/vm/tuples.cpp +++ b/vm/tuples.cpp @@ -23,10 +23,7 @@ inline void factor_vm::primitive_tuple() dpush(tag(t)); } -PRIMITIVE(tuple) -{ - PRIMITIVE_GETVM()->primitive_tuple(); -} +PRIMITIVE_FORWARD(tuple) /* push a new tuple on the stack, filling its slots from the stack */ inline void factor_vm::primitive_tuple_boa() @@ -39,9 +36,6 @@ inline void factor_vm::primitive_tuple_boa() dpush(t.value()); } -PRIMITIVE(tuple_boa) -{ - PRIMITIVE_GETVM()->primitive_tuple_boa(); -} +PRIMITIVE_FORWARD(tuple_boa) } diff --git a/vm/words.cpp b/vm/words.cpp index e99f483685..ce25313ea2 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -39,10 +39,7 @@ inline void factor_vm::primitive_word() dpush(tag(allot_word(vocab,name))); } -PRIMITIVE(word) -{ - PRIMITIVE_GETVM()->primitive_word(); -} +PRIMITIVE_FORWARD(word) /* word-xt ( word -- start end ) */ inline void factor_vm::primitive_word_xt() @@ -53,10 +50,7 @@ inline void factor_vm::primitive_word_xt() dpush(allot_cell((cell)code + code->size)); } -PRIMITIVE(word_xt) -{ - PRIMITIVE_GETVM()->primitive_word_xt(); -} +PRIMITIVE_FORWARD(word_xt) /* Allocates memory */ void factor_vm::update_word_xt(cell w_) @@ -85,10 +79,7 @@ inline void factor_vm::primitive_optimized_p() drepl(tag_boolean(word_optimized_p(untag_check(dpeek())))); } -PRIMITIVE(optimized_p) -{ - PRIMITIVE_GETVM()->primitive_optimized_p(); -} +PRIMITIVE_FORWARD(optimized_p) inline void factor_vm::primitive_wrapper() { @@ -97,9 +88,6 @@ inline void factor_vm::primitive_wrapper() drepl(tag(new_wrapper)); } -PRIMITIVE(wrapper) -{ - PRIMITIVE_GETVM()->primitive_wrapper(); -} +PRIMITIVE_FORWARD(wrapper) } From 602776c885fc4ed5c89eed30be55666bb4b9743a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 18:08:00 -0500 Subject: [PATCH 09/20] vm: clean up os-unix.cpp --- vm/os-unix.cpp | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index e9e26240cd..bd8f33aac2 100644 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -21,9 +21,8 @@ pthread_key_t tlsKey = 0; void init_platform_globals() { - if (pthread_key_create(&tlsKey, NULL) != 0){ + if (pthread_key_create(&tlsKey, NULL) != 0) fatal_error("pthread_key_create() failed",0); - } } @@ -75,8 +74,6 @@ void factor_vm::ffi_dlclose(dll *dll) dll->dll = NULL; } - - inline void factor_vm::primitive_existsp() { struct stat sb; From b14c683b3283020eeb89f9f6f9b0fb1b28ed2407 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 18:08:21 -0500 Subject: [PATCH 10/20] vm: ignore 'declare' calls in non-optimizing compiler --- basis/bootstrap/image/image.factor | 2 + vm/quotations.cpp | 73 +++++++++++++++--------------- vm/quotations.hpp | 13 +++--- vm/run.hpp | 1 + 4 files changed, 47 insertions(+), 42 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index ee081a14ca..eee65c1eba 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -163,6 +163,7 @@ USERENV: jit-3dip 40 USERENV: jit-execute-word 41 USERENV: jit-execute-jump 42 USERENV: jit-execute-call 43 +USERENV: jit-declare-word 44 ! PIC stubs USERENV: pic-load 47 @@ -493,6 +494,7 @@ M: quotation ' \ inline-cache-miss-tail \ pic-miss-tail-word set \ mega-cache-lookup \ mega-lookup-word set \ mega-cache-miss \ mega-miss-word set + \ declare jit-declare-word set [ undefined ] undefined-quot set ; : emit-userenvs ( -- ) diff --git a/vm/quotations.cpp b/vm/quotations.cpp index 1bc6240481..34412149db 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -36,51 +36,47 @@ includes stack shufflers, some fixnum arithmetic words, and words such as tag, slot and eq?. A primitive call is relatively expensive (two subroutine calls) so this results in a big speedup for relatively little effort. */ -bool quotation_jit::primitive_call_p(cell i) +bool quotation_jit::primitive_call_p(cell i, cell length) { - return (i + 2) == array_capacity(elements.untagged()) - && tagged(array_nth(elements.untagged(),i)).type_p(FIXNUM_TYPE) - && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_PRIMITIVE_WORD]; + return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_PRIMITIVE_WORD]; } -bool quotation_jit::fast_if_p(cell i) +bool quotation_jit::fast_if_p(cell i, cell length) { - return (i + 3) == array_capacity(elements.untagged()) - && tagged(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE) + return (i + 3) == length && tagged(array_nth(elements.untagged(),i + 1)).type_p(QUOTATION_TYPE) && array_nth(elements.untagged(),i + 2) == parent_vm->userenv[JIT_IF_WORD]; } -bool quotation_jit::fast_dip_p(cell i) +bool quotation_jit::fast_dip_p(cell i, cell length) { - return (i + 2) <= array_capacity(elements.untagged()) - && tagged(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE) - && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_DIP_WORD]; + return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_DIP_WORD]; } -bool quotation_jit::fast_2dip_p(cell i) +bool quotation_jit::fast_2dip_p(cell i, cell length) { - return (i + 2) <= array_capacity(elements.untagged()) - && tagged(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE) - && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_2DIP_WORD]; + return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_2DIP_WORD]; } -bool quotation_jit::fast_3dip_p(cell i) +bool quotation_jit::fast_3dip_p(cell i, cell length) { - return (i + 2) <= array_capacity(elements.untagged()) - && tagged(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE) - && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_3DIP_WORD]; + return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_3DIP_WORD]; } -bool quotation_jit::mega_lookup_p(cell i) +bool quotation_jit::mega_lookup_p(cell i, cell length) { - return (i + 3) < array_capacity(elements.untagged()) - && tagged(array_nth(elements.untagged(),i)).type_p(ARRAY_TYPE) + return (i + 4) <= length && tagged(array_nth(elements.untagged(),i + 1)).type_p(FIXNUM_TYPE) && tagged(array_nth(elements.untagged(),i + 2)).type_p(ARRAY_TYPE) && array_nth(elements.untagged(),i + 3) == parent_vm->userenv[MEGA_LOOKUP_WORD]; } +bool quotation_jit::declare_p(cell i, cell length) +{ + return (i + 2) <= length + && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_DECLARE_WORD]; +} + bool quotation_jit::stack_frame_p() { fixnum length = array_capacity(elements.untagged()); @@ -96,7 +92,7 @@ bool quotation_jit::stack_frame_p() return true; break; case QUOTATION_TYPE: - if(fast_dip_p(i) || fast_2dip_p(i) || fast_3dip_p(i)) + if(fast_dip_p(i,length) || fast_2dip_p(i,length) || fast_3dip_p(i,length)) return true; break; default: @@ -179,19 +175,21 @@ void quotation_jit::iterate_quotation() break; case FIXNUM_TYPE: /* Primitive calls */ - if(primitive_call_p(i)) + if(primitive_call_p(i,length)) { emit_with(parent_vm->userenv[JIT_PRIMITIVE],obj.value()); i++; tail_call = true; - break; } + else + push(obj.value()); + break; case QUOTATION_TYPE: /* 'if' preceeded by two literal quotations (this is why if and ? are mutually recursive in the library, but both still work) */ - if(fast_if_p(i)) + if(fast_if_p(i,length)) { if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]); tail_call = true; @@ -207,39 +205,37 @@ void quotation_jit::iterate_quotation() emit(parent_vm->userenv[JIT_IF]); i += 2; - - break; } /* dip */ - else if(fast_dip_p(i)) + else if(fast_dip_p(i,length)) { if(compiling) parent_vm->jit_compile(obj.value(),relocate); emit_with(parent_vm->userenv[JIT_DIP],obj.value()); i++; - break; } /* 2dip */ - else if(fast_2dip_p(i)) + else if(fast_2dip_p(i,length)) { if(compiling) parent_vm->jit_compile(obj.value(),relocate); emit_with(parent_vm->userenv[JIT_2DIP],obj.value()); i++; - break; } /* 3dip */ - else if(fast_3dip_p(i)) + else if(fast_3dip_p(i,length)) { if(compiling) parent_vm->jit_compile(obj.value(),relocate); emit_with(parent_vm->userenv[JIT_3DIP],obj.value()); i++; - break; } + else + push(obj.value()); + break; case ARRAY_TYPE: /* Method dispatch */ - if(mega_lookup_p(i)) + if(mega_lookup_p(i,length)) { emit_mega_cache_lookup( array_nth(elements.untagged(),i), @@ -247,8 +243,13 @@ void quotation_jit::iterate_quotation() array_nth(elements.untagged(),i + 2)); i += 3; tail_call = true; - break; } + /* Non-optimizing compiler ignores declarations */ + else if(declare_p(i,length)) + i++; + else + push(obj.value()); + break; default: push(obj.value()); break; diff --git a/vm/quotations.hpp b/vm/quotations.hpp index b21884a35b..3dc8fa5851 100755 --- a/vm/quotations.hpp +++ b/vm/quotations.hpp @@ -12,12 +12,13 @@ struct quotation_jit : public jit { relocate(relocate_){}; void emit_mega_cache_lookup(cell methods, fixnum index, cell cache); - bool primitive_call_p(cell i); - bool fast_if_p(cell i); - bool fast_dip_p(cell i); - bool fast_2dip_p(cell i); - bool fast_3dip_p(cell i); - bool mega_lookup_p(cell i); + bool primitive_call_p(cell i, cell length); + bool fast_if_p(cell i, cell length); + bool fast_dip_p(cell i, cell length); + bool fast_2dip_p(cell i, cell length); + bool fast_3dip_p(cell i, cell length); + bool mega_lookup_p(cell i, cell length); + bool declare_p(cell i, cell length); bool stack_frame_p(); void iterate_quotation(); }; diff --git a/vm/run.hpp b/vm/run.hpp index d10a6678b8..562eef9220 100755 --- a/vm/run.hpp +++ b/vm/run.hpp @@ -57,6 +57,7 @@ enum special_object { JIT_EXECUTE_WORD, JIT_EXECUTE_JUMP, JIT_EXECUTE_CALL, + JIT_DECLARE_WORD, /* Polymorphic inline cache generation in inline_cache.c */ PIC_LOAD = 47, From a6654c97ef158e60f417217fdde9f6ec0efc4b4f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 18:08:33 -0500 Subject: [PATCH 11/20] compiler: add unit test for undefined_symbol regression --- basis/compiler/tests/alien.factor | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index e21e13dc13..9d3a66df5b 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -588,3 +588,8 @@ FUNCTION: short ffi_test_48 ( bool-field-test x ) ; 123 >>parents ffi_test_48 ] unit-test + +! Regression: calling an undefined function would raise a protection fault +FUNCTION: void this_does_not_exist ( ) ; + +[ this_does_not_exist ] [ { "kernel-error" 10 f f } = ] must-fail-with From 09eb06ad94180da9a0d93172a8139d4cd671e499 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 18:27:52 -0500 Subject: [PATCH 12/20] webapps.mason: fix typo --- extra/webapps/mason/mason.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 9867038ef1..637ffa6dd8 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -135,10 +135,10 @@ CONSTANT: cpus : requirements ( builder -- xml ) [ os>> { - { "winnt" "Windows XP (also tested on Vista)" } + { "winnt" "Windows XP, Windows Vista or Windows 7" } { "macosx" "Mac OS X 10.5 Leopard" } { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" } - { "freebsd" "FreeBSD 7.0" } + { "freebsd" "FreeBSD 7.1" } { "netbsd" "NetBSD 5.0" } { "openbsd" "OpenBSD 4.4" } } at @@ -146,7 +146,7 @@ CONSTANT: cpus dup cpu>> "x86.32" = [ os>> { { [ dup { "winnt" "linux" "freebsd" "netbsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } - { [ dup {"openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } + { [ dup { "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } { [ t ] [ drop f ] } } cond ] [ drop f ] if From c0abb9ce95a721b6fda328dffa284e88c55e3e8c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 18:50:08 -0500 Subject: [PATCH 13/20] hints: fix regression with declarations --- basis/compiler/cfg/builder/builder-tests.factor | 6 +++++- basis/hints/hints-tests.factor | 12 ++++++++++++ basis/hints/hints.factor | 10 +++++----- 3 files changed, 22 insertions(+), 6 deletions(-) create mode 100644 basis/hints/hints-tests.factor diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index db0dd65a83..9a77ee4017 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -4,6 +4,7 @@ compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker compiler.cfg arrays locals byte-arrays kernel.private math slots.private vectors sbufs strings math.partial-dispatch +hashtables assocs combinators.short-circuit strings.private accessors compiler.cfg.instructions ; IN: compiler.cfg.builder.tests @@ -204,4 +205,7 @@ IN: compiler.cfg.builder.tests [ [ ##box-alien? ] contains-insn? ] [ [ ##box-float? ] contains-insn? ] bi ] unit-test -] when \ No newline at end of file +] when + +! Regression. Make sure everything is inlined correctly +[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test \ No newline at end of file diff --git a/basis/hints/hints-tests.factor b/basis/hints/hints-tests.factor new file mode 100644 index 0000000000..894e1dbdc8 --- /dev/null +++ b/basis/hints/hints-tests.factor @@ -0,0 +1,12 @@ +USING: math hashtables accessors kernel words hints +compiler.tree.debugger tools.test ; +IN: hints.tests + +! Regression +GENERIC: blahblah ( a b c -- ) + +M: hashtable blahblah 2nip [ 1 + ] change-count drop ; + +HINTS: M\ hashtable blahblah { object fixnum object } { object word object } ; + +[ t ] [ M\ hashtable blahblah { count>> (>>count) } inlined? ] unit-test diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 73142cf747..f49d2e4229 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -37,8 +37,8 @@ M: object specializer-declaration class ; [ [ specializer-declaration ] map swap '[ _ declare @ ] ] 2bi ] with { } map>assoc ; -: specialize-quot ( quot word specializer -- quot' ) - [ drop nip def>> ] [ nip specializer-cases ] 3bi alist>quot ; +: specialize-quot ( quot specializer -- quot' ) + [ drop ] [ specializer-cases ] 2bi alist>quot ; ! compiler.tree.propagation.inlining sets this to f SYMBOL: specialize-method? @@ -52,8 +52,8 @@ t specialize-method? set-global : specialize-method ( quot method -- quot' ) [ specialize-method? get [ method-declaration prepend ] [ drop ] if ] - [ dup "method-generic" word-prop specializer ] bi - [ specialize-quot ] [ drop ] if* ; + [ "method-generic" word-prop ] bi + specializer [ specialize-quot ] when* ; : standard-method? ( method -- ? ) dup method-body? [ @@ -64,7 +64,7 @@ t specialize-method? set-global [ def>> ] keep dup generic? [ drop ] [ [ dup standard-method? [ specialize-method ] [ drop ] if ] - [ dup specializer [ specialize-quot ] [ drop ] if* ] + [ specializer [ specialize-quot ] when* ] bi ] if ; From ed37950a3336db8bc11975fa298e8a60ba06e995 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 18:50:44 -0500 Subject: [PATCH 14/20] math.vectors: change vlshift and vrshift to mask the shift count by HEX: ff, to make them behave consistently with their SIMD counterparts --- basis/math/vectors/vectors-tests.factor | 14 ++++++++++++-- basis/math/vectors/vectors.factor | 4 ++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/basis/math/vectors/vectors-tests.factor b/basis/math/vectors/vectors-tests.factor index 5296831889..712c5e4c60 100644 --- a/basis/math/vectors/vectors-tests.factor +++ b/basis/math/vectors/vectors-tests.factor @@ -1,5 +1,7 @@ IN: math.vectors.tests -USING: math.vectors tools.test kernel ; +USING: math.vectors tools.test kernel specialized-arrays compiler +kernel.private ; +SPECIALIZED-ARRAY: int [ { 1 2 3 } ] [ 1/2 { 2 4 6 } n*v ] unit-test [ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test @@ -21,4 +23,12 @@ USING: math.vectors tools.test kernel ; [ { 0 3 2 5 4 } ] [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test -[ 1 ] [ { C{ 0 1 } } dup v. ] unit-test \ No newline at end of file +[ 1 ] [ { C{ 0 1 } } dup v. ] unit-test + +! Make sure vector shifts behave the same as hardware SIMD vector shifts +[ int-array{ 0 0 0 0 } ] [ int-array{ 10 20 30 40 } -1 vlshift ] unit-test + +[ int-array{ 0 0 0 0 } ] [ + int-array{ 10 20 30 40 } + [ { int-array } declare -1 vlshift ] compile-call +] unit-test \ No newline at end of file diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index a40506f980..1bd202f2ad 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -61,8 +61,8 @@ PRIVATE> : vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ; : vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ; -: vlshift ( u n -- w ) '[ _ shift ] map ; -: vrshift ( u n -- w ) neg '[ _ shift ] map ; +: vlshift ( u n -- w ) HEX: ff bitand '[ _ shift ] map ; +: vrshift ( u n -- w ) HEX: ff bitand neg '[ _ shift ] map ; : vfloor ( u -- v ) [ floor ] map ; : vceiling ( u -- v ) [ ceiling ] map ; From c046ff4b23897fc0a99c1fae7176d1a098f1cb31 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 20:32:00 -0500 Subject: [PATCH 15/20] vm: make heap data-type object-oriented --- Makefile | 2 +- vm/code_block.cpp | 10 +-- vm/code_gc.hpp | 38 --------- vm/code_heap.cpp | 18 ++--- vm/code_heap.hpp | 3 +- vm/data_gc.cpp | 4 +- vm/debug.cpp | 4 +- vm/{code_gc.cpp => heap.cpp} | 147 +++++++++++++++++------------------ vm/heap.hpp | 59 ++++++++++++++ vm/image.cpp | 12 +-- vm/inline_cache.cpp | 2 +- vm/master.hpp | 2 +- vm/vm-data.hpp | 4 +- vm/vm.hpp | 18 ----- 14 files changed, 163 insertions(+), 160 deletions(-) delete mode 100755 vm/code_gc.hpp rename vm/{code_gc.cpp => heap.cpp} (56%) mode change 100755 => 100644 create mode 100644 vm/heap.hpp diff --git a/Makefile b/Makefile index 10efe34d34..49c08c7d13 100755 --- a/Makefile +++ b/Makefile @@ -38,7 +38,6 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm/byte_arrays.o \ vm/callstack.o \ vm/code_block.o \ - vm/code_gc.o \ vm/code_heap.o \ vm/contexts.o \ vm/data_gc.o \ @@ -47,6 +46,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm/dispatch.o \ vm/errors.o \ vm/factor.o \ + vm/heap.o \ vm/image.o \ vm/inline_cache.o \ vm/io.o \ diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 2251345af7..bd7a93bf6d 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -371,7 +371,7 @@ void factor_vm::update_word_references(code_block *compiled) the code heap with dead PICs that will be freed on the next GC, we add them to the free list immediately. */ else if(compiled->type == PIC_TYPE) - heap_free(&code,compiled); + code->heap_free(compiled); else { iterate_relocations(compiled,factor::update_word_references_step); @@ -411,7 +411,7 @@ void factor_vm::mark_code_block(code_block *compiled) { check_code_address((cell)compiled); - mark_block(compiled); + code->mark_block(compiled); copy_handle(&compiled->literals); copy_handle(&compiled->relocation); @@ -503,19 +503,19 @@ void factor_vm::fixup_labels(array *labels, code_block *compiled) /* Might GC */ code_block *factor_vm::allot_code_block(cell size) { - heap_block *block = heap_allot(&code,size + sizeof(code_block)); + heap_block *block = code->heap_allot(size + sizeof(code_block)); /* If allocation failed, do a code GC */ if(block == NULL) { gc(); - block = heap_allot(&code,size + sizeof(code_block)); + block = code->heap_allot(size + sizeof(code_block)); /* Insufficient room even after code GC, give up */ if(block == NULL) { cell used, total_free, max_free; - heap_usage(&code,&used,&total_free,&max_free); + code->heap_usage(&used,&total_free,&max_free); print_string("Code heap stats:\n"); print_string("Used: "); print_cell(used); nl(); diff --git a/vm/code_gc.hpp b/vm/code_gc.hpp deleted file mode 100755 index d2cfba0cf4..0000000000 --- a/vm/code_gc.hpp +++ /dev/null @@ -1,38 +0,0 @@ -namespace factor -{ - -static const cell free_list_count = 16; -static const cell block_size_increment = 32; - -struct heap_free_list { - free_heap_block *small_blocks[free_list_count]; - free_heap_block *large_blocks; -}; - -struct heap { - segment *seg; - heap_free_list free; -}; - -typedef void (*heap_iterator)(heap_block *compiled,factor_vm *vm); - -inline static heap_block *next_block(heap *h, heap_block *block) -{ - cell next = ((cell)block + block->size); - if(next == h->seg->end) - return NULL; - else - return (heap_block *)next; -} - -inline static heap_block *first_block(heap *h) -{ - return (heap_block *)h->seg->start; -} - -inline static heap_block *last_block(heap *h) -{ - return (heap_block *)h->seg->end; -} - -} diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 7d70b4c254..c1139234ed 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -6,12 +6,12 @@ namespace factor /* Allocate a code heap during startup */ void factor_vm::init_code_heap(cell size) { - new_heap(&code,size); + code = new heap(this,size); } bool factor_vm::in_code_heap_p(cell ptr) { - return (ptr >= code.seg->start && ptr <= code.seg->end); + return (ptr >= code->seg->start && ptr <= code->seg->end); } /* Compile a word definition with the non-optimizing compiler. Allocates memory */ @@ -31,13 +31,13 @@ void factor_vm::jit_compile_word(cell word_, cell def_, bool relocate) /* Apply a function to every code block */ void factor_vm::iterate_code_heap(code_heap_iterator iter) { - heap_block *scan = first_block(&code); + heap_block *scan = code->first_block(); while(scan) { if(scan->status != B_FREE) iter((code_block *)scan,this); - scan = next_block(&code,scan); + scan = code->next_block(scan); } } @@ -112,8 +112,8 @@ PRIMITIVE_FORWARD(modify_code_heap) inline void factor_vm::primitive_code_room() { cell used, total_free, max_free; - heap_usage(&code,&used,&total_free,&max_free); - dpush(tag_fixnum(code.seg->size / 1024)); + code->heap_usage(&used,&total_free,&max_free); + dpush(tag_fixnum(code->seg->size / 1024)); dpush(tag_fixnum(used / 1024)); dpush(tag_fixnum(total_free / 1024)); dpush(tag_fixnum(max_free / 1024)); @@ -220,20 +220,20 @@ void factor_vm::compact_code_heap() gc(); /* Figure out where the code heap blocks are going to end up */ - cell size = compute_heap_forwarding(&code, forwarding); + cell size = code->compute_heap_forwarding(forwarding); /* Update word and quotation code pointers */ forward_object_xts(); /* Actually perform the compaction */ - compact_heap(&code,forwarding); + code->compact_heap(forwarding); /* Update word and quotation XTs */ fixup_object_xts(); /* Now update the free list; there will be a single free block at the end */ - build_free_list(&code,size); + code->build_free_list(size); } } diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp index 709ec85f95..f68c80a2a1 100755 --- a/vm/code_heap.hpp +++ b/vm/code_heap.hpp @@ -1,7 +1,8 @@ namespace factor { + struct factor_vm; -typedef void (*code_heap_iterator)(code_block *compiled,factor_vm *myvm); +typedef void (*code_heap_iterator)(code_block *compiled, factor_vm *myvm); PRIMITIVE(modify_code_heap); PRIMITIVE(code_room); diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp index 18c38cade3..011cc1f5f3 100755 --- a/vm/data_gc.cpp +++ b/vm/data_gc.cpp @@ -509,7 +509,7 @@ void factor_vm::garbage_collection(cell gen,bool growing_data_heap_,cell request growing_data_heap = true; /* see the comment in unmark_marked() */ - unmark_marked(&code); + code->unmark_marked(); } /* we try collecting aging space twice before going on to collect tenured */ @@ -546,7 +546,7 @@ void factor_vm::garbage_collection(cell gen,bool growing_data_heap_,cell request code_heap_scans++; if(collecting_gen == data->tenured()) - free_unmarked(&code,(heap_iterator)factor::update_literal_and_word_references); + code->free_unmarked((heap_iterator)factor::update_literal_and_word_references); else copy_code_heap_roots(); diff --git a/vm/debug.cpp b/vm/debug.cpp index 1ec73760d3..8cacbeca47 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -297,7 +297,7 @@ void factor_vm::dump_code_heap() { cell reloc_size = 0, literal_size = 0; - heap_block *scan = first_block(&code); + heap_block *scan = code->first_block(); while(scan) { @@ -326,7 +326,7 @@ void factor_vm::dump_code_heap() print_cell_hex(scan->size); print_string(" "); print_string(status); print_string("\n"); - scan = next_block(&code,scan); + scan = code->next_block(scan); } print_cell(reloc_size); print_string(" bytes of relocation data\n"); diff --git a/vm/code_gc.cpp b/vm/heap.cpp old mode 100755 new mode 100644 similarity index 56% rename from vm/code_gc.cpp rename to vm/heap.cpp index 1c372368dd..0905d7c190 --- a/vm/code_gc.cpp +++ b/vm/heap.cpp @@ -1,37 +1,36 @@ #include "master.hpp" +/* This malloc-style heap code is reasonably generic. Maybe in the future, it +will be used for the data heap too, if we ever get mark/sweep/compact GC. */ + namespace factor { -void factor_vm::clear_free_list(heap *heap) +void heap::clear_free_list() { - memset(&heap->free,0,sizeof(heap_free_list)); + memset(&free,0,sizeof(heap_free_list)); } -/* This malloc-style heap code is reasonably generic. Maybe in the future, it -will be used for the data heap too, if we ever get incremental -mark/sweep/compact GC. */ -void factor_vm::new_heap(heap *heap, cell size) +heap::heap(factor_vm *myvm_, cell size) { - heap->seg = alloc_segment(align_page(size)); - if(!heap->seg) - fatal_error("Out of memory in new_heap",size); - - clear_free_list(heap); + myvm = myvm_; + seg = myvm->alloc_segment(myvm->align_page(size)); + if(!seg) fatal_error("Out of memory in new_heap",size); + clear_free_list(); } -void factor_vm::add_to_free_list(heap *heap, free_heap_block *block) +void heap::add_to_free_list(free_heap_block *block) { if(block->size < free_list_count * block_size_increment) { int index = block->size / block_size_increment; - block->next_free = heap->free.small_blocks[index]; - heap->free.small_blocks[index] = block; + block->next_free = free.small_blocks[index]; + free.small_blocks[index] = block; } else { - block->next_free = heap->free.large_blocks; - heap->free.large_blocks = block; + block->next_free = free.large_blocks; + free.large_blocks = block; } } @@ -39,16 +38,16 @@ void factor_vm::add_to_free_list(heap *heap, free_heap_block *block) In the former case, we must add a large free block from compiling.base + size to compiling.limit. */ -void factor_vm::build_free_list(heap *heap, cell size) +void heap::build_free_list(cell size) { heap_block *prev = NULL; - clear_free_list(heap); + clear_free_list(); size = (size + block_size_increment - 1) & ~(block_size_increment - 1); - heap_block *scan = first_block(heap); - free_heap_block *end = (free_heap_block *)(heap->seg->start + size); + heap_block *scan = first_block(); + free_heap_block *end = (free_heap_block *)(seg->start + size); /* Add all free blocks to the free list */ while(scan && scan < (heap_block *)end) @@ -56,28 +55,28 @@ void factor_vm::build_free_list(heap *heap, cell size) switch(scan->status) { case B_FREE: - add_to_free_list(heap,(free_heap_block *)scan); + add_to_free_list((free_heap_block *)scan); break; case B_ALLOCATED: break; default: - critical_error("Invalid scan->status",(cell)scan); + myvm->critical_error("Invalid scan->status",(cell)scan); break; } prev = scan; - scan = next_block(heap,scan); + scan = next_block(scan); } /* If there is room at the end of the heap, add a free block. This branch is only taken after loading a new image, not after code GC */ - if((cell)(end + 1) <= heap->seg->end) + if((cell)(end + 1) <= seg->end) { end->status = B_FREE; - end->size = heap->seg->end - (cell)end; + end->size = seg->end - (cell)end; /* add final free block */ - add_to_free_list(heap,end); + add_to_free_list(end); } /* This branch is taken if the newly loaded image fits exactly, or after code GC */ @@ -86,30 +85,30 @@ void factor_vm::build_free_list(heap *heap, cell size) /* even if there's no room at the end of the heap for a new free block, we might have to jigger it up by a few bytes in case prev + prev->size */ - if(prev) prev->size = heap->seg->end - (cell)prev; + if(prev) prev->size = seg->end - (cell)prev; } } -void factor_vm::assert_free_block(free_heap_block *block) +void heap::assert_free_block(free_heap_block *block) { if(block->status != B_FREE) - critical_error("Invalid block in free list",(cell)block); + myvm->critical_error("Invalid block in free list",(cell)block); } -free_heap_block *factor_vm::find_free_block(heap *heap, cell size) +free_heap_block *heap::find_free_block(cell size) { cell attempt = size; while(attempt < free_list_count * block_size_increment) { int index = attempt / block_size_increment; - free_heap_block *block = heap->free.small_blocks[index]; + free_heap_block *block = free.small_blocks[index]; if(block) { assert_free_block(block); - heap->free.small_blocks[index] = block->next_free; + free.small_blocks[index] = block->next_free; return block; } @@ -117,7 +116,7 @@ free_heap_block *factor_vm::find_free_block(heap *heap, cell size) } free_heap_block *prev = NULL; - free_heap_block *block = heap->free.large_blocks; + free_heap_block *block = free.large_blocks; while(block) { @@ -127,7 +126,7 @@ free_heap_block *factor_vm::find_free_block(heap *heap, cell size) if(prev) prev->next_free = block->next_free; else - heap->free.large_blocks = block->next_free; + free.large_blocks = block->next_free; return block; } @@ -138,7 +137,7 @@ free_heap_block *factor_vm::find_free_block(heap *heap, cell size) return NULL; } -free_heap_block *factor_vm::split_free_block(heap *heap, free_heap_block *block, cell size) +free_heap_block *heap::split_free_block(free_heap_block *block, cell size) { if(block->size != size ) { @@ -148,21 +147,21 @@ free_heap_block *factor_vm::split_free_block(heap *heap, free_heap_block *block, split->size = block->size - size; split->next_free = block->next_free; block->size = size; - add_to_free_list(heap,split); + add_to_free_list(split); } return block; } /* Allocate a block of memory from the mark and sweep GC heap */ -heap_block *factor_vm::heap_allot(heap *heap, cell size) +heap_block *heap::heap_allot(cell size) { size = (size + block_size_increment - 1) & ~(block_size_increment - 1); - free_heap_block *block = find_free_block(heap,size); + free_heap_block *block = find_free_block(size); if(block) { - block = split_free_block(heap,block,size); + block = split_free_block(block,size); block->status = B_ALLOCATED; return block; @@ -172,13 +171,13 @@ heap_block *factor_vm::heap_allot(heap *heap, cell size) } /* Deallocates a block manually */ -void factor_vm::heap_free(heap *heap, heap_block *block) +void heap::heap_free(heap_block *block) { block->status = B_FREE; - add_to_free_list(heap,(free_heap_block *)block); + add_to_free_list((free_heap_block *)block); } -void factor_vm::mark_block(heap_block *block) +void heap::mark_block(heap_block *block) { /* If already marked, do nothing */ switch(block->status) @@ -189,41 +188,41 @@ void factor_vm::mark_block(heap_block *block) block->status = B_MARKED; break; default: - critical_error("Marking the wrong block",(cell)block); + myvm->critical_error("Marking the wrong block",(cell)block); break; } } /* If in the middle of code GC, we have to grow the heap, data GC restarts from scratch, so we have to unmark any marked blocks. */ -void factor_vm::unmark_marked(heap *heap) +void heap::unmark_marked() { - heap_block *scan = first_block(heap); + heap_block *scan = first_block(); while(scan) { if(scan->status == B_MARKED) scan->status = B_ALLOCATED; - scan = next_block(heap,scan); + scan = next_block(scan); } } /* After code GC, all referenced code blocks have status set to B_MARKED, so any which are allocated and not marked can be reclaimed. */ -void factor_vm::free_unmarked(heap *heap, heap_iterator iter) +void heap::free_unmarked(heap_iterator iter) { - clear_free_list(heap); + clear_free_list(); heap_block *prev = NULL; - heap_block *scan = first_block(heap); + heap_block *scan = first_block(); while(scan) { switch(scan->status) { case B_ALLOCATED: - if(secure_gc) + if(myvm->secure_gc) memset(scan + 1,0,scan->size - sizeof(heap_block)); if(prev && prev->status == B_FREE) @@ -242,30 +241,30 @@ void factor_vm::free_unmarked(heap *heap, heap_iterator iter) break; case B_MARKED: if(prev && prev->status == B_FREE) - add_to_free_list(heap,(free_heap_block *)prev); + add_to_free_list((free_heap_block *)prev); scan->status = B_ALLOCATED; prev = scan; - iter(scan,this); + iter(scan,myvm); break; default: - critical_error("Invalid scan->status",(cell)scan); + myvm->critical_error("Invalid scan->status",(cell)scan); } - scan = next_block(heap,scan); + scan = next_block(scan); } if(prev && prev->status == B_FREE) - add_to_free_list(heap,(free_heap_block *)prev); + add_to_free_list((free_heap_block *)prev); } /* Compute total sum of sizes of free blocks, and size of largest free block */ -void factor_vm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free) +void heap::heap_usage(cell *used, cell *total_free, cell *max_free) { *used = 0; *total_free = 0; *max_free = 0; - heap_block *scan = first_block(heap); + heap_block *scan = first_block(); while(scan) { @@ -280,34 +279,34 @@ void factor_vm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_f *max_free = scan->size; break; default: - critical_error("Invalid scan->status",(cell)scan); + myvm->critical_error("Invalid scan->status",(cell)scan); } - scan = next_block(heap,scan); + scan = next_block(scan); } } /* The size of the heap, not including the last block if it's free */ -cell factor_vm::heap_size(heap *heap) +cell heap::heap_size() { - heap_block *scan = first_block(heap); + heap_block *scan = first_block(); - while(next_block(heap,scan) != NULL) - scan = next_block(heap,scan); + while(next_block(scan) != NULL) + scan = next_block(scan); /* this is the last block in the heap, and it is free */ if(scan->status == B_FREE) - return (cell)scan - heap->seg->start; + return (cell)scan - seg->start; /* otherwise the last block is allocated */ else - return heap->seg->size; + return seg->size; } /* Compute where each block is going to go, after compaction */ -cell factor_vm::compute_heap_forwarding(heap *heap, unordered_map &forwarding) +cell heap::compute_heap_forwarding(unordered_map &forwarding) { - heap_block *scan = first_block(heap); - char *address = (char *)first_block(heap); + heap_block *scan = first_block(); + char *address = (char *)first_block(); while(scan) { @@ -317,21 +316,21 @@ cell factor_vm::compute_heap_forwarding(heap *heap, unordered_mapsize; } else if(scan->status == B_MARKED) - critical_error("Why is the block marked?",0); + myvm->critical_error("Why is the block marked?",0); - scan = next_block(heap,scan); + scan = next_block(scan); } - return (cell)address - heap->seg->start; + return (cell)address - seg->start; } -void factor_vm::compact_heap(heap *heap, unordered_map &forwarding) +void heap::compact_heap(unordered_map &forwarding) { - heap_block *scan = first_block(heap); + heap_block *scan = first_block(); while(scan) { - heap_block *next = next_block(heap,scan); + heap_block *next = next_block(scan); if(scan->status == B_ALLOCATED) memmove(forwarding[scan],scan,scan->size); diff --git a/vm/heap.hpp b/vm/heap.hpp new file mode 100644 index 0000000000..ab1cfeef6d --- /dev/null +++ b/vm/heap.hpp @@ -0,0 +1,59 @@ +namespace factor +{ + +static const cell free_list_count = 16; +static const cell block_size_increment = 32; + +struct heap_free_list { + free_heap_block *small_blocks[free_list_count]; + free_heap_block *large_blocks; +}; + +typedef void (*heap_iterator)(heap_block *compiled, factor_vm *vm); + +struct heap { + factor_vm *myvm; + segment *seg; + heap_free_list free; + + heap(factor_vm *myvm, cell size); + + inline heap_block *next_block(heap_block *block) + { + cell next = ((cell)block + block->size); + if(next == seg->end) + return NULL; + else + return (heap_block *)next; + } + + inline heap_block *first_block() + { + return (heap_block *)seg->start; + } + + inline heap_block *last_block() + { + return (heap_block *)seg->end; + } + + void clear_free_list(); + void new_heap(cell size); + void add_to_free_list(free_heap_block *block); + void build_free_list(cell size); + void assert_free_block(free_heap_block *block); + free_heap_block *find_free_block(cell size); + free_heap_block *split_free_block(free_heap_block *block, cell size); + heap_block *heap_allot(cell size); + void heap_free(heap_block *block); + void mark_block(heap_block *block); + void unmark_marked(); + void free_unmarked(heap_iterator iter); + void heap_usage(cell *used, cell *total_free, cell *max_free); + cell heap_size(); + cell compute_heap_forwarding(unordered_map &forwarding); + void compact_heap(unordered_map &forwarding); + +}; + +} diff --git a/vm/image.cpp b/vm/image.cpp index ade654c2e2..14bd0926b9 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -56,7 +56,7 @@ void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) if(h->code_size != 0) { - size_t bytes_read = fread(first_block(&code),1,h->code_size,file); + size_t bytes_read = fread(code->first_block(),1,h->code_size,file); if(bytes_read != h->code_size) { print_string("truncated image: "); @@ -69,7 +69,7 @@ void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p) } code_relocation_base = h->code_relocation_base; - build_free_list(&code,h->code_size); + code->build_free_list(h->code_size); } /* Save the current image to disk */ @@ -92,8 +92,8 @@ bool factor_vm::save_image(const vm_char *filename) h.version = image_version; h.data_relocation_base = tenured->start; h.data_size = tenured->here - tenured->start; - h.code_relocation_base = code.seg->start; - h.code_size = heap_size(&code); + h.code_relocation_base = code->seg->start; + h.code_size = code->heap_size(); h.t = T; h.bignum_zero = bignum_zero; @@ -107,7 +107,7 @@ bool factor_vm::save_image(const vm_char *filename) if(fwrite(&h,sizeof(image_header),1,file) != 1) ok = false; if(fwrite((void*)tenured->start,h.data_size,1,file) != 1) ok = false; - if(fwrite(first_block(&code),h.code_size,1,file) != 1) ok = false; + if(fwrite(code->first_block(),h.code_size,1,file) != 1) ok = false; if(fclose(file)) ok = false; if(!ok) @@ -175,7 +175,7 @@ void data_fixup(cell *cell, factor_vm *myvm) template void factor_vm::code_fixup(TYPE **handle) { TYPE *ptr = *handle; - TYPE *new_ptr = (TYPE *)(((cell)ptr) + (code.seg->start - code_relocation_base)); + TYPE *new_ptr = (TYPE *)(((cell)ptr) + (code->seg->start - code_relocation_base)); *handle = new_ptr; } diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 71076821b5..39147d0570 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -24,7 +24,7 @@ void factor_vm::deallocate_inline_cache(cell return_address) #endif if(old_type == PIC_TYPE) - heap_free(&code,old_block); + code->heap_free(old_block); } /* Figure out what kind of type check the PIC needs based on the methods diff --git a/vm/master.hpp b/vm/master.hpp index e4df60a8a2..e51273f546 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -64,7 +64,7 @@ #include "math.hpp" #include "float_bits.hpp" #include "io.hpp" -#include "code_gc.hpp" +#include "heap.hpp" #include "code_heap.hpp" #include "image.hpp" #include "callstack.hpp" diff --git a/vm/vm-data.hpp b/vm/vm-data.hpp index f4faf5b46b..7afea3c876 100644 --- a/vm/vm-data.hpp +++ b/vm/vm-data.hpp @@ -83,8 +83,8 @@ struct factor_vm_data { cell bignum_neg_one; //code_heap - heap code; - unordered_map forwarding; + heap *code; + unordered_map forwarding; //image cell code_relocation_base; diff --git a/vm/vm.hpp b/vm/vm.hpp index 282f48b41e..056393edb4 100644 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -381,24 +381,6 @@ struct factor_vm : factor_vm_data { inline void primitive_fflush(); inline void primitive_fclose(); - //code_gc - void clear_free_list(heap *heap); - void new_heap(heap *heap, cell size); - void add_to_free_list(heap *heap, free_heap_block *block); - void build_free_list(heap *heap, cell size); - void assert_free_block(free_heap_block *block); - free_heap_block *find_free_block(heap *heap, cell size); - free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size); - heap_block *heap_allot(heap *heap, cell size); - void heap_free(heap *heap, heap_block *block); - void mark_block(heap_block *block); - void unmark_marked(heap *heap); - void free_unmarked(heap *heap, heap_iterator iter); - void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free); - cell heap_size(heap *heap); - cell compute_heap_forwarding(heap *heap, unordered_map &forwarding); - void compact_heap(heap *heap, unordered_map &forwarding); - //code_block relocation_type relocation_type_of(relocation_entry r); relocation_class relocation_class_of(relocation_entry r); From f81c8549f471a5ae6faf8de4bafd4f1421f87ac0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 21:17:20 -0500 Subject: [PATCH 16/20] Make segment, context, data_heap, zone more object-oriented, and fix crash when calling undefined symbols --- vm/code_block.cpp | 4 +- vm/contexts.cpp | 6 +-- vm/data_gc.cpp | 2 +- vm/data_heap.cpp | 95 ++++++++++++++++++++-------------------------- vm/data_heap.hpp | 28 ++++++++------ vm/heap.cpp | 2 +- vm/inlineimpls.hpp | 7 ---- vm/os-genunix.cpp | 3 +- vm/os-linux.cpp | 4 +- vm/os-unix.cpp | 27 +++++-------- vm/os-windows.cpp | 23 +++++------ vm/segments.hpp | 13 +++++++ vm/vm.hpp | 8 ---- 13 files changed, 103 insertions(+), 119 deletions(-) diff --git a/vm/code_block.cpp b/vm/code_block.cpp index bd7a93bf6d..507dd3bd61 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -93,9 +93,9 @@ void factor_vm::undefined_symbol() general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL); } -void undefined_symbol(factor_vm *myvm) +void undefined_symbol() { - return myvm->undefined_symbol(); + return SIGNAL_VM_PTR()->undefined_symbol(); } /* Look up an external library symbol referenced by a compiled code block */ diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 6e51ed8ba9..d2d9db2b51 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -43,9 +43,9 @@ context *factor_vm::alloc_context() } else { - new_context = (context *)safe_malloc(sizeof(context)); - new_context->datastack_region = alloc_segment(ds_size); - new_context->retainstack_region = alloc_segment(rs_size); + new_context = new context; + new_context->datastack_region = new segment(this,ds_size); + new_context->retainstack_region = new segment(this,rs_size); } return new_context; diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp index 011cc1f5f3..07f457b447 100755 --- a/vm/data_gc.cpp +++ b/vm/data_gc.cpp @@ -455,7 +455,7 @@ void factor_vm::end_gc(cell gc_elapsed) if(growing_data_heap) { - dealloc_data_heap(old_data_heap); + delete old_data_heap; old_data_heap = NULL; growing_data_heap = false; } diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp index 5eaa715e6c..ecc891b369 100755 --- a/vm/data_heap.cpp +++ b/vm/data_heap.cpp @@ -3,14 +3,6 @@ namespace factor { -cell factor_vm::init_zone(zone *z, cell size, cell start) -{ - z->size = size; - z->start = z->here = start; - z->end = start + size; - return z->end; -} - void factor_vm::init_card_decks() { cell start = align(data->seg->start,deck_size); @@ -19,89 +11,86 @@ void factor_vm::init_card_decks() decks_offset = (cell)data->decks - (start >> deck_bits); } -data_heap *factor_vm::alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size) +data_heap::data_heap(factor_vm *myvm, cell gen_count_, cell young_size_, cell aging_size_, cell tenured_size_) { - young_size = align(young_size,deck_size); - aging_size = align(aging_size,deck_size); - tenured_size = align(tenured_size,deck_size); + young_size_ = align(young_size_,deck_size); + aging_size_ = align(aging_size_,deck_size); + tenured_size_ = align(tenured_size_,deck_size); - data_heap *data = (data_heap *)safe_malloc(sizeof(data_heap)); - data->young_size = young_size; - data->aging_size = aging_size; - data->tenured_size = tenured_size; - data->gen_count = gens; + young_size = young_size_; + aging_size = aging_size_; + tenured_size = tenured_size_; + gen_count = gen_count_; cell total_size; - if(data->gen_count == 2) + if(gen_count == 2) total_size = young_size + 2 * tenured_size; - else if(data->gen_count == 3) + else if(gen_count == 3) total_size = young_size + 2 * aging_size + 2 * tenured_size; else { - fatal_error("Invalid number of generations",data->gen_count); - return NULL; /* can't happen */ + total_size = 0; + fatal_error("Invalid number of generations",gen_count); } total_size += deck_size; - data->seg = alloc_segment(total_size); + seg = new segment(myvm,total_size); - data->generations = (zone *)safe_malloc(sizeof(zone) * data->gen_count); - data->semispaces = (zone *)safe_malloc(sizeof(zone) * data->gen_count); + generations = new zone[gen_count]; + semispaces = new zone[gen_count]; cell cards_size = total_size >> card_bits; - data->allot_markers = (cell *)safe_malloc(cards_size); - data->allot_markers_end = data->allot_markers + cards_size; + allot_markers = new char[cards_size]; + allot_markers_end = allot_markers + cards_size; - data->cards = (cell *)safe_malloc(cards_size); - data->cards_end = data->cards + cards_size; + cards = new char[cards_size]; + cards_end = cards + cards_size; cell decks_size = total_size >> deck_bits; - data->decks = (cell *)safe_malloc(decks_size); - data->decks_end = data->decks + decks_size; + decks = new char[decks_size]; + decks_end = decks + decks_size; - cell alloter = align(data->seg->start,deck_size); + cell alloter = align(seg->start,deck_size); - alloter = init_zone(&data->generations[data->tenured()],tenured_size,alloter); - alloter = init_zone(&data->semispaces[data->tenured()],tenured_size,alloter); + alloter = generations[tenured()].init_zone(tenured_size,alloter); + alloter = semispaces[tenured()].init_zone(tenured_size,alloter); - if(data->gen_count == 3) + if(gen_count == 3) { - alloter = init_zone(&data->generations[data->aging()],aging_size,alloter); - alloter = init_zone(&data->semispaces[data->aging()],aging_size,alloter); + alloter = generations[aging()].init_zone(aging_size,alloter); + alloter = semispaces[aging()].init_zone(aging_size,alloter); } - if(data->gen_count >= 2) + if(gen_count >= 2) { - alloter = init_zone(&data->generations[data->nursery()],young_size,alloter); - alloter = init_zone(&data->semispaces[data->nursery()],0,alloter); + alloter = generations[nursery()].init_zone(young_size,alloter); + alloter = semispaces[nursery()].init_zone(0,alloter); } - if(data->seg->end - alloter > deck_size) - critical_error("Bug in alloc_data_heap",alloter); - - return data; + if(seg->end - alloter > deck_size) + myvm->critical_error("Bug in alloc_data_heap",alloter); } data_heap *factor_vm::grow_data_heap(data_heap *data, cell requested_bytes) { cell new_tenured_size = (data->tenured_size * 2) + requested_bytes; - return alloc_data_heap(data->gen_count, + return new data_heap(this, + data->gen_count, data->young_size, data->aging_size, new_tenured_size); } -void factor_vm::dealloc_data_heap(data_heap *data) +data_heap::~data_heap() { - dealloc_segment(data->seg); - free(data->generations); - free(data->semispaces); - free(data->allot_markers); - free(data->cards); - free(data->decks); - free(data); + delete seg; + delete[] generations; + delete[] semispaces; + delete[] allot_markers; + delete[] cards; + delete[] decks; } void factor_vm::clear_cards(cell from, cell to) @@ -162,7 +151,7 @@ void factor_vm::set_data_heap(data_heap *data_) void factor_vm::init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_) { - set_data_heap(alloc_data_heap(gens,young_size,aging_size,tenured_size)); + set_data_heap(new data_heap(this,gens,young_size,aging_size,tenured_size)); secure_gc = secure_gc_; init_data_gc(); } diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp index 81a3405d42..8b8ca59185 100755 --- a/vm/data_heap.hpp +++ b/vm/data_heap.hpp @@ -9,6 +9,14 @@ struct zone { cell here; cell size; cell end; + + cell init_zone(cell size_, cell start_) + { + size = size_; + start = here = start_; + end = start_ + size_; + return end; + } }; struct data_heap { @@ -23,14 +31,14 @@ struct data_heap { zone *generations; zone *semispaces; - cell *allot_markers; - cell *allot_markers_end; + char *allot_markers; + char *allot_markers_end; - cell *cards; - cell *cards_end; + char *cards; + char *cards_end; - cell *decks; - cell *decks_end; + char *decks; + char *decks_end; /* the 0th generation is where new objects are allocated. */ cell nursery() { return 0; } @@ -42,6 +50,9 @@ struct data_heap { cell tenured() { return gen_count - 1; } bool have_aging_p() { return gen_count > 2; } + + data_heap(factor_vm *myvm, cell gen_count, cell young_size, cell aging_size, cell tenured_size); + ~data_heap(); }; static const cell max_gen_count = 3; @@ -51,11 +62,6 @@ inline static bool in_zone(zone *z, object *pointer) return (cell)pointer >= z->start && (cell)pointer < z->end; } -/* set up guard pages to check for under/overflow. -size must be a multiple of the page size */ -segment *alloc_segment(cell size); // defined in OS-*.cpp files PD -void dealloc_segment(segment *block); - PRIMITIVE(data_room); PRIMITIVE(size); diff --git a/vm/heap.cpp b/vm/heap.cpp index 0905d7c190..c8262cb7f5 100644 --- a/vm/heap.cpp +++ b/vm/heap.cpp @@ -14,7 +14,7 @@ void heap::clear_free_list() heap::heap(factor_vm *myvm_, cell size) { myvm = myvm_; - seg = myvm->alloc_segment(myvm->align_page(size)); + seg = new segment(myvm,align_page(size)); if(!seg) fatal_error("Out of memory in new_heap",size); clear_free_list(); } diff --git a/vm/inlineimpls.hpp b/vm/inlineimpls.hpp index db6ef8abf4..7074f0d33a 100644 --- a/vm/inlineimpls.hpp +++ b/vm/inlineimpls.hpp @@ -4,13 +4,6 @@ namespace factor // I've had to copy inline implementations here to make dependencies work. Am hoping to move this code back into include files // once the rest of the reentrant changes are done. -PD -// segments.hpp - -inline cell factor_vm::align_page(cell a) -{ - return align(a,getpagesize()); -} - // write_barrier.hpp inline card *factor_vm::addr_to_card(cell a) diff --git a/vm/os-genunix.cpp b/vm/os-genunix.cpp index 7f2429e46a..015a76f842 100644 --- a/vm/os-genunix.cpp +++ b/vm/os-genunix.cpp @@ -18,6 +18,7 @@ void early_init() { } #define SUFFIX ".image" #define SUFFIX_LEN 6 +/* You must delete[] the result yourself. */ const char *default_image_path() { const char *path = vm_executable_path(); @@ -31,7 +32,7 @@ const char *default_image_path() const char *iter = path; while(*iter) { len++; iter++; } - char *new_path = (char *)safe_malloc(PATH_MAX + SUFFIX_LEN + 1); + char *new_path = new char[PATH_MAX + SUFFIX_LEN + 1]; memcpy(new_path,path,len + 1); memcpy(new_path + len,SUFFIX,SUFFIX_LEN + 1); return new_path; diff --git a/vm/os-linux.cpp b/vm/os-linux.cpp index 66b197e7c9..2d26fba390 100644 --- a/vm/os-linux.cpp +++ b/vm/os-linux.cpp @@ -3,10 +3,10 @@ namespace factor { -/* Snarfed from SBCL linux-so.c. You must free() this yourself. */ +/* Snarfed from SBCL linux-so.c. You must delete[] the result yourself. */ const char *vm_executable_path() { - char *path = (char *)safe_malloc(PATH_MAX + 1); + char *path = new char[PATH_MAX + 1]; int size = readlink("/proc/self/exe", path, PATH_MAX); if (size < 0) diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index c829c3570c..d1af5cb565 100644 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -83,8 +83,11 @@ inline void factor_vm::primitive_existsp() PRIMITIVE_FORWARD(existsp) -segment *factor_vm::alloc_segment(cell size) +segment::segment(factor_vm *myvm_, cell size_) { + myvm = myvm_; + size = size_; + int pagesize = getpagesize(); char *array = (char *)mmap(NULL,pagesize + size + pagesize, @@ -92,7 +95,7 @@ segment *factor_vm::alloc_segment(cell size) MAP_ANON | MAP_PRIVATE,-1,0); if(array == (char*)-1) - out_of_memory(); + myvm->out_of_memory(); if(mprotect(array,pagesize,PROT_NONE) == -1) fatal_error("Cannot protect low guard page",(cell)array); @@ -100,26 +103,16 @@ segment *factor_vm::alloc_segment(cell size) if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1) fatal_error("Cannot protect high guard page",(cell)array); - segment *retval = (segment *)safe_malloc(sizeof(segment)); - - retval->start = (cell)(array + pagesize); - retval->size = size; - retval->end = retval->start + size; - - return retval; + start = (cell)(array + pagesize); + end = start + size; } -void dealloc_segment(segment *block) +segment::~segment() { int pagesize = getpagesize(); - - int retval = munmap((void*)(block->start - pagesize), - pagesize + block->size + pagesize); - + int retval = munmap((void*)(start - pagesize),pagesize + size + pagesize); if(retval) - fatal_error("dealloc_segment failed",0); - - free(block); + fatal_error("Segment deallocation failed",0); } stack_frame *factor_vm::uap_stack_pointer(void *uap) diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index 7d4b345da6..077bc48aa1 100644 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -98,14 +98,17 @@ inline void factor_vm::primitive_existsp() PRIMITIVE_FORWARD(existsp) -segment *factor_vm::alloc_segment(cell size) +segment::segment(factor_vm *myvm_, cell size_) { + myvm = myvm_; + size = size_; + char *mem; DWORD ignore; if((mem = (char *)VirtualAlloc(NULL, getpagesize() * 2 + size, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) == 0) - out_of_memory(); + myvm->out_of_memory(); if (!VirtualProtect(mem, getpagesize(), PAGE_NOACCESS, &ignore)) fatal_error("Cannot allocate low guard page", (cell)mem); @@ -114,22 +117,16 @@ segment *factor_vm::alloc_segment(cell size) getpagesize(), PAGE_NOACCESS, &ignore)) fatal_error("Cannot allocate high guard page", (cell)mem); - segment *block = (segment *)safe_malloc(sizeof(segment)); - - block->start = (cell)mem + getpagesize(); - block->size = size; - block->end = block->start + size; - - return block; + start = (cell)mem + getpagesize(); + end = start + size; } -void factor_vm::dealloc_segment(segment *block) +segment::~segment() { SYSTEM_INFO si; GetSystemInfo(&si); - if(!VirtualFree((void*)(block->start - si.dwPageSize), 0, MEM_RELEASE)) - fatal_error("dealloc_segment failed",0); - free(block); + if(!VirtualFree((void*)(start - si.dwPageSize), 0, MEM_RELEASE)) + myvm->fatal_error("Segment deallocation failed",0); } long factor_vm::getpagesize() diff --git a/vm/segments.hpp b/vm/segments.hpp index a715b4dabc..1884526ad2 100644 --- a/vm/segments.hpp +++ b/vm/segments.hpp @@ -1,10 +1,23 @@ namespace factor { +struct factor_vm; + +inline cell align_page(cell a) +{ + return align(a,getpagesize()); +} + +/* segments set up guard pages to check for under/overflow. +size must be a multiple of the page size */ struct segment { + factor_vm *myvm; cell start; cell size; cell end; + + segment(factor_vm *myvm, cell size); + ~segment(); }; } diff --git a/vm/vm.hpp b/vm/vm.hpp index 056393edb4..d75c3e0eaf 100644 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -5,9 +5,6 @@ namespace factor struct factor_vm : factor_vm_data { - // segments - inline cell align_page(cell a); - // contexts void reset_datastack(); void reset_retainstack(); @@ -127,11 +124,8 @@ struct factor_vm : factor_vm_data { bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factor_vm *), unsigned int radix, int negative_p); //data_heap - cell init_zone(zone *z, cell size, cell start); void init_card_decks(); - data_heap *alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size); data_heap *grow_data_heap(data_heap *data, cell requested_bytes); - void dealloc_data_heap(data_heap *data); void clear_cards(cell from, cell to); void clear_decks(cell from, cell to); void clear_allot_markers(cell from, cell to); @@ -560,14 +554,12 @@ struct factor_vm : factor_vm_data { void ffi_dlopen(dll *dll); void *ffi_dlsym(dll *dll, symbol_char *symbol); void ffi_dlclose(dll *dll); - segment *alloc_segment(cell size); void c_to_factor_toplevel(cell quot); // os-windows #if defined(WINDOWS) void sleep_micros(u64 usec); long getpagesize(); - void dealloc_segment(segment *block); const vm_char *vm_executable_path(); const vm_char *default_image_path(); void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length); From f846afd66135cd585ae557802495d191ad2bfe56 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 21:22:05 -0500 Subject: [PATCH 17/20] vm: remove safe_malloc now that everything uses constructors instead --- vm/utilities.cpp | 7 ------- vm/utilities.hpp | 1 - 2 files changed, 8 deletions(-) diff --git a/vm/utilities.cpp b/vm/utilities.cpp index 4190d02c05..0595430283 100755 --- a/vm/utilities.cpp +++ b/vm/utilities.cpp @@ -4,13 +4,6 @@ namespace factor { /* If memory allocation fails, bail out */ -void *safe_malloc(size_t size) -{ - void *ptr = malloc(size); - if(!ptr) fatal_error("Out of memory in safe_malloc", 0); - return ptr; -} - vm_char *safe_strdup(const vm_char *str) { vm_char *ptr = STRDUP(str); diff --git a/vm/utilities.hpp b/vm/utilities.hpp index 68e0c97b25..f93fe13f78 100755 --- a/vm/utilities.hpp +++ b/vm/utilities.hpp @@ -1,6 +1,5 @@ namespace factor { - void *safe_malloc(size_t size); vm_char *safe_strdup(const vm_char *str); void print_string(const char *str); void nl(); From fa598be66776525934e6cfc4b407f1b1c33b37e8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 21:42:21 -0500 Subject: [PATCH 18/20] Fix GC root safety in word-xt primitive --- core/words/words-tests.factor | 2 ++ vm/words.cpp | 17 +++++++++++++---- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index c3dacbaf14..b9d6e80630 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -125,3 +125,5 @@ DEFER: x keys [ "forgotten" word-prop ] filter ] map harvest ] unit-test + +[ "hi" word-xt ] must-fail diff --git a/vm/words.cpp b/vm/words.cpp index ce25313ea2..b6f7097f71 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -44,10 +44,19 @@ PRIMITIVE_FORWARD(word) /* word-xt ( word -- start end ) */ inline void factor_vm::primitive_word_xt() { - word *w = untag_check(dpop()); - code_block *code = (profiling_p ? w->profiling : w->code); - dpush(allot_cell((cell)code->xt())); - dpush(allot_cell((cell)code + code->size)); + gc_root w(dpop(),this); + w.untag_check(this); + + if(profiling_p) + { + dpush(allot_cell((cell)w->profiling->xt())); + dpush(allot_cell((cell)w->profiling + w->profiling->size)); + } + else + { + dpush(allot_cell((cell)w->code->xt())); + dpush(allot_cell((cell)w->code + w->code->size)); + } } PRIMITIVE_FORWARD(word_xt) From c38d523185d74da370b8428447c69ce08c452a7e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 21:44:14 -0500 Subject: [PATCH 19/20] math.vectors: fix SIMD unit tests --- basis/math/vectors/simd/simd-tests.factor | 10 +++++++--- basis/math/vectors/vectors.factor | 4 ++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 535a671359..f7c051fdce 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -81,9 +81,13 @@ CONSTANT: simd-classes : check-optimizer ( seq inputs quot eq-quot -- ) '[ @ - [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ] - [ [ call ] dip call ] - [ [ call ] dip compile-call ] 2tri @ not + { + [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ] + [ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ] + [ [ call ] dip call ] + [ [ call ] dip compile-call ] + } 2cleave + @ not ] filter ; inline "== Checking -new constructors" print diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 1bd202f2ad..e3e4f51e28 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -61,8 +61,8 @@ PRIVATE> : vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ; : vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ; -: vlshift ( u n -- w ) HEX: ff bitand '[ _ shift ] map ; -: vrshift ( u n -- w ) HEX: ff bitand neg '[ _ shift ] map ; +: vlshift ( u n -- w ) HEX: ffffffff bitand '[ _ shift ] map ; +: vrshift ( u n -- w ) HEX: ffffffff bitand neg '[ _ shift ] map ; : vfloor ( u -- v ) [ floor ] map ; : vceiling ( u -- v ) [ ceiling ] map ; From 8610fa5e488d93fd55b5c8fe628faae4408816c8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 25 Sep 2009 21:47:05 -0500 Subject: [PATCH 20/20] cpu: cleanups --- basis/cpu/ppc/ppc.factor | 2 +- basis/cpu/x86/32/32.factor | 10 +++++----- basis/cpu/x86/64/64.factor | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index eabac51db5..bcd52206a0 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -510,7 +510,7 @@ M:: ppc %save-gc-root ( gc-root register -- ) M:: ppc %load-gc-root ( gc-root register -- ) register 1 gc-root gc-root@ LWZ ; -M:: ppc %call-gc ( gc-root-count -- ) +M:: ppc %call-gc ( gc-root-count temp -- ) 3 1 gc-root-base local@ ADDI gc-root-count 4 LI "inline_gc" f %alien-invoke ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 84294b4912..5f6c0d4696 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -314,15 +314,15 @@ M: x86.32 %callback-return ( n -- ) [ drop 0 ] } cond RET ; -M:: x86.32 %call-gc ( gc-root-count temp1 -- ) - ! USE: prettyprint "PHIL" pprint temp1 pprint temp2 pprint - temp1 gc-root-base param@ LEA +M:: x86.32 %call-gc ( gc-root-count temp -- ) + temp gc-root-base param@ LEA 12 [ - 0 PUSH rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument + ! Pass the VM ptr as the third parameter + 0 PUSH rc-absolute-cell rt-vm rel-fixup ! Pass number of roots as second parameter gc-root-count PUSH ! Pass pointer to start of GC roots as first parameter - temp1 PUSH + temp PUSH ! Call GC "inline_gc" f %alien-invoke ] with-aligned-stack ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index dfe537baa3..562563039e 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -235,12 +235,12 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- ) func f %alien-invoke dst float-function-return ; -M:: x86.64 %call-gc ( gc-root-count temp1 -- ) +M:: x86.64 %call-gc ( gc-root-count temp -- ) ! Pass pointer to start of GC roots as first parameter param-reg-1 gc-root-base param@ LEA ! Pass number of roots as second parameter param-reg-2 gc-root-count MOV - ! Pass vm as third parameter + ! Pass VM ptr as third parameter param-reg-3 %mov-vm-ptr ! Call GC "inline_gc" f %alien-invoke ;