compiler.cfg: add ##load-float instruction for single precision floating point constants

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index d4e019d8dd7a45cdef8afb6a115fbb156a34df1f..91d01adb839038b219dc2f5d3513319675a0ef74 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -34,6 +34,10 @@ INSN: ##load-tagged
 def: dst/tagged-rep
 literal: val ;
 
+INSN: ##load-float
+def: dst/float-rep
+literal: val ;
+
 INSN: ##load-double
 def: dst/double-rep
 literal: val ;

diff --git a/basis/compiler/cfg/representations/peephole/peephole.factor b/basis/compiler/cfg/representations/peephole/peephole.factor
index 22366f57144837acc183730590ad725bd06c1704..c3e7fa06a55d63044855ca134a9b7e0fd1611e5b 100644 (file)
--- a/basis/compiler/cfg/representations/peephole/peephole.factor
+++ b/basis/compiler/cfg/representations/peephole/peephole.factor
@@ -42,8 +42,16 @@ M: ##load-integer optimize-insn
         [ call-next-method ]
     } cond ;
 
-! When a float is unboxed, we replace the ##load-reference with a ##load-double
-! if the architecture supports it
+! When a constant float is unboxed, we replace the
+! ##load-reference with a ##load-float or ##load-double if the
+! architecture supports it
+: convert-to-load-float? ( insn -- ? )
+    {
+        [ drop fused-unboxing? ]
+        [ dst>> rep-of float-rep? ]
+        [ obj>> float? ]
+    } 1&& ;
+
 : convert-to-load-double? ( insn -- ? )
     {
         [ drop fused-unboxing? ]
@@ -74,6 +82,10 @@ M: ##load-integer optimize-insn
 
 M: ##load-reference optimize-insn
     {
+        {
+            [ dup convert-to-load-float? ]
+            [ [ dst>> ] [ obj>> ] bi ##load-float here ]
+        }
         {
             [ dup convert-to-load-double? ]
             [ [ dst>> ] [ obj>> ] bi ##load-double here ]

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 604fb2570e5fca937b29ef3b7a85c51e11052845..d5e4987ee09453b82af0ef92838b9fd7e99ae641 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -122,6 +122,7 @@ SYNTAX: CODEGEN:
 CODEGEN: ##load-integer %load-immediate
 CODEGEN: ##load-tagged %load-immediate
 CODEGEN: ##load-reference %load-reference
+CODEGEN: ##load-float %load-float
 CODEGEN: ##load-double %load-double
 CODEGEN: ##load-vector %load-vector
 CODEGEN: ##peek %peek

diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor
index 427c7ff94c15f8ea27f84495359d88d378039d41..4bae4f96dae7a6501580b0edeed7b80b13c2cabb 100644 (file)
--- a/basis/compiler/codegen/fixup/fixup.factor
+++ b/basis/compiler/codegen/fixup/fixup.factor
@@ -12,10 +12,6 @@ IN: compiler.codegen.fixup
     [ length ] [ B{ 0 0 0 0 } swap push-all ] [ underlying>> ] tri
     swap set-alien-unsigned-4 ;
 
-: push-double ( value vector -- )
-    [ length ] [ B{ 0 0 0 0 0 0 0 0 } swap push-all ] [ underlying>> ] tri
-    swap set-alien-double ;
-
 ! Owner
 SYMBOL: compiling-word
 
@@ -136,15 +132,8 @@ MEMO: cached-string>symbol ( symbol -- obj ) string>symbol ;
 : align-code ( n -- )
     alignment (align-code) ;
 
-GENERIC# emit-data 1 ( obj label -- )
-
-M: float emit-data
-    8 align-code
-    resolve-label
-    building get push-double ;
-
-M: byte-array emit-data
-    16 align-code
+: emit-data ( obj label -- )
+    over length align-code
     resolve-label
     building get push-all ;
 

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 8f69b247292a2a2f5a12538676cd450b7d965159..19a9b027859980b83bdceccfe46422e807420b79 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -224,6 +224,7 @@ HOOK: complex-addressing? cpu ( -- ? )
 
 HOOK: %load-immediate cpu ( reg val -- )
 HOOK: %load-reference cpu ( reg obj -- )
+HOOK: %load-float cpu ( reg val -- )
 HOOK: %load-double cpu ( reg val -- )
 HOOK: %load-vector cpu ( reg val rep -- )
 
@@ -504,8 +505,8 @@ M: reg-class param-reg param-regs nth ;
 
 M: stack-params param-reg 2drop ;
 
-! Does this architecture support %load-double, %load-vector and
-! objects in %compare-imm?
+! Does this architecture support %load-float, %load-double,
+! and %load-vector?
 HOOK: fused-unboxing? cpu ( -- ? )
 
 ! Can this value be an immediate operand for %add-imm, %sub-imm,

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index d7c95ff15edcb8b0cf929c6f9df06abafb610938..8618affaedcd8f5a47d9eda109b7c1cb226498f4 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -27,12 +27,15 @@ M: x86.32 temp-reg ECX ;
 
 M: x86.32 immediate-comparand? ( obj -- ? ) drop t ;
 
-M: x86.32 %load-double ( dst val -- )
-    [ 0 [] MOVSD ] dip rc-absolute rel-binary-literal ;
-
 M:: x86.32 %load-vector ( dst val rep -- )
     dst 0 [] rep copy-memory* val rc-absolute rel-binary-literal ;
 
+M: x86.32 %load-float ( dst val -- )
+    <float> float-rep %load-vector ;
+
+M: x86.32 %load-double ( dst val -- )
+    <double> double-rep %load-vector ;
+
 M: x86.32 %mov-vm-ptr ( reg -- )
     0 MOV 0 rc-absolute-cell rel-vm ;
 

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 928daa741e9f9f00bbecb2d7fd8b8e2b1229e05f..5baeed81b85968355727637fd17e432e0a4b90bd 100644 (file)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -46,12 +46,15 @@ M: x86.64 %mov-vm-ptr ( reg -- )
 M: x86.64 %vm-field ( dst offset -- )
     [ vm-reg ] dip [+] MOV ;
 
-M: x86.64 %load-double ( dst val -- )
-    [ 0 [RIP+] MOVSD ] dip rc-relative rel-binary-literal ;
-
 M:: x86.64 %load-vector ( dst val rep -- )
     dst 0 [RIP+] rep copy-memory* val rc-relative rel-binary-literal ;
 
+M: x86.64 %load-float ( dst val -- )
+    <float> float-rep %load-vector ;
+
+M: x86.64 %load-double ( dst val -- )
+    <double> double-rep %load-vector ;
+
 M: x86.64 %set-vm-field ( src offset -- )
     [ vm-reg ] dip [+] swap MOV ;