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

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 ;

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 ]

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

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 ;
 

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,

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 ;
 

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 ;