compiler: add intrinsic for context-object primitive

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 68a8b8ce59d6fc376e2d6251a1be2f1c9cf12d06..678ce768600a5829282534af9b88c5049c0ff9d0 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -664,6 +664,10 @@ INSN: ##vm-field-ptr
 def: dst/int-rep
 literal: field-name ;
 
+INSN: ##vm-field
+def: dst/int-rep
+literal: field-name ;
+
 ! FFI
 INSN: ##alien-invoke
 literal: params stack-frame ;

diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor
index d753a4c1b496c75cbf0a329e9147bc685689ba23..4ebc818b83c1c7e97dfbbbfbfbe141f26c0198a5 100644 (file)
--- a/basis/compiler/cfg/intrinsics/intrinsics.factor
+++ b/basis/compiler/cfg/intrinsics/intrinsics.factor
@@ -30,6 +30,7 @@ IN: compiler.cfg.intrinsics
 
 {
     { kernel.private:tag [ drop emit-tag ] }
+    { kernel.private:context-object [ emit-context-object ] }
     { kernel.private:special-object [ emit-special-object ] }
     { kernel.private:(identity-hashcode) [ drop emit-identity-hashcode ] }
     { math.private:both-fixnums? [ drop emit-both-fixnums? ] }

diff --git a/basis/compiler/cfg/intrinsics/misc/misc.factor b/basis/compiler/cfg/intrinsics/misc/misc.factor
index fed5492220847bbd760935147a1995d2c94151f3..9731d2f6f519668c0e7d7f2fb60433b9b9b2f048 100644 (file)
--- a/basis/compiler/cfg/intrinsics/misc/misc.factor
+++ b/basis/compiler/cfg/intrinsics/misc/misc.factor
@@ -3,17 +3,29 @@
 USING: namespaces layouts sequences kernel math accessors
 compiler.tree.propagation.info compiler.cfg.stacks
 compiler.cfg.hats compiler.cfg.instructions
+compiler.cfg.builder.blocks
 compiler.cfg.utilities ;
+FROM: vm => context-field-offset ;
 IN: compiler.cfg.intrinsics.misc
 
 : emit-tag ( -- )
     ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
 
 : emit-special-object ( node -- )
-    "special-objects" ^^vm-field-ptr
-    swap node-input-infos first literal>>
-    [ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot ^^slot ] if*
-    ds-push ;
+    dup node-input-infos first literal>> [
+        "special-objects" ^^vm-field-ptr
+        ds-drop swap 0 ^^slot-imm
+        ds-push
+    ] [ emit-primitive ] ?if ;
+
+: context-object-offset ( -- n )
+    "context-objects" context-field-offset cell /i ;
+
+: emit-context-object ( node -- )
+    dup node-input-infos first literal>> [
+        "ctx" ^^vm-field
+        ds-drop swap context-object-offset + 0 ^^slot-imm ds-push
+    ] [ emit-primitive ] ?if ;
 
 : emit-identity-hashcode ( -- )
     ds-pop tag-mask get bitnot ^^load-immediate ^^and 0 0 ^^slot-imm

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 430bd9550d3de57cef8b6e5f8c52c06abb8ecc9b..d82ced8a1d8a8b2c4dad3457a80121a0b40be3cd 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -211,6 +211,7 @@ CODEGEN: ##compare-float-ordered %compare-float-ordered
 CODEGEN: ##compare-float-unordered %compare-float-unordered
 CODEGEN: ##save-context %save-context
 CODEGEN: ##vm-field-ptr %vm-field-ptr
+CODEGEN: ##vm-field %vm-field
 
 CODEGEN: _fixnum-add %fixnum-add
 CODEGEN: _fixnum-sub %fixnum-sub