Merge Phil Dawes' VM work

[factor.git] / basis / compiler / codegen / codegen.factor

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 23b02aa224aabe47ad8913ab84b9e170924ff13f..e1551f54c0fca0f728701f0fb471f85929227328 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
-combinators classes.algebra alien alien.c-types alien.structs
+combinators classes.algebra alien alien.c-types
 alien.strings alien.arrays alien.complex alien.libraries sets libc
 continuations.private fry cpu.architecture classes locals
 source-files.errors slots parser generic.parser
@@ -16,6 +16,8 @@ compiler.cfg.registers
 compiler.cfg.builder
 compiler.codegen.fixup
 compiler.utilities ;
+QUALIFIED: classes.struct
+QUALIFIED: alien.structs
 IN: compiler.codegen
 
 SYMBOL: insn-counts
@@ -201,6 +203,7 @@ CODEGEN: ##compare %compare
 CODEGEN: ##compare-imm %compare-imm
 CODEGEN: ##compare-float-ordered %compare-float-ordered
 CODEGEN: ##compare-float-unordered %compare-float-unordered
+CODEGEN: ##save-context %save-context
 
 CODEGEN: _fixnum-add %fixnum-add
 CODEGEN: _fixnum-sub %fixnum-sub
@@ -254,6 +257,7 @@ M: _gc generate-insn
         [ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
         [ 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>> ] [ temp1>> ] bi load-gc-roots ]
         [ data-values>> load-data-regs ]
@@ -266,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 -- )
 
@@ -314,7 +321,10 @@ GENERIC: flatten-value-type ( type -- types )
 
 M: object flatten-value-type 1array ;
 
-M: struct-type flatten-value-type ( type -- types )
+M: alien.structs:struct-type flatten-value-type ( type -- types )
+    stack-size cell align (flatten-int-type) ;
+
+M: classes.struct:struct-c-type flatten-value-type ( type -- types )
     stack-size cell align (flatten-int-type) ;
 
 M: long-long-type flatten-value-type ( type -- types )
@@ -396,8 +406,6 @@ M: long-long-type flatten-value-type ( type -- types )
 
 M: ##alien-invoke generate-insn
     params>>
-    ! Save registers for GC
-    %prepare-alien-invoke
     ! Unbox parameters
     dup objects>registers
     %prepare-var-args
@@ -410,8 +418,6 @@ M: ##alien-invoke generate-insn
 ! ##alien-indirect
 M: ##alien-indirect generate-insn
     params>>
-    ! Save registers for GC
-    %prepare-alien-invoke
     ! Save alien at top of stack to temporary storage
     %prepare-alien-indirect
     ! Unbox parameters
@@ -431,7 +437,7 @@ M: ##alien-indirect generate-insn
     ! Generate code for boxing input parameters in a callback.
     [
         dup \ %save-param-reg move-parameters
-        "nest_stacks" f %alien-invoke
+        "nest_stacks" %vm-invoke-1st-arg
         box-parameters
     ] with-param-regs ;
 
@@ -453,7 +459,7 @@ TUPLE: callback-context ;
 
 : callback-return-quot ( ctype -- quot )
     return>> {
-        { [ dup "void" = ] [ drop [ ] ] }
+        { [ dup void? ] [ drop [ ] ] }
         { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
         [ c-type c-type-unboxer-quot ]
     } cond ;
@@ -469,7 +475,7 @@ TUPLE: callback-context ;
         [ callback-context new do-callback ] %
     ] [ ] make ;
 
-: %unnest-stacks ( -- ) "unnest_stacks" f %alien-invoke ;
+: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke-1st-arg ;
 
 M: ##callback-return generate-insn
     #! All the extra book-keeping for %unwind is only for x86.