Constant propagation

4 files changed, 770 insertions, 119 deletions

diff --git a/common.sml b/common.sml
index 72efe93..f8adede 100644
--- a/common.sml
+++ b/common.sml
@@ -26,6 +26,7 @@ structure FRU = struct
   fun f7 z = next f6 z
   fun f8 z = next f7 z
   fun f9 z = next f8 z
+  fun f10 z = next f9 z
 
   fun c0 from = from
   fun c1 from = c0 from f1
@@ -37,6 +38,7 @@ structure FRU = struct
   fun c7 from = c6 from f7
   fun c8 from = c7 from f8
   fun c9 from = c8 from f9
+  fun c10 from = c9 from f10
 
   fun makeUpdate cX (from, from', to) record =
     let
@@ -55,6 +57,7 @@ structure FRU = struct
   fun makeUpdate7 z = makeUpdate c7 z
   fun makeUpdate8 z = makeUpdate c8 z
   fun makeUpdate9 z = makeUpdate c9 z
+  fun makeUpdate10 z = makeUpdate c10 z
 
   fun upd z = Fold.step2
     (fn (s, f, (vars, ops)) =>
@@ -147,6 +150,8 @@ fun bindWith2str to = bind A1 (fn v => fn (output, _) => output $ to v)
 fun F z = bind A0 (fn (_, mf) => mf ()) z
 
 val I = fn z => bindWith2str Int.toString z
+fun i v out = Printf out I v %
+
 val C = fn z => bindWith2str str z
 val B = fn z => bindWith2str Bool.toString z
 val W = fn z => bindWith2str (Word.fmt StringCvt.DEC) z
diff --git a/il.fun b/il.fun
index 5b38660..4c12d51 100644
--- a/il.fun
+++ b/il.fun
@@ -18,11 +18,12 @@ functor IL(P: PARSER) = struct
   type vreg = int
   type label = int
 
-  datatype setArg = SaVReg of vreg | SaConst of word | SaGL of P.nid
+  datatype setArg = SaVReg of vreg | SaConst of word |
+    SaAddr of P.nid * word
 
   datatype accessClass = AC1 | AC2 | AC4 | AC8
 
-  datatype irIsn =
+  datatype irIns =
       IrSet of vreg * setArg
     | IrAdd of vreg * vreg * vreg
     | IrSub of vreg * vreg * vreg
@@ -63,17 +64,34 @@ functor IL(P: PARSER) = struct
     | IrRet of vreg option
     | IrAlloc of vreg * word
     | IrCopy of vreg * label * word
+    | IrFcall of vreg * vreg * vreg list
 
     | IrNopLabel of label
+    | IrNop of string
 
   datatype ev = Reg of vreg | Addr of vreg
 
+  datatype regType =
+    RtUnk |
+    RtConst of word |
+    RtAddrConst of int * word
+
+  type regInfo = {
+    class: vregClass,
+    use: int list,
+    defs: int list,
+    t: regType
+  }
+
   datatype localCtx = Lctx of {
     localVars: { onStack: bool, t: P.ctype } vector,
-    vregs: { class: vregClass } D.t,
+    vregs: regInfo D.t,
     newLabelNum: int,
-    ops: irIsn list,
-    loopLabels: { break: label, continue: label } list
+    ops: irIns list,
+    opTable: (irIns option) array option,
+    curPos: int, (* length ops + 1 *)
+    loopLabels: { break: label, continue: label } list,
+    paramNum: int
   }
 
   (*
@@ -90,14 +108,19 @@ functor IL(P: PARSER) = struct
 
   fun updateLctx (Lctx ctx) = fn z =>
   let
-    fun from localVars vregs ops newLabelNum loopLabels =
-      { localVars, vregs, ops, newLabelNum, loopLabels }
-    fun to f { localVars, vregs, ops, newLabelNum, loopLabels } =
-      f localVars vregs ops newLabelNum loopLabels
+    fun from localVars vregs ops opTable curPos newLabelNum loopLabels
+      paramNum =
+      { localVars, vregs, ops, opTable, curPos, newLabelNum, loopLabels,
+      paramNum }
+    fun to f { localVars, vregs, ops, opTable, curPos, newLabelNum,
+      loopLabels, paramNum } =
+      f localVars vregs ops opTable curPos newLabelNum loopLabels paramNum
   in
-    FRU.makeUpdate5 (from, from, to) ctx (fn (a, f) => z (a, Lctx o f))
+    FRU.makeUpdate8 (from, from, to) ctx (fn (a, f) => z (a, Lctx o f))
   end
 
+  fun isLocal (Lctx { localVars, ... }) id = id < Vector.length localVars
+
   fun typeAccessClass t =
     case P.sizeOfType t of
       0w1 => AC1
@@ -106,6 +129,12 @@ functor IL(P: PARSER) = struct
     | 0w8 => AC8
     | _ => raise Unreachable
 
+  fun ac2word AC1 = 0w1
+    | ac2word AC2 = 0w2
+    | ac2word AC4 = 0w4
+    | ac2word AC8 = 0w8
+
+  fun getRegType vregs r = #t $ D.get vregs r
 
   fun setupLocalVars localVars =
   let
@@ -116,7 +145,7 @@ functor IL(P: PARSER) = struct
         Vector.fromList (rev acc)
       else
         let
-          val { onStack: bool, t, ... } = Vector.sub (localVars, idx)
+          val { onStack: bool, t: P.ctype, ... } = Vector.sub (localVars, idx)
         in
           setup (idx + 1) ({ onStack, t } :: acc)
         end
@@ -130,33 +159,144 @@ functor IL(P: PARSER) = struct
     | EQUAL => VR8
     | LESS => VR4
 
-  fun setupVregs localVars =
+  fun getClassSize VR4 = 0w4
+    | getClassSize VR8 = 0w8
+
+  fun setupVregs localVars paramNum =
   let
-    val len = Vector.length localVars
+    val lvlen = Vector.length localVars
+    val len = lvlen + paramNum
     val vregs = D.create len
 
+    val () = printfn `"local + copies: " I len %
+
     fun loop idx =
       if idx = len then
         ()
       else
-        let
-          val { t, onStack, ... } = Vector.sub (localVars, idx)
-          val class = if onStack then VR8 else getClassForType t
-        in
-          D.push vregs ({ class });
-          loop (idx + 1)
-        end
+        if idx < lvlen then
+          let
+            val { t, onStack, ... } = Vector.sub (localVars, idx)
+            val class = if onStack then VR8 else getClassForType t
+            val defs = if idx < paramNum then [0] else []
+          in
+            D.push vregs ({ class, defs, use = [], t = RtUnk });
+            loop (idx + 1)
+          end
+        else
+          let
+            val { class, ... } = D.get vregs (idx - lvlen)
+          in
+            D.push vregs ({ class, defs = [], use = [], t = RtUnk });
+            loop (idx + 1)
+          end
     val () = loop 0
   in
     vregs
   end
 
-  fun createLocalCtx localVars =
+  fun getInsInfo op' =
+  let
+    fun tr (rd, rs1, rs2) = { defs = [rd], use = [rs1, rs2] }
+    fun de (rd, rs1) = { defs = [rd], use = [rs1] }
+    fun set reg arg =
+      { defs = [reg], use = case arg of SaVReg rs => [rs] | _ => [] }
+  in
+    case op' of
+      IrAdd t => tr t
+    | IrSub t => tr t
+    | IrMul t => tr t
+    | IrIMul t => tr t
+    | IrDiv t => tr t
+    | IrIDiv t => tr t
+    | IrMod t => tr t
+    | IrIMod t => tr t
+    | IrShl t => tr t
+    | IrShr t => tr t
+    | IrSar t => tr t
+    | IrAnd t => tr t
+    | IrOr t => tr t
+    | IrXor t => tr t
+    | IrEq t => tr t
+    | IrNeq t => tr t
+    | IrCmpul t => tr t
+    | IrCmpug t => tr t
+    | IrCmpule t => tr t
+    | IrCmpuge t => tr t
+    | IrCmpsl t => tr t
+    | IrCmpsg t => tr t
+    | IrCmpsle t => tr t
+    | IrCmpsge t => tr t
+
+    | IrExtZero (rd, rs, _) => de (rd, rs)
+    | IrExtSign (rd, rs, _) => de (rd ,rs)
+
+    | IrSet (reg, arg) => set reg arg
+
+    | IrLoad (r1, r2, _) => de (r1, r2)
+    | IrStore (r1, r2, _) => { defs = [], use = [r1, r2] }
+    | IrJmp _ => { defs = [], use = [] }
+    | IrJz (r, _) => { defs = [], use = [r] }
+    | IrJnz (r, _) => { defs = [], use = [r] }
+    | IrNopLabel _  | IrNop _  => { defs = [], use = [] }
+    | IrRet v => { defs = [], use = case v of SOME r => [r] | _ => [] }
+    | IrAlloc (r, _) => { defs = [r], use = [] }
+    | IrCopy (r, _, _) => { defs = [], use = [r] }
+    | IrFcall (rd, f, args) =>
+        { defs = if rd = ~1 then [] else [rd], use = f :: args }
+  end
+
+  fun updateDefsUse (Lctx { vregs, ... }) defs use pos =
+  let
+    fun updateDef vr =
+    let
+      val { class, defs, use, t } = D.get vregs vr
+    in
+      D.set vregs vr { class, defs = pos :: defs, use, t }
+    end
+    fun updateUse vr =
+    let
+      val { class, defs, use, t } = D.get vregs vr
+    in
+      D.set vregs vr { class, defs, use = pos :: use, t }
+    end
+
+  in
+    List.app updateDef defs;
+    List.app updateUse use
+  end
+
+  fun ctxPutOp (C as Lctx { curPos, ... }) op' =
+  let
+    val { defs, use } = getInsInfo op'
+    val insPos = curPos + 1
+    val () = updateDefsUse C defs use insPos
+  in
+    updateLctx C u#ops (fn l => op' ::  l) u#curPos (fn pos => pos + 1) %
+  end
+
+  fun copyArgs (C as Lctx { localVars, paramNum, ... }) =
+  let
+    val lvlen = Vector.length localVars
+
+    fun loop ctx idx =
+      if idx = paramNum then
+        ctx
+      else
+        loop (ctxPutOp ctx (IrSet (idx + lvlen, SaVReg idx))) (idx + 1)
+    val ctx = loop C 0
+  in
+    ctx
+  end
+
+  fun createLocalCtx localVars paramNum =
   let
     val localVars = setupLocalVars localVars
-    val vregs = setupVregs localVars
+    val vregs = setupVregs localVars paramNum
+    val ctx = Lctx { localVars, vregs, ops = [], opTable = NONE, curPos = 0,
+        newLabelNum = 0, loopLabels = [], paramNum }
   in
-    Lctx { localVars, vregs, ops = [], newLabelNum = 0, loopLabels = [] }
+    copyArgs ctx
   end
 
     (*
@@ -172,7 +312,7 @@ functor IL(P: PARSER) = struct
 
   fun getNewVReg class (Lctx { vregs, ... }) =
   let
-    val id = D.pushAndGetId vregs ({ class })
+    val id = D.pushAndGetId vregs ({ class, defs = [], use = [], t = RtUnk })
   in
     id
   end
@@ -180,8 +320,6 @@ functor IL(P: PARSER) = struct
   val getNew4 = getNewVReg VR4
   val getNew8 = getNewVReg VR8
 
-  fun ctxPutOp ctx op' = updateLctx ctx u#ops (fn l => op' ::  l) %
-
   fun newConst ctx class w =
   let
     val v = getNewVReg class ctx
@@ -191,6 +329,9 @@ functor IL(P: PARSER) = struct
 
   fun getClass (Lctx { vregs, ... }) id = #class $ D.get vregs id
 
+  fun pv (Reg v) out = Printf out `"Reg %" I v %
+    | pv (Addr v) out = Printf out `"Addr %" I v %
+
   fun convConst ctx (w, t) =
   let
     val class =
@@ -207,7 +348,7 @@ functor IL(P: PARSER) = struct
   fun convGLconst ctx (id, isFunc) =
   let
     val v = getNew8 ctx
-    val ctx = ctxPutOp ctx (IrSet (v, SaGL id))
+    val ctx = ctxPutOp ctx (IrSet (v, SaAddr (id, 0w0)))
   in
     if isFunc then
       (Reg v, ctx)
@@ -216,12 +357,15 @@ functor IL(P: PARSER) = struct
   end
 
   fun convId ctx (P.Gid p) = convGLconst ctx p
-    | convId (C as Lctx { localVars, ... }) (P.Lid id) =
-    let
-      val onStack = #onStack $ Vector.sub (localVars, id)
-    in
-      ((if onStack then Addr else Reg) id, C)
-    end
+    | convId (C as Lctx { localVars, paramNum, ... }) (P.Lid id) =
+      if id < paramNum then (* function parameter *)
+        (Reg $ id + Vector.length (localVars), C)
+      else
+        let
+          val onStack = #onStack $ Vector.sub (localVars, id)
+        in
+          ((if onStack then Addr else Reg) id, C)
+        end
 
   fun getOffset ea field = #1 $ valOf $ P.getFieldInfo (P.getT ea) field
 
@@ -269,12 +413,18 @@ functor IL(P: PARSER) = struct
     (Reg v, ctx)
   end
 
+  and getSingleOffset t =
+    if P.isPointer t then
+      P.sizeOfType (P.pointsTo t)
+    else
+      0w1
+
   and convPre op' ctx (v, t) =
     case v of
       Reg v =>
       let
         val class = getClass ctx v
-        val (v1, ctx) = newConst ctx class 0w1
+        val (v1, ctx) = newConst ctx class (getSingleOffset t)
 
         val ctx = ctxPutOp ctx (op' (v, v, v1))
       in
@@ -286,7 +436,7 @@ functor IL(P: PARSER) = struct
         val aClass = typeAccessClass t
         val vl = getNewVReg class ctx
         val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
-        val (v1, ctx) = newConst ctx class 0w1
+        val (v1, ctx) = newConst ctx class (getSingleOffset t)
         val ctx = ctxPutOp ctx (op' (vl, vl, v1))
         val ctx = ctxPutOp ctx (IrStore (v, vl, aClass))
       in
@@ -300,7 +450,7 @@ functor IL(P: PARSER) = struct
           val class = getClass ctx v
           val vOld = getNewVReg class ctx
           val ctx = ctxPutOp ctx (IrSet (vOld, SaVReg v))
-          val (v1, ctx) = newConst ctx class 0w1
+          val (v1, ctx) = newConst ctx class (getSingleOffset t)
           val ctx = ctxPutOp ctx (op' (v, v, v1))
         in
           (Reg vOld, ctx)
@@ -313,7 +463,7 @@ functor IL(P: PARSER) = struct
         val ctx = ctxPutOp ctx (IrLoad (vl, v, aClass))
         val vOld = getNewVReg class ctx
         val ctx = ctxPutOp ctx (IrSet (vOld, SaVReg vl))
-        val (v1, ctx) = newConst ctx class 0w1
+        val (v1, ctx) = newConst ctx class (getSingleOffset t)
         val ctx = ctxPutOp ctx (op' (vl, vl, v1))
         val ctx = ctxPutOp ctx (IrStore (v, vl, aClass))
       in
@@ -458,7 +608,7 @@ functor IL(P: PARSER) = struct
     (vNew, vLeft, vRight, ctx)
   end
 
-  and convSimple ctx t vLeft vRight op' =
+  and convSimple op' ctx t vLeft vRight =
   let
     val (vNew, vLeft, vRight, ctx) = binopPrepOpers ctx t vLeft vRight
     val ctx = ctxPutOp ctx (op' (vNew, vLeft, vRight))
@@ -559,7 +709,7 @@ functor IL(P: PARSER) = struct
     (Addr res, ctx)
   end
 
-  and convCompAssign ctx (leftT, vLeft) (rightT, vRight) (op', op2) =
+  and convCompAssign (op', op2) ctx (leftT, vLeft) (rightT, vRight) =
   let
     val (vRight, ctx) = loadIfNeeded ctx rightT vRight
     val leftT = P.resolveType leftT
@@ -581,6 +731,18 @@ functor IL(P: PARSER) = struct
       val (vRight, ctx) = convIfNeeded ctx rightT vRight
 
       val op' = if P.isSigned commonType then op2 else op'
+      val (vRight, ctx) =
+        if P.isPointer leftT then
+          let
+            val (mul, ctx) =
+              newConst ctx VR8 (P.sizeOfType (P.pointsTo leftT))
+            val vm = getNew8 ctx
+            val ctx = ctxPutOp ctx (IrMul (vm, vRight, mul))
+          in
+            (vm, ctx)
+          end
+        else
+          (vRight, ctx)
       val ctx = ctxPutOp ctx (op' (vLeft, vLeft, vRight))
     in
       (vLeft, ctx)
@@ -695,8 +857,8 @@ functor IL(P: PARSER) = struct
     fun commonWrapper f ctx (leftT, vLeft) (_, vRight) =
       f ctx leftT vLeft vRight
 
-    val convSimple = apply $ commonWrapper convSimple
-    val convCompAssign = apply convCompAssign
+    val convSimple = fn op' => apply $ commonWrapper (convSimple op')
+    val convCompAssign = fn opp => apply $ convCompAssign opp
   in
     case binop of
       P.BR P.BrMul => convSimple (chs IrIMul IrMul)
@@ -759,9 +921,69 @@ functor IL(P: PARSER) = struct
     (Reg vRes, ctx)
   end
 
-  (*
-    EfuncCall of exprAug * exprAug list |
-  *)
+  and convFuncCall ctx func args =
+  let
+    val t = P.getT func
+    val (vFunc, ctx) = convExpr ctx func
+    val (vFunc, ctx) = loadIfNeeded ctx t vFunc
+    val (vFunc, ctx) =
+      case (getClass ctx vFunc) of
+        VR4 =>
+        let
+          val v = getNew8 ctx
+        in
+          (v, ctxPutOp ctx (IrSet (v, SaVReg vFunc)))
+        end
+      | VR8 => (vFunc, ctx)
+
+    fun genArgs ctx [] acc =
+      let
+        fun loop ctx _ [] acc2 = (rev acc2, ctx)
+          | loop ctx idx (vArg :: acc) acc2 =
+          let
+            val arg = getNewVReg (getClass ctx vArg) ctx
+            val ctx = ctxPutOp ctx (IrSet (arg, SaVReg vArg))
+          in
+            loop ctx (idx + 1) acc (arg :: acc2)
+          end
+      in
+        loop ctx 0 acc []
+      end
+      | genArgs ctx (arg :: args) acc =
+      let
+        val (vArg, ctx) = convExpr ctx arg
+        val (vArg, ctx) = loadIfNeeded ctx (P.getT arg) vArg
+        val (vArg, ctx) =
+          if isLocal ctx vArg then
+            let
+              val vA = getNewVReg (getClassForType t) ctx
+              val ctx = ctxPutOp ctx (IrSet (vA, SaVReg vArg))
+            in
+              (vA, ctx)
+            end
+          else
+            (vArg, ctx)
+
+      in
+        genArgs ctx args (vArg :: acc)
+      end
+
+    val (args, ctx) = genArgs ctx args []
+
+    val rt = #1 $ P.funcParts (P.pointsTo t)
+    val vRes =
+      case P.resolveType rt of
+          P.void_t => ~1
+        | t =>
+          let
+            val class = getClassForType t
+            val vRes = getNewVReg class ctx
+          in
+            vRes
+          end
+  in
+    (Reg vRes, ctxPutOp ctx (IrFcall (vRes, vFunc, args)))
+  end
 
   and convExpr ctx ea: ev * localCtx =
   let
@@ -778,7 +1000,7 @@ functor IL(P: PARSER) = struct
     | P.Eunop (unop, ea) => convUnop ctx unop ea t
     | P.Ebinop (binop, left, right) => convBinop ctx binop left right
     | P.Eternary (cond, left, right) => convTernary ctx cond left right
-    | P.EfuncCall (_, _) => raise Unimplemented
+    | P.EfuncCall (func, args) => convFuncCall ctx func args
   end
 
   fun convIni (C as Lctx { localVars, ... }) (id, NONE) =
@@ -890,6 +1112,37 @@ functor IL(P: PARSER) = struct
     ctxPutOp C (IrJmp label)
   end
 
+  and convFor ctx (pre, cond, post, stmt) =
+  let
+    val ctx =
+      case pre of
+        NONE => ctx
+      | SOME ea => #2 $ convExpr ctx ea
+    val (startL, ctx) = getLabel ctx
+    val (breakL, contL, ctx) = ctxGetLoopLabels ctx
+
+    val ctx = ctxPutOp ctx (IrNopLabel startL)
+    val ctx =
+      case cond of
+        NONE => ctx
+      | SOME cond =>
+        let
+          val (cond, ctx) = genLogPart ctx cond
+        in
+          ctxPutOp ctx (IrJz (cond, breakL))
+        end
+    val ctx = convStmt ctx stmt
+    val ctx = ctxPutOp ctx (IrNopLabel contL)
+    val ctx =
+      case post of
+        NONE => ctx
+      | SOME post => #2 $ convExpr ctx post
+    val ctx = ctxPutOp ctx (IrJmp startL)
+    val ctx = ctxPutOp ctx (IrNopLabel breakL)
+  in
+    ctx
+  end
+
   and convStmt ctx stmt =
     case stmt of
       P.StmtExpr ea => #2 $ convExpr ctx ea
@@ -903,18 +1156,11 @@ functor IL(P: PARSER) = struct
         end
     | P.StmtIf t => convIf ctx t
     | P.StmtReturn ea => convReturn ctx ea
+    | P.StmtFor quad => convFor ctx quad
     | P.StmtWhile pair => convWhile ctx pair
     | P.StmtDoWhile pair => convDoWhile ctx pair
     | P.StmtBreak => convBreakOrCont true ctx
     | P.StmtContinue => convBreakOrCont false ctx
-    | _ => raise Unimplemented
-
-  val Preg = fn z =>
-  let
-    fun f id out = Printf out `"%" I id %
-  in
-    bind A1 f
-  end z
 
   val Pl = fn z =>
   let
@@ -948,36 +1194,79 @@ functor IL(P: PARSER) = struct
     bind A2 f
   end z
 
+  fun printConst class w =
+  let
+    val (sign, w) =
+      case class of
+        VR4 =>
+          if w < Word.<< (0w1, 0w31) then
+            ("+", w)
+          else
+            ("-", Word.~ (P.exts w 0w4))
+      | VR8 =>
+          if w < Word.<< (0w1, 0w63) then
+            ("+", w)
+          else
+            ("-", Word.~ w)
+    in
+      printf `sign W w %
+    end
+
+  fun preg (C as Lctx { vregs, ... }) id out =
+  let
+    val rt = getRegType vregs id
+  in
+    case rt of
+      RtUnk => Printf out `"%" I id %
+    | RtConst w => printConst (getClass C id) w
+    | RtAddrConst (id, w) => (printf `"$" PP.? id %; printConst VR8 w)
+  end
+  val Preg = fn z => bind A2 preg z
+
   fun printOpSet ctx reg arg =
   let
-    val () = printf `"\t" Preg reg `" " Pt ctx reg `" = " %
+    val () = printf `"\t" Preg ctx reg `" " Pt ctx reg `" = " %
   in
     case arg of
-      SaVReg reg => printf Preg reg %
-    | SaConst w => printf W w %
-    | SaGL id => printf PP.? id %
+      SaVReg reg => printf Preg ctx reg %
+    | SaConst w => printConst (getClass ctx reg) w
+    | SaAddr (id, w) => (printf PP.? id %; printConst VR8 w)
   end
 
-  fun printOp ctx op' =
+  fun printOp ctx (idx, SOME op') =
   let
+
+    val () = printf I idx `":" %
     fun pt (reg1, reg2, reg3) op' =
-      printf `"\t" Preg reg1 `" " Pt ctx reg1 `" = "
-          `op' `" " Preg reg2 `", " Preg reg3 %
+      printf `"\t" Preg ctx reg1 `" " Pt ctx reg1 `" = "
+          `op' `" " Preg ctx reg2 `", " Preg ctx reg3 %
 
     fun pe (reg1, reg2, aClass) op' =
-      printf `"\t" Preg reg1 `" " Pt ctx reg1 `" = "
-          `op' `" " Pac aClass `" " Preg reg2 %
+      printf `"\t" Preg ctx reg1 `" " Pt ctx reg1 `" = "
+          `op' `" " Pac aClass `" " Preg ctx reg2 %
 
-    fun pj (r, l) op' = printf `"\t" `op' `" " Preg r `", " Pl l %
+    fun pj (r, l) op' = printf `"\t" `op' `" " Preg ctx r `", " Pl l %
 
 
     fun printRet NONE = printf `"\tret" %
       | printRet (SOME reg) =
-        printf `"\tret " Pt ctx reg `" " Preg reg %
+        printf `"\tret " Pt ctx reg `" " Preg ctx reg %
 
-    fun printAlloc (r, size) = printf `"\t" Preg r `" = alloc " W size %
+    fun printAlloc (r, size) = printf `"\t" Preg ctx r `" = alloc " W size %
     fun printCopy (to, from, size) =
-      printf `"\tcopy " Preg to `", .I" I from `", " W size %
+      printf `"\tcopy " Preg ctx to `", .I" I from `", " W size %
+
+    fun printFcall (ret, f, args) =
+    let
+      val () = printf `"\t" %
+      val () =
+        if ret <> ~1 then
+          printf Preg ctx ret `" " Pt ctx ret `" = " %
+        else
+          ()
+    in
+      printf `"fcall " Preg ctx f `"" Plist (preg ctx) args (", ", true, 0) %
+    end
   in
     case op' of
       IrSet (reg, arg) => printOpSet ctx reg arg
@@ -1010,32 +1299,367 @@ functor IL(P: PARSER) = struct
     | IrExtSign t => pe t "exts"
 
     | IrLoad (r1, r2, ac) =>
-      printf `"\t" Preg r1 `" = " Pac ac `" [" Preg r2 `"]" %
+      printf `"\t" Preg ctx r1 `" = " Pac ac `" [" Preg ctx r2 `"]" %
     | IrStore (r1, r2, ac) =>
-      printf `"\t" Pac ac `" [" Preg r1 `"] <- " Preg r2 %
+      printf `"\t" Pac ac `" [" Preg ctx r1 `"] <- " Preg ctx r2 %
     | IrJmp l => printf `"\tjmp " Pl l %
     | IrJz p => pj p "jz"
     | IrJnz p => pj p "jnz"
-    | IrNopLabel l => printf Pl l `":" %
+    | IrNopLabel l => printf `"@" Pl l `":" %
+    | IrNop s => printf `"\t; " `s %
     | IrRet v => printRet v
     | IrAlloc p => printAlloc p
     | IrCopy t => printCopy t
+    | IrFcall t => printFcall t
     ;
     printf `"\n" %
   end
+   | printOp _ (_, NONE) = ()
+
+  fun printIns (C as Lctx { opTable, ... }) =
+    Array.appi (printOp C) (valOf opTable)
+
+  fun printVar idx { class, defs, use, t = _ } =
+  let
+  in
+    printfn `"%" I idx `" " `(if class = VR4 then "w4" else "w8")
+        `": defs = " Plist i defs (", ", true, 0)
+        `", uses = " Plist i use (", ", true, 0) %
+  end
+
+  fun printVars (Lctx { vregs, ... }) =
+  let
+    fun loop idx =
+      if idx = D.length vregs then
+        ()
+      else (
+        printVar idx (D.get vregs idx);
+        loop (idx + 1)
+      )
+  in
+    loop 0
+  end
+
+  fun createInsTable (C as Lctx { ops, ... }) =
+  let
+    val l = NONE :: map (fn v => SOME v) (rev ops)
+    val arr = Array.fromList l
+  in
+    updateLctx C s#opTable (SOME arr) %
+  end
+
+  fun constAdd vregs opTable vid v insId =
+  let
+    val () = printfn `"new constant: %" I vid %
+
+    val { class, defs, use, t = _ } = D.get vregs vid
+
+    val v =
+      case v of
+        RtConst w =>
+        let
+          val w = P.extz w (getClassSize class)
+        in
+          RtConst w
+        end
+      | RtAddrConst (id, 0w0) => RtAddrConst (id, 0w0)
+      | RtAddrConst _ | RtUnk => raise Unreachable
+    val () = D.set vregs vid { class, defs, use, t = v }
+  in
+    Array.update (opTable, insId, NONE)
+  end
+
+  fun getFirstConstants
+    (Lctx { vregs, opTable, localVars, paramNum, ... }) =
+  let
+    val opTable = valOf opTable
+
+    fun loop vid acc =
+      if vid = D.length vregs then
+        rev acc
+      else
+        let
+          val { defs, ... } = D.get vregs vid
+
+          fun addConst arg def =
+          let
+            val v =
+              case arg of
+                SaConst w => RtConst w
+              | SaAddr p => RtAddrConst p
+              | _ => raise Unreachable
+          in
+            constAdd vregs opTable vid v def
+          end
+        in
+          case defs of
+            [def] =>
+            let
+              val ins = valOf $ Array.sub (opTable, def)
+            in
+              case ins of
+                IrSet(_, arg as SaConst _ | arg as SaAddr _) =>
+                let
+                  val () = addConst arg def
+                in
+                  loop (vid + 1) (vid :: acc)
+                end
+              | _ => loop (vid + 1) acc
+            end
+            | _ => loop (vid + 1) acc
+        end
+  in
+    loop (Vector.length localVars + paramNum) []
+  end
+
+  datatype ext = ExtSign | ExtZero
+
+  fun getCS vregs r =
+  let
+    val { class, ... } = D.get vregs r
+  in
+    getClassSize class
+  end
+
+  fun evalPrep supThird vregs (rd, rs1, rs2) ext =
+  let
+    val getC = getCS vregs
+
+    val () =
+      if getC rs1 <> getC rs2 then
+        raise Unreachable
+      else
+        if not supThird andalso getC rd <> getC rs1 then
+          raise Unreachable
+        else
+          ()
+
+    val rt1 = getRegType vregs rs1
+    val rt2 = getRegType vregs rs2
+    val size = getC rd
+
+  in
+    case (rt1, rt2) of
+      (RtConst w1, RtConst w2) => (
+        case ext of
+          ExtZero => SOME (P.extz w1 size, P.extz w2 size)
+        | ExtSign => SOME (P.exts w1 size, P.exts w2 size)
+      )
+    | _ => NONE
+  end
+
+  fun evalSimple supThird vregs ext triple op' =
+    case evalPrep supThird vregs triple ext of
+      SOME wp => RtConst (op' wp)
+    | NONE => RtUnk
+
+  fun evalSet vregs (rd, SaVReg rs) =
+  let
+    val rt = getRegType vregs rs
+    val fromSize = getCS vregs rs
+    val toSize = getCS vregs rd
+  in
+    case rt of
+      RtConst w => RtConst $ P.extz w fromSize
+    | RtAddrConst p =>
+        if toSize = 0w8 then
+          RtAddrConst p
+        else
+          RtUnk
+    | _ => raise Unreachable
+  end
+    | evalSet _ _ = raise Unreachable
 
-  fun printIns (C as Lctx { ops, ... }) =
-    List.app (printOp C) ops
+  fun evalExt vregs ext (_, rs, aClass) =
+  let
+    val rt = getRegType vregs rs
+    val ext = if ext = ExtZero then P.extz else P.exts
+  in
+    case rt of
+      RtConst w => RtConst $ ext w (ac2word aClass)
+    | RtAddrConst p =>
+        if aClass = AC8 then
+          RtAddrConst p
+        else
+          RtUnk
+    | _ => raise Unreachable
+  end
 
-  fun translateFn (F as { localVars, stmt, ... }) =
+  fun evalAddSub op' vregs (rd, rs1, rs2) =
+  let
+    val getC = getCS vregs
+    val () =
+      if getC rs1 <> getC rs2 orelse getC rd <> getC rs1 then
+        raise Unreachable
+      else
+        ()
+    val size = getC rd
+
+    val rt1 = getRegType vregs rs1
+    val rt2 = getRegType vregs rs2
+  in
+    case (rt1, rt2) of
+      (RtConst w1, RtConst w2) => RtConst $ P.extz (op' (w1, w2)) size
+    | (RtAddrConst (id, w1), RtConst w2) => RtAddrConst (id, op' (w1, w2))
+    | _ => RtUnk
+  end
+
+  fun eval' ins vregs =
+  let
+    open Word
+
+    val es = evalSimple false vregs
+    val esu = es ExtZero
+    val ess = es ExtSign
+
+    fun opCommon conv op' (w1, w2) =
+    let
+      val i1 = word64Toint64 w1
+      val i2 = word64Toint64 w2
+    in
+      conv (op' (i1, i2))
+    end
+
+    val sop = opCommon int64Toword64
+
+    fun bop op' wp =
+    let
+      val res = op' wp
+    in
+      if res then 0w1 else 0w0
+    end
+
+    val sbop = opCommon (fn true => 0w1 | false => 0w0)
+
+    fun eq wp = case compare wp of EQUAL => 0w1 | _ => 0w0
+    fun neq wp = case compare wp of EQUAL => 0w0 | _ => 0w1
+  in
+    case ins of
+      IrAdd t => evalAddSub Word.+ vregs t
+    | IrSub t => evalAddSub Word.- vregs t
+
+    | IrAnd t => esu t Word.andb
+    | IrOr t => esu t Word.orb
+    | IrXor t => esu t Word.xorb
+    | IrMul t => esu t Word.*
+    | IrIMul t => ess t (sop Int64.*)
+    | IrDiv t => esu t Word.div
+    | IrIDiv t => ess t (sop Int64.div)
+    | IrMod t => esu t Word.mod
+    | IrIMod t => esu t (sop Int64.mod)
+    | IrShl t => esu t Word.<<
+    | IrShr t => esu t Word.>>
+    | IrSar t => ess t Word.~>>
+
+    | IrCmpul t => esu t (bop Word.<)
+    | IrCmpug t => esu t (bop Word.<)
+    | IrCmpule t => esu t (bop Word.<=)
+    | IrCmpuge t => esu t (bop Word.>=)
+    | IrCmpsl t => ess t (sbop Int64.<)
+    | IrCmpsg t => ess t (sbop Int64.>)
+    | IrCmpsle t => ess t (sbop Int64.<=)
+    | IrCmpsge t => ess t (sbop Int64.>=)
+    | IrEq t => evalSimple true vregs ExtZero t eq
+    | IrNeq t => evalSimple true vregs ExtZero t neq
+    | IrSet t => evalSet vregs t
+    | IrExtZero p => evalExt vregs ExtZero p
+    | IrExtSign p => evalExt vregs ExtSign p
+
+    | IrAlloc _ | IrLoad _ | IrStore _ | IrRet _ | IrFcall _
+    | IrCopy _ | IrJz _ | IrJnz _  => RtUnk
+    | IrJmp _ | IrNop _ | IrNopLabel _ => raise Unreachable
+  end
+
+  fun eval (SOME ins) vregs =
+  let
+    val res = eval' ins vregs
+  in
+    case res of
+      RtConst w =>
+      let
+        val { defs, ...  } = getInsInfo ins
+        val { class, ... } = D.get vregs (hd defs)
+        val w = P.extz w (getClassSize class)
+      in
+        RtConst w
+      end
+    | _ => res
+  end
+   | eval NONE _ = RtUnk
+
+  fun defines (SOME ins) =
+  let
+    val { defs, ... } = getInsInfo ins
+  in
+    hd defs
+  end
+    | defines NONE = raise Unreachable
+
+  fun propagate [] _ _ = ()
+    | propagate (v :: vs) vregs opTable =
+    let
+      open Array
+      val { use, ... } = D.get vregs v
+
+      fun loop (insId :: tail) acc =
+      let
+        val ins = sub (opTable, insId)
+      in
+        case eval ins vregs of
+          RtUnk => loop tail acc
+        | v =>
+        let
+          val vd = defines ins
+          val { defs, ... } = D.get vregs vd
+          val newConst =
+            case defs of
+              [_] => (constAdd vregs opTable vd v insId; SOME vd)
+            | _ =>
+              let
+                val vl =
+                  case v of
+                    RtConst w => SaConst w
+                  | RtAddrConst p => SaAddr p
+                  | _ => raise Unreachable
+                val ins = IrSet (vd, vl)
+              in
+                update (opTable, insId, SOME ins);
+                NONE
+              end
+        in
+          loop tail (case newConst of SOME vc => vc :: acc | NONE => acc)
+        end
+      end
+        | loop [] acc = acc
+
+      val newConst = loop use []
+    in
+      propagate (List.revAppend (newConst, vs)) vregs opTable
+    end
+
+  fun constPropagate (C as Lctx { vregs, opTable, ... }) =
+  let
+    val opTable = valOf opTable
+    val worklist = getFirstConstants C
+  in
+    propagate worklist vregs opTable
+  end
+
+  fun translateFn (F as { localVars, stmt, paramNum, ... }) =
   let
     val () = P.printDef (P.Definition F)
-    val ctx = createLocalCtx localVars
+    val ctx = createLocalCtx localVars paramNum
     val ctx = convStmt ctx stmt
 
-    val ctx = updateLctx ctx u#ops (fn ops => rev ops) %
+    val ctx = createInsTable ctx
+    val () = printVars ctx
+    val () = printIns ctx
+
+    val () = printf `"\nconstant propagation\n" %
+    val () = constPropagate ctx
+    val () = printIns ctx
   in
-    printIns ctx
+    ctx
   end
 
   fun createCtx ({ ext, glob, objsZI, objs, funcs, strlits }) =
diff --git a/parser.fun b/parser.fun
index 40d254f..9e36f2c 100644
--- a/parser.fun
+++ b/parser.fun
@@ -263,6 +263,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     tokenBuf: P.t * (token * P.tkPos) list list,
 
     loopLevel: int,
+    paramNum: int option,
 
     defs: def list,
     strlits: int list
@@ -275,18 +276,18 @@ functor Parser(structure Tree: TREE; structure P: PPC;
   fun updateCtx (Ctx ctx) = fn z =>
   let
     fun from aggrTypeNames localScopes funcRetType globalSyms
-      tokenBuf loopLevel defs strlits
+      tokenBuf loopLevel paramNum defs strlits
     =
       { aggrTypeNames, localScopes, funcRetType, globalSyms,
-        tokenBuf, loopLevel, defs, strlits }
+        tokenBuf, loopLevel, paramNum, defs, strlits }
 
     fun to f { aggrTypeNames, localScopes, funcRetType, globalSyms,
-        tokenBuf, loopLevel, defs, strlits }
+        tokenBuf, loopLevel, paramNum, defs, strlits }
     =
       f aggrTypeNames localScopes funcRetType globalSyms tokenBuf
-        loopLevel defs strlits
+        loopLevel paramNum defs strlits
   in
-    FRU.makeUpdate8 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
+    FRU.makeUpdate9 (from, from, to) ctx (fn (a, f) => z (a, Ctx o f))
   end
 
   datatype declParts =
@@ -718,6 +719,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     globalSyms = Tree.empty,
     tokenBuf = (P.create { fname, incDirs, debugMode = false }, []),
     loopLevel = 0,
+    paramNum = NONE,
     defs = [],
     strlits = []
   }
@@ -1364,7 +1366,10 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
             val () =
               if under = UAddr then
-                reduceVarToStack lid
+                if lid < valOf (#paramNum ctx) then
+                  P.error pos `"cannot take address of function argument" %
+                else
+                  reduceVarToStack lid
               else
                 ()
           in
@@ -1957,40 +1962,42 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
   and sizeofWrapper t = Word64.toInt $ sizeOfType t
 
-  and zeroExtend (ER (w, t)): word =
+  and zeroExtend (ER (w, t)): word = extz w (sizeOfType t)
+
+  and extz w fromSize =
   let
-    val size = Word.fromLarge $ sizeOfType t
     val minus1 = Word64.notb (Word64.fromInt 0)
-    val mask = Word64.>> (minus1, 0w64 - size * 0w8)
+    val mask = Word64.>> (minus1, 0w64 - fromSize * 0w8)
 
-    val () = printf `"ZH0: " W w `"\n" %
     val res = Word64.andb (mask, w)
-    val () = printf `"ZH1: " W res `"\n" %
   in
     res
   end
 
-  and getSignBit w sizeInBits =
+  and getSignBit w sizeInBits: int =
   let
-    val shift = Word64.>> (w, Word.fromInt $ sizeInBits -1)
-    val bit = Word64.andb (shift, Word64.fromInt 1)
+    open Word
+
+    val shift = >> (w, sizeInBits - 0w1)
+    val bit = andb (shift, 0w1)
   in
-    Word64.toInt bit
+    toInt bit
   end
 
-  and signExtend (R as (ER (w, t))) =
+  and signExtend (ER (w, t)) = exts w (sizeOfType t)
+
+  and exts w fromSize =
   let
-    val sizeInBits = 8 * sizeofWrapper t
+    open Word
 
+    val sizeInBits = fromSize * 0w8
     val signBit = getSignBit w sizeInBits
-
-    val signExtMask =
-      Word64.<< (Word64.notb $ Word64.fromInt 0, Word.fromInt sizeInBits)
+    val signExtMask = << (notb 0w0, sizeInBits)
   in
     if Int.compare (signBit, 0) = EQUAL then
-      zeroExtend R
+      extz w fromSize
     else
-      Word64.orb (signExtMask, w)
+      orb (signExtMask, w)
   end
 
   and evalUnop UnopPos _ arg = arg
@@ -2055,7 +2062,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
   and ebIsNegative (ER (w, t)) =
     if isSigned t then
-      if getSignBit w (8 * sizeofWrapper t) = 1 then
+      if getSignBit w (0w8 * sizeOfType t) = 1 then
         true
       else
         false
@@ -3248,7 +3255,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
   in
     if class = DeclDefined then
       let
-        val ini = canonIni (isGlobalScope ctx) pos t (valOf ini)
+        val ini = canonIni true pos t (valOf ini)
       in
         (SOME $ ToplevId (id, pos, t, ini, linkage), ctx)
       end
@@ -3301,10 +3308,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     printf R offset
         `"local var " P.?nid `"(" I varId `"): " Pctype t `"\n" %;
 
-    if isSome ini orelse not $ isScalar t then
-      (SOME $ LocalId (varId, ini), ctx)
-    else
-      (NONE, ctx)
+    (SOME $ LocalId (varId, ini), ctx)
   end
 
   fun handleTypedef (C as Ctx ctx) ({ pos, t, id, ini, ... }: rawDecl) =
@@ -3611,20 +3615,30 @@ functor Parser(structure Tree: TREE; structure P: PPC;
       (StmtExpr ea, ctx)
   end
 
-  and handleInis ctx l =
-  let
-    fun handleIni (id, NONE) = (id, NONE)
-      | handleIni (id, SOME ini) =
-      let
-        val (pos, t) = (fn ({pos, t, ... }) => (pos, t)) $
-            D.get localVars id
+  and handleLocalIni (id, NONE) =
+    if #onStack $ D.get localVars id then
+      SOME (id, NONE)
+    else
+      NONE
+    | handleLocalIni (id, SOME ini) =
+    let
+      val (pos, t) = (fn ({pos, t, ... }) => (pos, t)) $
+          D.get localVars id
 
-        val ini = canonIni (isGlobalScope ctx) pos t ini
-      in
-        (id, SOME ini)
-      end
+      val ini = canonIni false pos t ini
+    in
+      SOME (id, SOME ini)
+    end
+
+  and processLocalInis inis =
+  let
+    fun loop [] acc = rev acc
+      | loop (ini :: inis) acc =
+        case handleLocalIni ini of
+          NONE => loop inis acc
+        | SOME v => loop inis (v :: acc)
   in
-    List.map handleIni l
+    loop inis []
   end
 
   and parseStmtCompound isFuncBody ctx =
@@ -3636,12 +3650,12 @@ functor Parser(structure Tree: TREE; structure P: PPC;
       if isTypeNameStart ctx tk then
         let
           val (res, ctx) = parseDeclaration ctx
-          val inits =
+          val varInits =
             case res of
-              LocalVarInits l => handleInis ctx l
+              LocalVarInits l => l (* handleInis ctx l *)
             | _ => raise Unreachable
         in
-          collectDecls (List.revAppend (inits, acc)) ctx
+          collectDecls (List.revAppend (varInits, acc)) ctx
         end
       else
         (rev acc, ctx)
@@ -3669,6 +3683,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
     val (inits, ctx) = collectDecls [] ctx
     val (stmts, ctx) = collectStmts [] ctx
+    val inits = processLocalInis inits
 
     val ctx = updateCtx ctx u#localScopes tl %
   in
@@ -3768,7 +3783,8 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
     val scope = createLocalVars Tree.empty 0 paramTypes params
   in
-    updateCtx ctx s#localScopes [scope] s#funcRetType (SOME rt) %
+    updateCtx ctx s#localScopes [scope] s#funcRetType (SOME rt)
+        s#paramNum (SOME $ length params) %
   end
 
   fun worldPrepareForFunc () = D.reset localVars
@@ -3788,6 +3804,8 @@ functor Parser(structure Tree: TREE; structure P: PPC;
 
     val (stmt, ctx) = parseStmtCompound true ctx
     val localVars = finishLocalVars ()
+
+    val ctx = updateCtx ctx s#paramNum NONE %
   in
     (Definition {
         name = id,
diff --git a/parser.sig b/parser.sig
index 2dea29f..17dbeaa 100644
--- a/parser.sig
+++ b/parser.sig
@@ -161,7 +161,11 @@ signature PARSER = sig
 
   val getLayoutSize: int -> word
 
+  val extz: word -> word -> word
+  val exts: word -> word -> word
+
   val getT: exprAug -> ctype
+  val funcParts: ctype -> ctype * ctype list
 
   val getFieldInfo: ctype -> nid -> (word * ctype) option