]> gitweb.factorcode.org Git - factor.git/commitdiff
fixed up getenv compiler intrinsic to use vm struct userenv
authorPhil Dawes <phil@phildawes.net>
Fri, 21 Aug 2009 19:13:49 +0000 (20:13 +0100)
committerPhil Dawes <phil@phildawes.net>
Wed, 16 Sep 2009 07:16:32 +0000 (08:16 +0100)
basis/compiler/cfg/alias-analysis/alias-analysis.factor
basis/compiler/cfg/hats/hats.factor
basis/compiler/cfg/instructions/instructions.factor
basis/compiler/cfg/intrinsics/misc/misc.factor
basis/compiler/codegen/codegen.factor
basis/cpu/architecture/architecture.factor
basis/cpu/ppc/ppc.factor
basis/cpu/x86/x86.factor
basis/vm/vm.factor
vm/os-macosx.mm
vm/vm.hpp

index fcfc89ea523206e7855a59f341dc81e29b50e747..cb8b2de54303c851db2d83bb564f0deb8561ce7c 100644 (file)
@@ -190,12 +190,14 @@ M: ##slot-imm insn-slot# slot>> ;
 M: ##set-slot insn-slot# slot>> constant ;
 M: ##set-slot-imm insn-slot# slot>> ;
 M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
+M: ##vm-field-ptr insn-slot# fieldname>> 1array ;  ! is this right?
 
 M: ##slot insn-object obj>> resolve ;
 M: ##slot-imm insn-object obj>> resolve ;
 M: ##set-slot insn-object obj>> resolve ;
 M: ##set-slot-imm insn-object obj>> resolve ;
 M: ##alien-global insn-object drop \ ##alien-global ;
+M: ##vm-field-ptr insn-object drop \ ##vm-field-ptr ;
 
 : init-alias-analysis ( insns -- insns' )
     H{ } clone histories set
index 469ba37703ca333e531c9cd04a4dabcefdd6dd19..1b99b5d4dd185144c19a03660a7abc182b7928da 100644 (file)
@@ -57,4 +57,4 @@ insn-classes get [
 : ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
 : ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ; inline
 : ^^tag-fixnum ( src -- dst ) tag-bits get ^^shl-imm ; inline
-: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
\ No newline at end of file
+: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
index 32e5d46c61469c77165e1c4cbf875354ad779db4..7c28198f67d29c902216309ef458fd1d58a704b0 100644 (file)
@@ -450,6 +450,10 @@ INSN: ##alien-global
 def: dst/int-rep
 literal: symbol library ;
 
+INSN: ##vm-field-ptr
+def: dst/int-rep
+literal: fieldname ;
+
 ! FFI
 INSN: ##alien-invoke
 literal: params stack-frame ;
index f9f2182a4ec97ac0df9e00430099479d819198aa..f9f34887736f3c222937dba1ec3482369df93d60 100644 (file)
@@ -10,7 +10,7 @@ IN: compiler.cfg.intrinsics.misc
     ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
 
 : emit-getenv ( node -- )
-    "userenv" f ^^alien-global
+    "userenv" ^^vm-field-ptr
     swap node-input-infos first literal>>
     [ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot 0 ^^slot ] if*
     ds-push ;
index 0456ff485f077232de68aa2553bfe19a6e32f52a..de15cda21c45c9c0d42bae0e0f0f12afb3d6cf5d 100755 (executable)
@@ -270,6 +270,9 @@ M: ##alien-global generate-insn
     [ dst>> ] [ symbol>> ] [ library>> ] tri
     %alien-global ;
 
+M: ##vm-field-ptr generate-insn
+    [ dst>> ] [ fieldname>> ] bi %vm-field-ptr ;
+
 ! ##alien-invoke
 GENERIC: next-fastcall-param ( rep -- )
 
index da1bcfc61fe00c929dd5c14ccf8fca1901ece131..b9d07f578e0d1f97dac458c805c98d18a11573d9 100644 (file)
@@ -202,6 +202,7 @@ HOOK: %set-alien-double    cpu ( ptr value -- )
 HOOK: %set-alien-vector    cpu ( ptr value rep -- )
 
 HOOK: %alien-global cpu ( dst symbol library -- )
+HOOK: %vm-field-ptr cpu ( dst fieldname -- )
 
 HOOK: %allot cpu ( dst size class temp -- )
 HOOK: %write-barrier cpu ( src card# table -- )
index 37a5369259c66736c89672edd20b81b21af0138e..fc6a1221018392b75d86505794622c6a3982c8cb 100644 (file)
@@ -36,6 +36,7 @@ enable-float-intrinsics
     [ drop %load-vm-addr ]
     [ [ dup ] dip vm-field-offset ADDI ] 2bi ;
 
+M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
 
 M: ppc machine-registers
     {
index 7e73275dde1433e2978dfcf02df5a75572379706..57517ba3192e282a10f794a0881e145e45c128d1 100644 (file)
@@ -1,6 +1,5 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-<<<<<<< HEAD
 USING: accessors assocs alien alien.c-types arrays strings
 cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
 cpu.architecture kernel kernel.private math memory namespaces make
@@ -12,15 +11,7 @@ compiler.cfg.intrinsics
 compiler.cfg.comparisons
 compiler.cfg.stack-frame
 compiler.codegen
-compiler.codegen.fixup ;
-=======
-USING: accessors alien combinators compiler.cfg.comparisons
-compiler.cfg.intrinsics compiler.cfg.registers
-compiler.cfg.stack-frame compiler.codegen.fixup compiler.constants
-cpu.architecture cpu.x86.assembler cpu.x86.assembler.operands fry
-kernel layouts locals make math math.order namespaces sequences system
-vm ;
->>>>>>> Added a vm C-STRUCT, using it for struct offsets in x86 asm
+compiler.codegen.fixup vm ;
 IN: cpu.x86
 
 << enable-fixnum-log2 >>
@@ -564,10 +555,13 @@ M: x86 %shl [ SHL ] emit-shift ;
 M: x86 %shr [ SHR ] emit-shift ;
 M: x86 %sar [ SAR ] emit-shift ;
 
+M: x86 %vm-field-ptr ( dst field -- )
+    [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
+    [ vm-field-offset ADD ] 2bi ;
+
 : load-zone-ptr ( reg -- )
     #! Load pointer to start of zone array
-    [ 0 MOV rc-absolute-cell rt-vm rel-fixup ]
-    [ "nursery" vm-field-offset ADD ] bi ;
+    "nursery" %vm-field-ptr ;
 
 : load-allot-ptr ( nursery-ptr allot-ptr -- )
     [ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
@@ -587,9 +581,6 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
     dst class store-tagged
     nursery-ptr size inc-allot-ptr ;
 
-: %vm-field-ptr ( reg field -- )
-    [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
-    [ vm-field-offset ADD ] 2bi ;
 
 M:: x86 %write-barrier ( src card# table -- )
     #! Mark the card pointed to by vreg.
@@ -627,7 +618,7 @@ M:: x86 %call-gc ( gc-root-count -- )
     "inline_gc" f %vm-invoke ;
 
 M: x86 %alien-global ( dst symbol library -- )
-    [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
+    [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;    
 
 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
 
index 655250d7554ef4a0e0b9db97560450979627a295..e2e7fc879cbe168b0be9fbf71e532e3e5d58587f 100644 (file)
@@ -17,6 +17,8 @@ C-STRUCT: vm
     { "zone" "nursery" }
     { "cell" "cards_offset" }
     { "cell" "decks_offset" }
+    { "cell" "__padding__" }
+    { "cell[70]" "userenv" }
     ;
 
 : vm-field-offset ( field -- offset ) "vm" offset-of ;
\ No newline at end of file
index 865371b8ac431503a5183ce4f6ee5611ae218b56..e4da7b2221031e0cf95b79f9323b52b8ad1e0749 100644 (file)
@@ -14,7 +14,7 @@ NS_DURING
                NS_VOIDRETURN;
 NS_HANDLER
                dpush(vm->allot_alien(F,(cell)localException));
-               quot = userenv[COCOA_EXCEPTION_ENV];
+               quot = vm->userenv[COCOA_EXCEPTION_ENV];
                if(!tagged<object>(quot).type_p(QUOTATION_TYPE))
                {
                        /* No Cocoa exception handler was registered, so
index e0b598de6fbca394d0a1b86f3c21be55da1bda33..8372c3f0bab18ae46ae48a7fd5091ce2d6624d1b 100644 (file)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -8,9 +8,13 @@ struct factorvm {
        zone nursery; /* new objects are allocated here */
        cell cards_offset;
        cell decks_offset;
-       cell __padding__ ;   // align to 8byte boundary (for 32bit platforms)
+#ifndef FACTOR_64
+       cell __padding__ ;   // align to 8 byte boundary
+#endif
        cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
-
+#ifndef FACTOR_64
+       cell __padding2__;   // not sure why we need this, bootstrap doesn't work without it
+#endif
 
        // segments
        inline cell align_page(cell a);