diff options
Diffstat (limited to 'il.fun')
-rw-r--r-- | il.fun | 196 |
1 files changed, 107 insertions, 89 deletions
@@ -14,6 +14,11 @@ functor IL(P: PARSER) = struct datatype accessClass = AC1 | AC2 | AC4 | AC8 + datatype cmpOp = + Cmpeq | Cmpneq | + Cmpul | Cmpug | Cmpule | Cmpuge | + Cmpsl | Cmpsg | Cmpsle | Cmpsge + datatype irIns = IrSet of vreg * setArg | IrAdd of vreg * vreg * vreg @@ -30,18 +35,8 @@ functor IL(P: PARSER) = struct | IrAnd of vreg * vreg * vreg | IrOr of vreg * vreg * vreg | IrXor of vreg * vreg * vreg - | IrEq of vreg * vreg * vreg - | IrNeq of vreg * vreg * vreg - - | IrCmpul of vreg * vreg * vreg - | IrCmpug of vreg * vreg * vreg - | IrCmpule of vreg * vreg * vreg - | IrCmpuge of vreg * vreg * vreg - | IrCmpsl of vreg * vreg * vreg - | IrCmpsg of vreg * vreg * vreg - | IrCmpsle of vreg * vreg * vreg - | IrCmpsge of vreg * vreg * vreg + | IrCmp of cmpOp * vreg * vreg * vreg | IrExtZero of vreg * vreg * accessClass | IrExtSign of vreg * vreg * accessClass @@ -72,7 +67,8 @@ functor IL(P: PARSER) = struct class: vregClass, use: int list, defs: int list, - t: regType + t: regType, + canFold: bool } datatype scopeInfo = @@ -180,14 +176,16 @@ functor IL(P: PARSER) = struct 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 = RtReg }); + D.push vregs + { class, defs, use = [], t = RtReg, canFold = true }; loop (idx + 1) end else let val { class, ... } = D.get vregs (idx - lvlen) in - D.push vregs ({ class, defs = [], use = [], t = RtReg }); + D.push vregs + { class, defs = [], use = [], t = RtReg, canFold = true }; loop (idx + 1) end val () = loop 0 @@ -217,16 +215,7 @@ functor IL(P: PARSER) = struct | 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 + | IrCmp (_, vr1, vr2, vr3) => tr (vr1, vr2, vr3) | IrExtZero (rd, rs, _) => de (rd, rs) | IrExtSign (rd, rs, _) => de (rd ,rs) @@ -250,17 +239,16 @@ functor IL(P: PARSER) = struct let fun updateDef vr = let - val { class, defs, use, t } = D.get vregs vr + val { class, defs, use, t, canFold } = D.get vregs vr in - D.set vregs vr { class, defs = pos :: defs, use, t } + D.set vregs vr { class, defs = pos :: defs, use, t, canFold } end fun updateUse vr = let - val { class, defs, use, t } = D.get vregs vr + val { class, defs, use, t, canFold } = D.get vregs vr in - D.set vregs vr { class, defs, use = pos :: use, t } + D.set vregs vr { class, defs, use = pos :: use, t, canFold } end - in List.app updateDef defs; List.app updateUse use @@ -340,13 +328,17 @@ functor IL(P: PARSER) = struct ctx end - fun getNewVReg class (Lctx { vregs, ... }) = + fun getNewVR class (Lctx { vregs, ... }) canFold = let - val id = D.pushAndGetId vregs ({ class, defs = [], use = [], t = RtReg }) + val id = D.pushAndGetId vregs + { class, defs = [], use = [], t = RtReg, canFold } in id end + fun getNewVReg class C = getNewVR class C true + fun getNewVRegFuncArg class C = getNewVR class C false + val getNew4 = getNewVReg VR4 val getNew8 = getNewVReg VR8 @@ -529,7 +521,7 @@ functor IL(P: PARSER) = struct let val vc = newConst ctx (getClass ctx vSrc) 0w0 in - ctxPutOp ctx (IrEq (vDest, vSrc, vc)) + ctxPutOp ctx (IrCmp (Cmpeq, vDest, vSrc, vc)) end and prepNeg ctx vDest vSrc = @@ -842,7 +834,7 @@ functor IL(P: PARSER) = struct val vRight = genLogPart ctx right val vC = newConst ctx (getClass ctx vRight) 0w0 - val () = ctxPutOp ctx (IrNeq (vRes, vRight, vC)) + val () = ctxPutOp ctx (IrCmp (Cmpneq, vRes, vRight, vC)) in Reg vRes end @@ -856,7 +848,7 @@ functor IL(P: PARSER) = struct val vRes = getNew4 ctx val vC = newConst ctx (getClass ctx vRight) 0w0 in - ctxPutOp ctx (IrNeq (vRes, vRight, vC)); + ctxPutOp ctx (IrCmp (Cmpneq, vRes, vRight, vC)); ctxPutOp ctx (IrJmp endLabel); ctxPutOp ctx (IrNopLabel (falseLabel)); ctxPutOp ctx (IrSet (vRes, SaConst 0w0)); @@ -884,6 +876,8 @@ functor IL(P: PARSER) = struct val convSimple = fn op' => apply $ commonWrapper (convSimple op') val convCompAssign = fn opp => apply $ convCompAssign opp + + fun cmpw cmop (r1, r2, r3) = IrCmp (cmop, r1, r2, r3) in case binop of P.BR P.BrMul => convSimple (chs IrIMul IrMul) @@ -894,12 +888,12 @@ functor IL(P: PARSER) = struct | P.BR P.BrBitAnd => convSimple IrAnd | P.BR P.BrBitOr => convSimple IrOr | P.BR P.BrBitXor => convSimple IrXor - | P.BR P.BrEqual => convSimple IrEq - | P.BR P.BrNotEqual => convSimple IrNeq - | P.BR P.BrGreater => convSimple (chs IrCmpsg IrCmpug) - | P.BR P.BrLess => convSimple (chs IrCmpsl IrCmpul) - | P.BR P.BrGreaterEqual => convSimple (chs IrCmpsge IrCmpuge) - | P.BR P.BrLessEqual => convSimple (chs IrCmpsle IrCmpule) + | P.BR P.BrEqual => convSimple (cmpw Cmpeq) + | P.BR P.BrNotEqual => convSimple (cmpw Cmpneq) + | P.BR P.BrGreater => convSimple (chs (cmpw Cmpsg) (cmpw Cmpug)) + | P.BR P.BrLess => convSimple (chs (cmpw Cmpsl) (cmpw Cmpul)) + | P.BR P.BrGreaterEqual => convSimple (chs (cmpw Cmpsge) (cmpw Cmpuge)) + | P.BR P.BrLessEqual => convSimple (chs (cmpw Cmpsle) (cmpw Cmpule)) | P.BR P.BrAssign => apply $ commonWrapper convSimpleAssignment | P.BR P.BrBitAndAssign => convCompAssign (IrAnd, IrAnd) @@ -967,7 +961,7 @@ functor IL(P: PARSER) = struct fun loop _ [] acc2 = rev acc2 | loop idx (vArg :: acc) acc2 = let - val arg = getNewVReg (getClass ctx vArg) ctx + val arg = getNewVRegFuncArg (getClass ctx vArg) ctx in ctxPutOp ctx (IrSet (arg, SaVReg vArg)); loop (idx + 1) acc (arg :: acc2) @@ -1021,11 +1015,18 @@ functor IL(P: PARSER) = struct | P.EfuncCall (func, args) => convFuncCall ctx func args end + fun wrapTo8 v = + let + open Word + in + (v + 0w7) div 0w8 * 0w8 + end + fun convIni (C as Lctx { localVars, ... }) (id, NONE) = let val size = P.sizeOfType $ #t $ Vector.sub (localVars, id) in - ctxPutOp C (IrAlloc (id, size, NONE)) + ctxPutOp C (IrAlloc (id, wrapTo8 size, NONE)) end | convIni (C as Lctx { localVars, ... }) (id, SOME (P.CiniExpr ea)) = let @@ -1041,6 +1042,11 @@ functor IL(P: PARSER) = struct | convIni ctx (id, SOME (P.CiniLayout lid)) = let val size = P.getLayoutSize lid + val () = + if Word.mod (size, 0w8) <> 0w0 then + raise Unreachable + else + () in ctxPutOp ctx (IrAlloc (id, size, NONE)); ctxPutOp ctx (IrCopy (id, lid, size)) @@ -1338,6 +1344,19 @@ functor IL(P: PARSER) = struct in printf `"@" Pl lid `"(" I use `"):" % end + + fun cmpOpStr cmpop = + case cmpop of + Cmpeq => "cmpeq" + | Cmpneq => "cmpneq" + | Cmpul => "cmpul" + | Cmpug => "cmpug" + | Cmpule => "cmpule" + | Cmpuge => "cmpuge" + | Cmpsl => "cmpsl" + | Cmpsg => "cmpsg" + | Cmpsle => "cmpsle" + | Cmpsge => "cmpsge" in case op' of IrSet (reg, arg) => printOpSet ctx reg arg @@ -1355,16 +1374,8 @@ functor IL(P: PARSER) = struct | IrAnd t => pt t "and" | IrOr t => pt t "or" | IrXor t => pt t "xor" - | IrEq t => pt t "eq" - | IrNeq t => pt t "neq" - | IrCmpul t => pt t "cmpul" - | IrCmpug t => pt t "cmpug" - | IrCmpule t => pt t "cmpule" - | IrCmpuge t => pt t "cmpuge" - | IrCmpsl t => pt t "cmpsl" - | IrCmpsg t => pt t "cmpsg" - | IrCmpsle t => pt t "cmpsle" - | IrCmpsge t => pt t "cmpsge" + + | IrCmp (cmpOp, vr1, vr2, vr3) => pt (vr1, vr2, vr3) (cmpOpStr cmpOp) | IrExtZero t => pe t "extz" | IrExtSign t => pe t "exts" @@ -1390,7 +1401,7 @@ functor IL(P: PARSER) = struct fun printIns (C as Lctx { ops, ... }) = D.appi (printOp C) ops - fun printVar idx { class, defs, use, t } = + fun printVar idx { class, defs, use, t, canFold = _ } = let val c = if class = VR4 then "w4" else "w8" @@ -1437,7 +1448,7 @@ functor IL(P: PARSER) = struct end | RtAddrConst (id, w) => RtAddrConst (id, w) | RtReg | RtRem => raise Unreachable - val () = D.set vregs vid { class, defs, use, t = v } + val () = D.set vregs vid { class, defs, use, t = v, canFold = true } fun f (SOME _, li) = (NONE, li) | f (NONE, _) = raise Unreachable @@ -1530,17 +1541,22 @@ functor IL(P: PARSER) = struct fun evalSet vregs (rd, SaVReg rs) = let val rt = getRegType vregs rs + val { canFold, ... } = D.get vregs rd + 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 - RtReg - | _ => raise Unreachable + if canFold = false then + RtReg + else + case rt of + RtConst w => RtConst $ P.extz w fromSize + | RtAddrConst p => + if toSize = 0w8 then + RtAddrConst p + else + RtReg + | _ => raise Unreachable end | evalSet _ _ = raise Unreachable @@ -1610,6 +1626,23 @@ functor IL(P: PARSER) = struct fun eq wp = case compare wp of EQUAL => 0w1 | _ => 0w0 fun neq wp = case compare wp of EQUAL => 0w0 | _ => 0w1 + + fun ecmp (cmpOp, vr1, vr2, vr3) = + let + val t = (vr1, vr2, vr3) + in + case cmpOp of + Cmpeq => evalSimple true vregs ExtZero t eq + | Cmpneq => evalSimple true vregs ExtZero t neq + | Cmpul => esu t (bop Word.<) + | Cmpug => esu t (bop Word.>) + | Cmpule => esu t (bop Word.<=) + | Cmpuge => esu t (bop Word.>=) + | Cmpsl => ess t (sbop Int64.<) + | Cmpsg => ess t (sbop Int64.>) + | Cmpsle => ess t (sbop Int64.<=) + | Cmpsge => ess t (sbop Int64.>=) + end in case ins of IrAdd t => evalAddSub Word.+ vregs t @@ -1628,16 +1661,8 @@ functor IL(P: PARSER) = struct | 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 + | IrCmp q => ecmp q + | IrSet t => evalSet vregs t | IrExtZero p => evalExt vregs ExtZero p | IrExtSign p => evalExt vregs ExtSign p @@ -1744,19 +1769,12 @@ functor IL(P: PARSER) = struct | IrIDiv t => IrIDiv (tr t) | IrMod t => IrMod (tr t) | IrIMod t => IrIMod (tr t) - | IrCmpul t => IrCmpul (tr t) - | IrCmpug t => IrCmpug (tr t) - | IrCmpule t => IrCmpule (tr t) - | IrCmpuge t => IrCmpuge (tr t) - | IrCmpsl t => IrCmpsl (tr t) - | IrCmpsg t => IrCmpsg (tr t) - | IrCmpsle t => IrCmpsle (tr t) - | IrCmpsge t => IrCmpsge (tr t) + + | IrCmp (cmpOp, _, vr2, vr3) => IrCmp (cmpOp, rd, vr2, vr3) + | IrAnd t => IrAnd (tr t) | IrOr t => IrOr (tr t) | IrXor t => IrXor (tr t) - | IrEq t => IrEq (tr t) - | IrNeq t => IrNeq (tr t) | IrExtSign t => IrExtSign (tr t) | IrExtZero t => IrExtZero (tr t) | IrLoad (_, rs, am) => IrLoad (rd, rs, am) @@ -1775,9 +1793,9 @@ functor IL(P: PARSER) = struct let val () = printfn `"removing %" I rs % - val { class, ... } = D.get vregs rs - val () = D.set vregs rs { defs = [], use = [], class, t = RtRem } + val () = D.set vregs rs + { defs = [], use = [], class, t = RtRem, canFold = false } val ins = valOf o #1 $ D.get ops (idx - 1) val ir = changeDest rd ins @@ -1789,12 +1807,12 @@ functor IL(P: PARSER) = struct val () = D.update ops f1 (idx - 1) val () = D.update ops f2 idx - val { defs, use, class, t } = D.get vregs rd + val { defs, use, class, t, canFold } = D.get vregs rd fun loop (d :: ds) acc = loop ds $ (if d = idx then idx - 1 else d) :: acc | loop [] acc = rev acc - val () = D.set vregs rd { defs = loop defs [], use, class, t } + val () = D.set vregs rd { defs = loop defs [], use, class, t, canFold } in () end @@ -1834,7 +1852,7 @@ functor IL(P: PARSER) = struct let val (_, usage) = D.get labels lid in - if usage = 0 then ( + if usage = 0 andalso lid <> 0 then ( printfn `"removing label: " I lid %; D.set ops insId (NONE, NONE) ) else @@ -1867,7 +1885,7 @@ functor IL(P: PARSER) = struct () else let - val { defs, use, t, class } = D.get vregs idx + val { defs, use, t, class, canFold } = D.get vregs idx val t = if t = RtReg andalso defs = [] then case use of @@ -1880,7 +1898,7 @@ functor IL(P: PARSER) = struct else t in - D.set vregs idx { defs, use, t, class }; + D.set vregs idx { defs, use, t, class, canFold }; loop (idx + 1) end in |