summaryrefslogtreecommitdiff
path: root/il.fun
diff options
context:
space:
mode:
Diffstat (limited to 'il.fun')
-rw-r--r--il.fun196
1 files changed, 107 insertions, 89 deletions
diff --git a/il.fun b/il.fun
index fb549d3..0e2240c 100644
--- a/il.fun
+++ b/il.fun
@@ -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