diff options
Diffstat (limited to 'il.fun')
-rw-r--r-- | il.fun | 213 |
1 files changed, 156 insertions, 57 deletions
@@ -43,6 +43,7 @@ functor IL(P: PARSER) = struct | IrLoad of vreg * vreg * accessClass (* %1 <- [%2] *) | IrStore of vreg * vreg * accessClass (* [%1] <- %2 *) + | IrJmpc of cmpOp * vreg * vreg * label | IrJz of vreg * label | IrJnz of vreg * label | IrJmp of label @@ -243,6 +244,7 @@ functor IL(P: PARSER) = struct | IrLoad (r1, r2, _) => de (r1, r2) | IrStore (r1, r2, _) => { defs = [], use = [r1, r2] } | IrJmp _ => { defs = [], use = [] } + | IrJmpc (_, r1, r2, _) => { defs = [], use = [r1, r2] } | IrJz (r, _) => { defs = [], use = [r] } | IrJnz (r, _) => { defs = [], use = [r] } | IrNopLabel _ | IrNop _ => { defs = [], use = [] } @@ -387,12 +389,12 @@ functor IL(P: PARSER) = struct Reg v end - fun convGLconst ctx (id, isFunc) = + fun convGLconst ctx id = let val v = getNew8 ctx in ctxPutOp ctx (IrSet (v, SaAddr (id, 0w0))); - if isFunc then Reg v else Addr v + Addr v end fun convStrlit ctx id t = @@ -403,7 +405,7 @@ functor IL(P: PARSER) = struct (if P.isArray t then Addr else Reg) v end - fun convId ctx (P.Gid p) = convGLconst ctx p + fun convId ctx (P.Gid id) = convGLconst ctx id | convId (Lctx { localVars, paramNum, ... }) (P.Lid id) = if id < paramNum then (* function parameter *) (Reg (id + Vector.length localVars)) @@ -576,8 +578,7 @@ functor IL(P: PARSER) = struct Reg vl end - and convCast _ (v, _, P.void_t) = v - | convCast ctx (v, fromT, toT) = + and convCastScalar ctx v fromT toT = case Word.compare (P.sizeOfType toT, P.sizeOfType fromT) of EQUAL => v | LESS => ( @@ -613,6 +614,30 @@ functor IL(P: PARSER) = struct Reg vNew end + and convCast _ (v, _, P.void_t) = v + | convCast ctx (v, fromT, toT) = + if P.isArray fromT then + let + val elT = P.elementType fromT + val () = + if toT <> P.pointer_t (1, elT) then raise Unreachable else () + in + case v of + Addr v => Reg v + | _ => raise Unreachable + end + else if P.isFunc fromT then + let + val () = + if toT <> P.pointer_t (1, fromT) then raise Unreachable else () + in + case v of + Addr v => Reg v + | _ => raise Unreachable + end + else + convCastScalar ctx v fromT toT + and convUnop ctx unop ea t: ev = let val v: ev = convExpr ctx ea @@ -1050,20 +1075,17 @@ functor IL(P: PARSER) = struct val t = P.getT ea val v = convExpr C ea val v = loadIfNeeded C t v + in - if #onStack $ Vector.sub (localVars, id) then - ctxPutOp C (IrLoad (id, v, typeAccessClass t)) - else + if #onStack $ Vector.sub (localVars, id) then ( + ctxPutOp C (IrAlloc (id, 0w8, NONE)); + ctxPutOp C (IrStore (id, v, typeAccessClass t)) + ) else ctxPutOp C (IrSet (id, SaVReg v)) end | convIni ctx (id, SOME (P.CiniLayout lid)) = let - val size = P.getLayoutSize lid - val () = - if Word.mod (size, 0w8) <> 0w0 then - raise Unreachable - else - () + val size = wrapTo8 $ P.getLayoutSize lid in ctxPutOp ctx (IrAlloc (id, size, NONE)); ctxPutOp ctx (IrCopy (id, lid, size)) @@ -1340,7 +1362,7 @@ functor IL(P: PARSER) = struct end fun printCopy (to, from, size) = - dprintf `"\tcopy " Preg ctx to `", .I" I from `", " W size % + dprintf `"\tcopy " Preg ctx to `", I." I from `", " W size % fun printFcall (ret, f, args) = let @@ -1353,6 +1375,7 @@ functor IL(P: PARSER) = struct in dprintf `"fcall " Preg ctx f `"" Plist (preg ctx) args (", ", true, 0) % end + fun printLabel (Lctx { labels, ... }) lid = let val (labelPos, use) = D.get labels lid @@ -1373,6 +1396,15 @@ functor IL(P: PARSER) = struct | Cmpsg => "cmpsg" | Cmpsle => "cmpsle" | Cmpsge => "cmpsge" + + fun pjc (op', r1, r2, lid) = + let + val opRepr = cmpOpStr op' + val opRepr = "jmp" ^ String.extract (opRepr, 3, NONE) + in + dprintf `"\t" `opRepr `" " + Preg ctx r1 `", " Preg ctx r2 `", " Pl lid % + end in case op' of IrSet (reg, arg) => printOpSet ctx reg arg @@ -1401,6 +1433,7 @@ functor IL(P: PARSER) = struct | IrStore (r1, r2, ac) => dprintf `"\t" Pac ac `" [" Preg ctx r1 `"] <- " Preg ctx r2 % | IrJmp l => dprintf `"\tjmp " Pl l % + | IrJmpc q => pjc q | IrJz p => pj p "jz" | IrJnz p => pj p "jnz" | IrNopLabel l => printLabel ctx l @@ -1681,7 +1714,7 @@ functor IL(P: PARSER) = struct | IrAlloc _ | IrLoad _ | IrStore _ | IrRet _ | IrFcall _ | IrCopy _ | IrJz _ | IrJnz _ => RtReg - | IrJmp _ | IrNop _ | IrNopLabel _ => raise Unreachable + | IrJmpc _ | IrJmp _ | IrNop _ | IrNopLabel _ => raise Unreachable end fun eval (SOME ins) vregs = @@ -1800,63 +1833,129 @@ functor IL(P: PARSER) = struct | IrRet NONE => raise Unreachable | IrSet (_, arg) => IrSet (rd, arg) | IrNop _ | IrNopLabel _ | IrAlloc _ | IrCopy _ | IrJmp _ | IrJz _ - | IrJnz _ | IrStore _ => raise Unreachable + | IrJmpc _ | IrJnz _ | IrStore _ => raise Unreachable end - fun mergeIns (Lctx { vregs, ops, ... }) idx rd rs = + fun removeVR vregs vr = let - val () = dprintf `"removing %" I rs `"\n" % - - val { class, ... } = D.get vregs rs - val () = D.set vregs rs + val { class, ... } = D.get vregs vr + in + D.set vregs vr { defs = [], use = [], class, t = RtRem, canFold = false } - val ins = valOf o #1 $ D.get ops (idx - 1) - val ir = changeDest rd ins + end + + fun changeIns ops idx ins = + let + fun f (SOME _, v) = (ins, v) + | f (NONE, _) = raise Unreachable + in + D.update ops f idx + end - fun f1 (SOME _, v) = (SOME ir, v) - | f1 (NONE, _) = raise Unreachable - fun f2 (SOME _, v) = (NONE, v) - | f2 (NONE, _) = raise Unreachable + fun changeEl from to (x :: xs) acc = + changeEl from to xs $ (if x = from then to else x) :: acc + | changeEl _ _ [] acc = rev acc - val () = D.update ops f1 (idx - 1) - val () = D.update ops f2 idx + fun changeDef vregs vr from to = + let + val { defs, use, class, t, canFold } = D.get vregs vr + in + D.set vregs vr { defs = changeEl from to defs [], use, class, t, + canFold } + end - val { defs, use, class, t, canFold } = D.get vregs rd + fun changeUse vregs vr from to = + let + val { defs, use, class, t, canFold } = D.get vregs vr + in + D.set vregs vr { defs, use = changeEl from to use [], class, t, + canFold } + end - 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, canFold } + fun singleDefUse vregs vr = + let + val { defs, use, ... } = D.get vregs vr in - () + case (defs, use) of + ([d], [_]) => SOME d + | _ => NONE end - fun optSet (C as Lctx { vregs, localVars, paramNum, ... }) + fun fuseSet (Lctx { vregs, localVars, paramNum, ops, ... }) (idx, (SOME (IrSet (rd, SaVReg rs)), _)) = if getCS vregs rd <> getCS vregs rs then () - else - let - val { defs, use, ... } = D.get vregs rs - in - case (defs, use) of - ([d], [_]) => - if d = idx - 1 andalso rs >= Vector.length localVars + paramNum - then - mergeIns C idx rd rs - else - () - | _ => () - end - | optSet _ _ = () + else ( + case singleDefUse vregs rs of + NONE => () + | SOME d => ( + if d = idx - 1 andalso rs >= Vector.length localVars + paramNum + then + let + val () = dprintf `"fusing instruction " I d `" with " I idx % + val () = removeVR vregs rs - fun peephole (C as Lctx { ops, ... }) = - let - val () = D.appi (optSet C) ops - in - () - end + val ins = valOf o #1 $ D.get ops (idx - 1) + val ir = changeDest rd ins + + val () = changeIns ops (idx - 1) (SOME ir) + val () = changeIns ops idx NONE + in + changeDef vregs rd idx (idx - 1) + end + else + () + ) + ) + | fuseSet _ _ = () + + fun convCmpOp op' false = op' + | convCmpOp op' true = + case op' of + Cmpeq => Cmpneq + | Cmpneq => Cmpeq + | Cmpul => Cmpuge + | Cmpug => Cmpule + | Cmpule => Cmpug + | Cmpuge => Cmpul + | Cmpsl => Cmpsge + | Cmpsg => Cmpsle + | Cmpsle => Cmpsg + | Cmpsge => Cmpsl + + fun fuseJmpCommon (Lctx { ops, vregs, ... }) idx rs lid isRev = + case singleDefUse vregs rs of + NONE => () + | SOME d => ( + case #1 $ D.get ops d of + SOME (IrCmp (op', _, r1, r2)) => + let + val () = dprintf `"fusing instruction " I d `" with " I idx % + val () = removeVR vregs rs + val () = changeUse vregs r1 d idx + val () = changeUse vregs r2 d idx + val ins = IrJmpc (convCmpOp op' isRev, r1, r2, lid) + in + changeIns ops d NONE; + changeIns ops idx (SOME ins) + end + | _ => () + ) + + fun fuseJmpc C (idx, (ins, _)) = + case ins of + SOME (IrJnz (rs, lid)) => fuseJmpCommon C idx rs lid false + | SOME (IrJz (rs, lid)) => fuseJmpCommon C idx rs lid true + | _ => () + + fun lowerMul C (idx, (ins, _)) = raise Unimplemented + + fun peephole (C as Lctx { ops, ... }) = ( + D.appi (fuseSet C) ops; + D.appi (fuseJmpc C) ops; + D.appi (lowerMul C) ops + ) fun removeUnusedLabels (Lctx { ops, labels, ... }) = let |