Actually generate real code.

diff --git a/codegen/blarg.sml b/codegen/blarg.sml
index aacc99311239caa519d35478723752b34aee2f0e..cf3ea4c59044e77bf940ff1309336acffce1e573 100644 (file)
--- a/codegen/blarg.sml
+++ b/codegen/blarg.sml
@@ -8,7 +8,7 @@ signature BLARG =
 sig
   (* register type *)
   datatype reg =
-    R0 | R1 | R2 | R3 | FR | SP | PC
+    R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | FR | SP | PC
   (* operands to instructions *)
   datatype oper = REG of reg |
                      TEMP of Temp.temp |
@@ -65,7 +65,7 @@ struct
 
 (* register type *)
   datatype reg =
-    R0 | R1 | R2 | R3 | FR | SP | PC
+    R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 | FR | SP | PC
   (* operands to instructions *)
   datatype oper = REG of reg |
                   TEMP of Temp.temp |
@@ -109,6 +109,15 @@ struct
       (R1, "r1"),
       (R2, "r2"),
       (R3, "r3"),
+      (R4, "r4"),
+      (R5, "r5"),
+      (R6, "r6"),
+      (R7, "r7"),
+      (R8, "r8"),
+      (R9, "r9"),
+      (R10, "r10"),
+      (R11, "r11"),
+      (R12, "r12"),
       (FR, "fr"),
       (SP, "sp"),
       (PC, "pc") ];
@@ -134,6 +143,15 @@ struct
     | regtonum R1 = 1
     | regtonum R2 = 2
     | regtonum R3 = 3
+    | regtonum R4 = 4
+    | regtonum R5 = 5
+    | regtonum R6 = 6
+    | regtonum R7 = 7
+    | regtonum R8 = 8
+    | regtonum R9 = 9
+    | regtonum R10 = 10
+    | regtonum R11 = 11
+    | regtonum R12 = 12
     | regtonum SP = 4
     | regtonum _ = raise ErrorMsg.InternalError ("regtonum: Invalid register")
 
@@ -142,6 +160,15 @@ struct
     | numtoreg 1 = R1
     | numtoreg 2 = R2
     | numtoreg 3 = R3
+    | numtoreg 4 = R4
+    | numtoreg 5 = R5
+    | numtoreg 6 = R6
+    | numtoreg 7 = R7
+    | numtoreg 8 = R8
+    | numtoreg 9 = R9
+    | numtoreg 10 = R10
+    | numtoreg 11 = R11
+    | numtoreg 12 = R12
     | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Invalid register "^(Int.toString n))
 
   (* register compare *)

diff --git a/codegen/liveness.sml b/codegen/liveness.sml
index 72df2485016bc58ac9dc8693b6320180aa154a40..97037cb28db16d3a39bfa4924f7bad2c40ed8fa5 100644 (file)
--- a/codegen/liveness.sml
+++ b/codegen/liveness.sml
@@ -127,8 +127,12 @@ struct
         | gendef (n, X.INSN(_, X.POP(X.REG X.SP, X.REG X.PC))) = ([USE (X.REG X.R0), SUCC(n+1)])
         | gendef (n, X.INSN(_, X.POP(X.REG X.SP, src))) = (defhit src @ [SUCC (n+1)])
         | gendef (n, X.INSN(_, X.POP(_, _))) = raise ErrorMsg.InternalError "POP with sp != SP"
-        | gendef (n, X.INSN(_, X.CALL(X.REG X.SP, src, a))) = (callhit a @ usehit src @ [DEF(X.REG(X.R0)), DEF(X.REG(X.R1)), DEF(X.REG(X.R2)),
-                                                               DEF(X.REG(X.R3)), SUCC(n+1)])
+        | gendef (n, X.INSN(_, X.CALL(X.REG X.SP, src, a))) = (callhit a @
+                                                               usehit src @
+                                                               [DEF(X.REG(X.R0)), DEF(X.REG(X.R1)), DEF(X.REG(X.R2)), DEF(X.REG(X.R3)),
+                                                                DEF(X.REG(X.R4)), DEF(X.REG(X.R5)),
+                                                                SUCC(n+1)]
+                                                              )
         | gendef (n, X.INSN(_, X.CALL(_, _, _))) = raise ErrorMsg.InternalError "CALL with sp != SP"
         | gendef (n, X.INSN(_, X.SHR(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)])
         | gendef (n, X.INSN(_, X.SHL(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)])

diff --git a/codegen/solidify.sml b/codegen/solidify.sml
index 07ae420b950703bc33226a307bcc46a6f09ff9f4..a2622e122b54e21c47638ab8e780f80b7d9b4b0f 100644 (file)
--- a/codegen/solidify.sml
+++ b/codegen/solidify.sml
@@ -8,18 +8,18 @@
 signature SOLIDIFY =
 sig
   type colorings = (Temp.temp * int) list
-  type asm = x86.insn list
+  type asm = Blarg.insn list
   
   val solidify : colorings -> asm -> asm
 end
 
 structure Solidify :> SOLIDIFY =
 struct
-  structure X = x86
+  structure X = Blarg
   structure T = Temp
   
   type colorings = (Temp.temp * int) list
-  type asm = x86.insn list
+  type asm = Blarg.insn list
   
   exception Spilled
 
@@ -31,8 +31,8 @@ struct
 
   fun solidify (regmap : colorings) (instrs : asm) : asm =
     let
-      (* r14d and r15d is reserved for spilling *)
-      val maxreg = X.regtonum X.R13D
+      (* r11 and r12 is reserved for spilling *)
+      val maxreg = X.regtonum X.R10
       fun numtoreg n =
           if (n > maxreg)
           then raise Spilled
@@ -41,244 +41,192 @@ struct
       val tempnums = List.foldr (fn ((t,n),b) => TempMap.insert(b,t,n)) (TempMap.empty) regmap
       fun temptonum (t: T.temp) : int = valOf (TempMap.find (tempnums, t))
 
-      fun temptoreg (t: T.temp) : x86.reg =
+      fun temptoreg (t: T.temp) : Blarg.reg =
         numtoreg (temptonum t)          
-        handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
+        handle Option => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
 
-      val spillreg1 = X.R15D
-      val spillreg2 = X.R14D
+      val spillreg1 = X.R12
+      val spillreg2 = X.R11
 
       (* Determine which need to be saved. *)
-      val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap) @ [X.REG X.R14D]
+      val opsused = (map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R12)) regmap) @ [X.REG X.R11]
       val saveregs = X.OperSet.intersection (
         X.OperSet.addList (X.OperSet.empty, opsused),
         X.OperSet.addList (
           X.OperSet.empty,
-          [X.REG X.EBX,
-           X.REG X.EBP,
-           X.REG X.R12D,
-           X.REG X.R13D,
-           X.REG X.R14D,
-           X.REG X.R15D]))
+          [X.REG X.R7,
+           X.REG X.R8,
+           X.REG X.R9,
+           X.REG X.R10,
+           X.REG X.R11,
+           X.REG X.R12]))
       val savelist = X.OperSet.listItems saveregs
       val nsave = length savelist
 
       val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap)    (* Number of registers used. *)
       val nspilled = Int.max (numreg - maxreg, 0)    (* Number of spilled registers. *)
-      fun isspilled (X.TEMP temp, _) = (temptonum temp) > maxreg    (* Whether a register is spilled *)
-        | isspilled (X.STACKARG _, _) = true
-        | isspilled (X.REL _, _) = true
+      fun isspilled (X.TEMP temp) = (temptonum temp) > maxreg    (* Whether a register is spilled *)
+        | isspilled (X.STACKARG _) = true
         | isspilled _ = false
 
-      val stacksz = (nspilled + nsave) * 8
-      fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8    (* Stack position of some register number *)
+      val stacksz = (nspilled + nsave) * 1
+      fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 1    (* Stack position of some register number *)
 
       val prologue =
-        (X.SUB ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))) ::
-        (ListPair.map
-          (fn (num, reg) =>
-            X.MOV ((X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (stacksz - 8*(num+1))), Tm.Quad), 0w1), Tm.Quad), (reg, Tm.Quad)))
-          (List.tabulate (nsave, fn x => x), savelist))
+        [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
+         X.INSN (X.AL, X.SUB (X.REG X.SP, X.REG X.R4))] @
+        (List.concat
+          (ListPair.map
+            (fn (num, reg) =>
+              [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
+               X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
+               X.INSN (X.AL, X.STO (X.REG X.R4, reg))])
+            (List.tabulate (nsave, fn x => x), savelist)
+          )
+        )
       val epilogue =
-        (ListPair.map
-          (fn (num, reg) =>
-            X.MOV ((reg, Tm.Quad), (X.REL ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt (stacksz - 8*(num+1))), Tm.Quad), 0w1), Tm.Quad)))
-          (List.tabulate (nsave, fn x => x), savelist)) @
-        [X.ADD ((X.REG X.RSP, Tm.Quad), (X.CONST (Word32.fromInt stacksz), Tm.Quad))]
+        (List.concat
+          (ListPair.map
+            (fn (num, reg) =>
+              [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt (stacksz - 1*(num+1)))),
+               X.INSN (X.AL, X.ADD (X.REG X.R4, X.REG X.SP)),
+               X.INSN (X.AL, X.LDR (reg, X.REG X.R4))])
+            (List.tabulate (nsave, fn x => x), savelist)
+          )
+        ) @
+        [X.INSN (X.AL, X.MOVLIT (X.REG X.R4, Word.fromInt stacksz)),
+         X.INSN (X.AL, X.ADD (X.REG X.SP, X.REG X.R4))]
       val endlbl = Label.new()
 
-      fun spill ((X.TEMP temp, s), xreg: x86.reg) =    (* Spill a register if need be. *)
+      fun spill (X.TEMP temp, xreg: Blarg.reg) =    (* Spill a register if need be. *)
             let
-              val base = (X.REG X.RSP, Tm.Quad)
-              val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
+              val base = X.REG X.SP
+              val offs = Word.fromInt (stackpos (temptonum temp))
             in
-              if (isspilled (X.TEMP temp, s))
-                then [X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]
+              if (isspilled (X.TEMP temp))
+                then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REL (base, offs, 0w1), Tm.Quad), (X.REG xreg, Tm.Quad))]*)
                 else nil
             end
-        | spill ((X.STACKARG _, s), _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
-        | spill ((a as X.REL _, s), xreg) = [X.MOV ((a,s), (X.REG xreg,s))]
+        | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
         | spill _ = nil        (* Nothing else can be spilled. *)
-      fun unspill ((X.TEMP temp, s), xreg: x86.reg) =    (* Unspill a register if need be. *)
+      fun unspill (X.TEMP temp, xreg: Blarg.reg) =    (* Unspill a register if need be. *)
             let
-              val base = (X.REG X.RSP, Tm.Quad)
-              val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
+              val base = X.REG X.SP
+              val offs = Word.fromInt (stackpos (temptonum temp))
             in
-              if (isspilled (X.TEMP temp, s))
-                then [X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]
+              if (isspilled (X.TEMP temp))
+                then raise ErrorMsg.InternalError "unspill not supported" (*[X.MOV ((X.REG xreg, Tm.Quad), (X.REL (base, offs, 0w1), Tm.Quad))]*)
                 else nil
             end
-        | unspill ((X.STACKARG arg, s), xreg) =
+        | unspill (X.STACKARG arg, xreg) =
             let
-              val base = (X.REG X.RSP, Tm.Quad)
-              val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
+              val base = X.REG X.SP
+              val offs = Word.fromInt (stacksz + 8 + (arg * 8))
             in
-              [X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]
+              (*[X.MOV ((X.REG xreg, s), (X.REL (base, offs, 0w1), s))]*)
+              raise ErrorMsg.InternalError "unspill from stack not supported"
             end
-        | unspill ((a as X.REL _, s), xreg) = [X.MOV ((X.REG xreg, s), (a,s))]
         | unspill _ = nil
 
-      fun realoper (X.TEMP temp, s) = (X.REG (temptoreg temp), s) (* makes an operand 'real' *)
-        | realoper (X.STACKARG arg, _) = raise Spilled
-        | realoper (X.REL _, _) = raise Spilled
-        | realoper r = r
-
-      fun stackoper (X.TEMP temp, s) =
-            let
-              val base = (X.REG X.RSP, Tm.Quad)
-              val offs = (X.CONST (Word32.fromInt (stackpos (temptonum temp))), Tm.Quad)
-            in
-              if (isspilled (X.TEMP temp, s)) 
-                then (X.REL (base, offs, 0w1), s)
-                else raise ErrorMsg.InternalError "stackoper on unspilled temp?"
-            end
-        | stackoper (X.STACKARG arg, s) =
-            let
-              val base = (X.REG X.RSP, Tm.Quad)
-              val offs = (X.CONST (Word32.fromInt (stacksz + 8 + (arg * 8))), Tm.Quad)
-            in
-              (X.REL (base, offs, 0w1), s)
-            end
-        | stackoper (a as (X.REL _, s)) = a
-        | stackoper (a as (X.CONST _, s)) = a
-        | stackoper anous = raise ErrorMsg.InternalError ("stackoper on not temp " ^ X.pp_oper anous)
-
-      fun ophit (X.REL(op1, op2, m), s) =
-            if (isspilled op1 andalso isspilled op2) then
-              ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2),
-                X.IMUL((X.REG spillreg1, Tm.Quad), (X.CONST m, Tm.Quad)), 
-                X.ADD ((X.REG spillreg1, Tm.Quad), stackoper op1)],
-                (X.REL ((X.REG spillreg1, Tm.Quad), (X.CONST 0w0, Tm.Quad), 0w1), s))
-            else if(isspilled op1) then
-              ([X.MOV ((X.REG spillreg1, Tm.Quad), stackoper op1)],
-                (X.REL ((X.REG spillreg1, Tm.Quad), realoper op2, m), s))
-            else if(isspilled op2) then
-              ([X.MOV ((X.REG spillreg1, Tm.Long), stackoper op2)],
-                (X.REL (realoper op1, (X.REG spillreg1, Tm.Quad), m), s))
-            else
-              ([],
-                (X.REL (realoper op1, realoper op2, m), s))
-        | ophit a = (nil, realoper a handle Spilled => stackoper a)
+      fun unspill_ops (op1, op2) =
+        case (isspilled op1, isspilled op2)
+        of (false, false) => []
+         | (true, false) => unspill (op1, spillreg1)
+         | (false, true) => unspill (op2, spillreg2)
+         | (true, true)  => unspill (op1, spillreg1) @ unspill (op2, spillreg2)
+      
+      fun respill_ops (op1, op2) =
+        case (isspilled op1, isspilled op2) (* no instruction writes back to op2 *)
+        of (false, _) => []
+         | (true, _) => spill (op1, spillreg1)
+      
+      fun real_op1 op1 =
+        case op1
+        of (X.TEMP temp) => if isspilled op1
+                            then (X.REG spillreg1)
+                            else X.REG (temptoreg temp)
+         | (X.STACKARG arg) => X.REG spillreg1
+         | r => r
+      
+      fun real_ops (op1, op2) =
+        (case op1
+         of (X.TEMP temp) => if isspilled op1
+                             then (X.REG spillreg1)
+                             else X.REG (temptoreg temp)
+          | (X.STACKARG arg) => X.REG spillreg1
+          | r => r,
+        case op2
+         of (X.TEMP temp) => if isspilled op2
+                             then (X.REG spillreg2)
+                             else X.REG (temptoreg temp)
+          | (X.STACKARG arg) => X.REG spillreg2
+          | r => r)
+
+      fun whack_insn (pred, insn, op1, op2) =
+        (map (fn i => X.INSN (pred, i)) (unspill_ops (op1, op2))) @
+        [ X.INSN (pred, insn (real_ops (op1, op2))) ] @
+        (map (fn i => X.INSN (pred, i)) (respill_ops (op1, op2)))
 
       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
         | transform (X.COMMENT s) = [X.COMMENT s]
+        | transform (X.LABEL l) = [X.LABEL l]
         | transform (X.LIVEIGN a) = transform a
-        | transform (X.MOV (dest, src)) =
-            let
-              val (insns1, realop1 as (_,s1)) = ophit dest
-              val (insns2, realop2 as (_,s2)) = ophit src
-            in
-              if(isspilled dest andalso isspilled src) then
-                insns2 @ [X.MOV ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
-              else
-                insns1 @ insns2 @ [X.MOV (realop1, realop2)]
-            end
-        | transform (X.LEA (dest, src)) =
-            let
-              val (insns1, realop1 as (_,s1)) = ophit dest
-              val (insns2, realop2 as (_,s2)) = ophit src
-            in
-              if(isspilled dest andalso isspilled src) then
-                insns2 @ [X.LEA ((X.REG spillreg2, s2), realop2)] @ insns1 @ [X.MOV (realop1, (X.REG spillreg2, s1))]
-              else
-                insns1 @ insns2 @ [X.LEA (realop1, realop2)]
-            end
-        | transform (X.SUB (dest, src)) =
-            let
-              val (insns, realop) = ophit dest
-            in
-              unspill (src, spillreg2) @ insns @
-              [ X.SUB(realop,
-                  realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
-            end
-        | transform (X.IMUL (dest, src)) =
-            unspill (dest, spillreg1) @
-            [ X.IMUL(
-                realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
-                realoper src handle Spilled => stackoper src)] @
-            spill (dest, spillreg1)
-        | transform (X.IMUL3 (dest, src, const)) =
-            unspill (src, spillreg2) @
-            [ X.IMUL3(
-                realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
-                realoper src handle Spilled => (X.REG spillreg2, X.osize src),
-                const)] @
-            spill (dest, spillreg1)
-        | transform (X.ADD (dest, src)) =
-            let
-              val (insns, realop) = ophit dest
-            in
-              unspill (src, spillreg2) @ insns @
-              [ X.ADD(realop,
-                  realoper src handle Spilled => (X.REG spillreg2, X.osize realop))]
-            end
-        | transform (X.IDIV (src)) = [ X.IDIV(realoper src handle Spilled => stackoper src)]
-        | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
-        | transform (X.NOT (src)) = [ X.NOT(realoper src handle Spilled => stackoper src)]
-        | transform (X.SAL (dest, shft)) =
-            [ X.SAL (
-                realoper dest handle Spilled => stackoper dest,
-                shft)]
-        | transform (X.SAR (dest, shft)) =
-            [ X.SAR (
-                realoper dest handle Spilled => stackoper dest,
-                shft)]
-        | transform (X.CLTD) = [ X.CLTD ]
-        | transform (X.AND (dest, src)) =
-            unspill (src, spillreg1) @
-            [ X.AND(
-                realoper dest handle Spilled => stackoper dest,
-                realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
-        | transform (X.OR (dest, src)) =
-            unspill (src, spillreg1) @
-            [ X.OR(
-                realoper dest handle Spilled => stackoper dest,
-                realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
-        | transform (X.XOR (dest, src)) =
-            unspill (src, spillreg1) @
-            [ X.XOR(
-                realoper dest handle Spilled => stackoper dest,
-                realoper src handle Spilled => (X.REG spillreg1, X.osize src))]
-        | transform (X.CMP (op1, op2)) =
-            let
-              val (insns1, realop1) = ophit op1
-            in
-              if(isspilled realop1 andalso isspilled op2) then
-                unspill (op2, spillreg2) @ insns1 @ [X.CMP (realop1, (X.REG spillreg2, X.osize realop1))]
-              else
-                insns1 @ [X.CMP (realop1, realoper op2 handle Spilled => stackoper op2)]
-            end
-        | transform (X.TEST (op1, op2)) =
-            unspill (op2, spillreg1) @
-            [ X.TEST(
-                realoper op1 handle Spilled => stackoper op1,
-                realoper op2 handle Spilled => (X.REG spillreg1, X.osize op2))]
-        | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]
-        | transform (X.CMOVcc (c, dest, src)) =
-            let
-              val (insns1, realop1) = ophit dest
-              val (insns2, realop2) = ophit src
-            in
-              if(isspilled dest andalso isspilled src) then
-                insns2 @ [X.MOV ((X.REG spillreg2, X.osize src), realop2)] @ insns1 @ [X.CMOVcc (c, realop1, (X.REG spillreg2, X.osize src))]
-              else
-                insns1 @ insns2 @ [X.CMOVcc (c, realop1, realop2)]
-            end
-        | transform (X.CALL l) = [ X.CALL l ]
-        | transform (X.MOVZB (dest, src)) =
-            [ X.MOVZB(
-                realoper dest handle Spilled => (X.REG spillreg1, X.osize dest),
-                realoper src handle Spilled => stackoper src)]
-            @ spill (dest, spillreg1)
-        | transform (X.RET) = if nsave < 2 then (epilogue @ [X.RET]) else [X.JMP endlbl]
-        | transform (X.LABEL l) = [ X.LABEL l ]
-        | transform (X.JMP l) = [ X.JMP l ]
-        | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]
-        | transform _ = raise ErrorMsg.InternalError "probably movsc: unimplemented"
+        
+        (* god the special cases are going to suck *)
+        | transform (X.INSN (pred, X.MOVLIT (op1, w))) =
+            [ X.INSN (pred, X.MOVLIT (real_op1 op1, w)) ] @
+            (if isspilled op1
+             then spill (op1, spillreg1)
+             else [])
+        | transform (X.INSN (pred, X.MOVSYM (op1, w))) =
+            [ X.INSN (pred, X.MOVSYM (real_op1 op1, w)) ] @
+            (if isspilled op1
+             then spill (op1, spillreg1)
+             else [])
+        | transform (X.INSN (pred, X.MOVLBL (op1, w))) =
+            [ X.INSN (pred, X.MOVLBL (real_op1 op1, w)) ] @
+            (if isspilled op1
+             then spill (op1, spillreg1)
+             else [])
+        
+        (* and here comes the boilerplate *)
+        | transform (X.INSN (pred, X.LDR (op1, op2))) =  whack_insn (pred, X.LDR, op1, op2)
+        | transform (X.INSN (pred, X.STO (op1, op2))) =  whack_insn (pred, X.STO, op1, op2)
+        | transform (X.INSN (pred, X.MOV (op1, op2))) =  whack_insn (pred, X.MOV, op1, op2)
+        | transform (X.INSN (pred, X.MOVS (op1, op2))) = whack_insn (pred, X.MOVS, op1, op2)
+        | transform (X.INSN (pred, X.ADD (op1, op2))) =  whack_insn (pred, X.ADD, op1, op2)
+        | transform (X.INSN (pred, X.ADDS (op1, op2))) = whack_insn (pred, X.ADDS, op1, op2)
+        | transform (X.INSN (pred, X.SUB (op1, op2))) =  whack_insn (pred, X.SUB, op1, op2)
+        | transform (X.INSN (pred, X.SUBS (op1, op2))) = whack_insn (pred, X.SUBS, op1, op2)
+        | transform (X.INSN (pred, X.AND (op1, op2))) =  whack_insn (pred, X.AND, op1, op2)
+        | transform (X.INSN (pred, X.ANDS (op1, op2))) = whack_insn (pred, X.ANDS, op1, op2)
+        | transform (X.INSN (pred, X.NOT (op1, op2))) =  whack_insn (pred, X.NOT, op1, op2)
+        | transform (X.INSN (pred, X.NOTS (op1, op2))) = whack_insn (pred, X.NOTS, op1, op2)
+        | transform (X.INSN (pred, X.PUSH (op1, op2))) = if isspilled op2
+                                                         then raise ErrorMsg.InternalError "PUSH on spilled op2 is not possible"
+                                                         else [ X.INSN (pred, X.PUSH (real_ops (op1, op2))) ]
+        | transform (X.INSN (pred, X.POP (X.REG X.SP, X.REG X.PC))) = [ X.INSN (pred, X.MOVLBL (X.REG X.PC, endlbl)) ] (* optimize epilogue? *)
+        | transform (X.INSN (pred, X.POP (op1, op2))) =  if isspilled op2
+                                                         then raise ErrorMsg.InternalError "POP on spilled op2 is not possible"
+                                                         else [ X.INSN (pred, X.POP (real_ops (op1, op2))) ]
+        | transform (X.INSN (pred, X.CALL (op1, op2, i))) =  if isspilled op2
+                                                             then raise ErrorMsg.InternalError "CALL on spilled op2 is not possible"
+                                                             else [ X.INSN (pred, X.CALL ((fn (x, y) => (x, y, i)) (real_ops (op1, op2)))) ]
+        | transform (X.INSN (pred, X.SHR (op1, op2))) =  whack_insn (pred, X.SHR, op1, op2)
+        | transform (X.INSN (pred, X.SHL (op1, op2))) =  whack_insn (pred, X.SHL, op1, op2)
+        (*| transform _ = raise ErrorMsg.InternalError "unimplemented"*)
     in
-      if (nsave < 2) then
+      (*if (nsave < 2) then
         List.concat (prologue :: (map transform instrs))
       else
-        List.concat (prologue :: ((map transform instrs) @ [[X.LABEL endlbl], epilogue, [X.RET]]))
+      *)
+      List.concat (prologue ::
+                   ((map transform instrs) @
+                    [[X.LABEL endlbl],
+                     epilogue,
+                     [X.INSN (X.AL, X.POP (X.REG X.SP, X.REG X.PC))]
+                    ]
+                   )
+                  )
     end
 end

diff --git a/sources.cm b/sources.cm
index e10115a3b1c153f7c51a8cccb70eb84ca08451a6..edf6e4929acc06a0ddac0db6b5a3e2e659b4ddec 100644 (file)
--- a/sources.cm
+++ b/sources.cm
@@ -35,7 +35,7 @@ Group is
        codegen/liveness.sml
        codegen/igraph.sml
        codegen/colororder.sml
-(*     codegen/solidify.sml*)
+       codegen/solidify.sml
        codegen/coloring.sml
        codegen/stringifier.sml
 

diff --git a/top/top.sml b/top/top.sml
index 6a132c68931fb415686e29b2689e81d7a0cf0ab2..49e7dc6c3516072e7d7d87bf88b842f3880425a5 100644 (file)
--- a/top/top.sml
+++ b/top/top.sml
@@ -149,19 +149,19 @@ struct
                         ^ "--"^ Int.toString i ^ "\n"))
                     colors) ()
 
-(*        val _ = Flag.guard Flags.verbose say "  Solidifying blargCPU code..."
+        val _ = Flag.guard Flags.verbose say "  Solidifying blargCPU code..."
         val x86 = Solidify.solidify colors assem
 
         val _ = Flag.guard Flags.verbose say "  Optimizing final assembly..."
         val x86p = Optimizer.optimize_final (!enabledopts) x86
 
         val _ = Flag.guard Flags.verbose say "  Stringifying..."
-        val x86d = [x86.DIRECTIVE(".globl " ^ name),
-                    x86.DIRECTIVE(name ^ ":")]
+        val x86d = [Blarg.DIRECTIVE(".globl " ^ name),
+                    Blarg.DIRECTIVE(name ^ ":")]
                     @ x86p
-        val code = Stringify.stringify realname x86d*)
+        val code = Stringify.stringify realname x86d
       in
-        ""
+        code
       end
 
   fun main (name, args) =