diff options
| -rw-r--r-- | emit.fun | 545 | ||||
| -rw-r--r-- | il.fun | 196 | ||||
| -rw-r--r-- | il.sig | 21 | ||||
| -rw-r--r-- | parser.fun | 15 |
4 files changed, 562 insertions, 215 deletions
@@ -34,14 +34,15 @@ functor Emit(I: IL) = struct (R14, 10), (R15, 11), - (Rax, 12), - (Rdx, 13), + (Rdx, 12), + + (Rax, 13), (Rsp, 14), (Rbp, 15) ] val callerSavedRegs = 7 - val usedRegNum = 12 + val usedRegNum = 12 (* rdx is not counted *) fun reg2idx reg = case List.find (fn (r, _) => r = reg) regs of @@ -148,10 +149,31 @@ functor Emit(I: IL) = struct fun handleStrlits strlits = let - fun f id = fprint `".S" I id `":\tdb " `(PP.?? id) `", 0\n" % + fun emitStrlit id = + let + val () = fprint `".S" I id `":\t" % + val symbols = PP.T.strlit2charList (PP.?? id) + + fun pc c out = + if Char.isPrint c andalso not (Char.isSpace c) then + Printf out `"'" C c `"'" % + else + Printf out I (ord c) % + + fun outputStrlit (c :: []) = fprint A1 pc c % + | outputStrlit [] = raise Unreachable + | outputStrlit (c :: cs) = ( + fprint A1 pc c `", " %; + outputStrlit cs + ) + + in + fprint `"db " %; + outputStrlit symbols + end in fprint `"\n" %; - List.app f strlits + List.app emitStrlit strlits end fun handleLocalIniLayouts () = @@ -304,16 +326,8 @@ functor Emit(I: IL) = struct | I.IrAnd t => tr t | I.IrOr t => tr t | I.IrXor t => tr t - | I.IrEq t => tr t - | I.IrNeq t => tr t - | I.IrCmpul t => tr t - | I.IrCmpug t => tr t - | I.IrCmpule t => tr t - | I.IrCmpuge t => tr t - | I.IrCmpsl t => tr t - | I.IrCmpsg t => tr t - | I.IrCmpsle t => tr t - | I.IrCmpsge t => tr t + + | I.IrCmp (_, _, _, _) => IaNone | I.IrExtZero _ | I.IrExtSign _ | I.IrLoad _ | I.IrStore _ | I.IrJmp _ @@ -510,11 +524,12 @@ functor Emit(I: IL) = struct FRU.makeUpdate5 (from, from, to) i end z - fun returnToPool pool reg = + fun returnToPool (_, rdxRef) Rdx = rdxRef := NONE + | returnToPool (arr, _) reg = let val idx = reg2idx reg in - Array.update (pool, idx, NONE) + Array.update (arr, idx, NONE) end fun expireOne { rinfo, active, pool, ... } (_, start, _) = @@ -563,21 +578,29 @@ functor Emit(I: IL) = struct Array.update (arr, idx, (aff, reg)) end + fun getUser (_, rdxRef) Rdx = !rdxRef + | getUser (arr, _) r = Array.sub (arr, reg2idx r) + + fun setUser (_, rdxRef) u Rdx: unit = rdxRef := SOME u + | setUser (arr, _) u r = Array.update(arr, reg2idx r, SOME u) + fun assignFirstReg poff { rinfo, pool, ... } vr = let + val regArr = #1 pool + fun loop idx = - if idx = Array.length pool then + if idx = Array.length regArr then raise Unreachable else let - val user = Array.sub (pool, idx) + val user = Array.sub (regArr, idx) in case user of SOME _ => loop (idx + 1) | NONE => let - val () = Array.update (pool, idx, SOME vr); val reg = idx2reg idx + val () = setUser pool vr reg val () = printfn R poff `"assigned (first) reg " Preg reg `" to %" ip vr % @@ -589,7 +612,7 @@ functor Emit(I: IL) = struct loop 0 end - fun freeRegList pool = + fun freeRegList (pool, _) = let fun loop idx acc = if idx = Array.length pool then @@ -633,7 +656,7 @@ functor Emit(I: IL) = struct intersection l1 l2 end - fun assignSoftReg poff affs (I as { rinfo, pool, ... }) vr = + fun assignSoftReg poff affs (I as { rinfo, pool, ... }) vr = let val () = printfn R poff `"trying to assign register (by affinity) to %" ip vr % @@ -658,7 +681,8 @@ functor Emit(I: IL) = struct let in updReg rinfo vr (VtReg reg); - Array.update (pool, reg2idx reg, SOME vr); + setUser pool vr reg; + printfn R (poff + 1) `"assigned (by affinity) reg " Preg reg `" to %" ip vr %; printfn R (poff + 1) @@ -681,14 +705,13 @@ functor Emit(I: IL) = struct val () = printfn R poff `"trying to assign hard reg " A1 preg reg `" to %" ip vr % - val regIdx = reg2idx reg - val user = Array.sub (pool, regIdx) + val user = getUser pool reg fun setOurReg () = let val () = printfn R (poff + 1) `"reg assigned" % in - Array.update (pool, regIdx, SOME vr); + setUser pool vr reg; updReg rinfo vr (VtReg reg) end in @@ -696,6 +719,8 @@ functor Emit(I: IL) = struct NONE => setOurReg () | SOME u => let + val () = if reg = Rdx then raise Unreachable else () + val () = printfn R (poff + 1) `"reg is taken by %" ip u % val (aff, _) = Array.sub (rinfo, u) in @@ -718,7 +743,8 @@ functor Emit(I: IL) = struct | AfHard reg => assignHardReg 0 I vr reg end - fun getPool () = Array.array (usedRegNum, NONE) + (* Ref is for Rdx *) + fun getPool () = (Array.array (usedRegNum, NONE), ref NONE) fun changeInActive active newInt oldVr = let @@ -728,10 +754,13 @@ functor Emit(I: IL) = struct active := addToActive newInt a end - fun expropriateReg (I as { rinfo, pool, active, ... }) int reg = + fun expropriateReg (I as { rinfo, pool = (pool, _), active, ... }) + int reg = let val vr = #1 int + val () = if reg = Rdx then raise Unreachable else () + val regIdx = reg2idx reg val u = valOf $ Array.sub (pool, regIdx) @@ -748,13 +777,19 @@ functor Emit(I: IL) = struct changeInActive active int u end - fun userIdx pool vr = + fun userIdx (arr, rdxRef) vr = let + val () = + if !rdxRef = SOME vr then + raise Unreachable + else + () + fun loop idx = - if idx = Array.length pool then + if idx = Array.length arr then raise Unreachable else - case Array.sub (pool, idx) of + case Array.sub (arr, idx) of SOME u => if u = vr then idx @@ -788,9 +823,10 @@ functor Emit(I: IL) = struct let val idx = userIdx pool (#1 spill) val () = printfn `"spilling!!!" % + val reg = idx2reg idx in - Array.update (pool, idx, SOME vr); - updReg rinfo vr (VtReg $ idx2reg idx); + setUser pool vr reg; + updReg rinfo vr (VtReg reg); putToStack 1 I (#1 spill); changeInActive active int (#1 spill) end @@ -798,6 +834,23 @@ functor Emit(I: IL) = struct putToStack 0 I vr end + fun haveRoomForVR { rinfo, active, pool = (_, rdxRef), ... } vr = + if length (!active) < usedRegNum then + true + else + let + val (aff, _) = Array.sub (rinfo, vr) + in + case aff of + AfHard Rdx => + if isSome (!rdxRef) then + raise Unreachable + else + true + | _ => false + end + + fun linearscan rinfo ints stackOff = let fun incStart ((_, start1, _), (_, start2, _)) = start1 <= start2 @@ -814,14 +867,14 @@ functor Emit(I: IL) = struct val () = expireOld I int val () = - if length (!active) = usedRegNum then - spillAtInterval I int - else + if haveRoomForVR I (#1 int) then let val () = assignReg I int in active := addToActive int (!active) end + else + spillAtInterval I int in loop I ints end @@ -841,6 +894,37 @@ functor Emit(I: IL) = struct | VtConst _ | VtUnk => raise Unreachable end + fun pr is8 reg out = + let + fun old s = + let + val s = if is8 then s else "e" ^ String.extract (s, 1, NONE) + in + Printf out `s % + end + + fun new s = Printf out `(if is8 then s else s ^ "d") % + in + case reg of + Rcx => old "rcx" + | Rsi => old "rsi" + | Rdi => old "rdi" + | R8 => new "r8" + | R9 => new "r9" + | R10 => new "r10" + | R11 => new "r11" + + | Rbx => old "rbx" + | R12 => new "r12" + | R13 => new "r13" + | R14 => new "r14" + | R15 => new "r15" + + | Rax => old "rax" + | Rdx => old "rdx" + | Rsp => old "rsp" + | Rbp => old "rbp" + end fun printAlloced rinfo toAlloc = let val () = printfn `"\nallocated:\n" % @@ -850,7 +934,7 @@ functor Emit(I: IL) = struct fun getUsedRegs rinfo = let - val regs = Array.array (usedRegNum, false) + val regs = Array.array (usedRegNum + 1, false) fun loop idx = if idx = Array.length rinfo then @@ -860,7 +944,10 @@ functor Emit(I: IL) = struct val (_, vt) = Array.sub (rinfo, idx) in case vt of - VtReg reg => Array.update (regs, reg2idx reg, true) + VtReg reg => ( + printfn `"reg: " A2 pr true reg %; + Array.update (regs, reg2idx reg, true) + ) | _ => (); loop (idx + 1) end @@ -971,7 +1058,10 @@ functor Emit(I: IL) = struct let val () = printfn `"alloca size: " W size % val () = - if Word.mod (size, 0w8) <> 0w0 then raise Unreachable else () + if Word.mod (size, 0w8) <> 0w0 then + raise Unreachable + else + () val stackOffset = stackOffset - Word.toInt size val negOffset = ~stackOffset @@ -1009,64 +1099,31 @@ functor Emit(I: IL) = struct rinfo = regInfo, vregs } end - fun emitPushReg reg = fprinttn `"push " Preg reg % + fun emitPushPopReg op' reg = fprinttn `op' `" " Preg reg % fun emitPrologue ({ stackOffset, regsToSave, ... }) name = let val () = fprint PP.? name `":\n" % in + List.app (emitPushPopReg "push") regsToSave; if stackOffset <> 0 then ( fprinttn `"push rbp" %; fprinttn `"mov rbp, rsp" %; fprinttn `"sub rsp, " I (~ stackOffset) % ) else - (); - List.app emitPushReg regsToSave + () end - fun emitEpilogue { regsToSave, stackOffset, ... } = - let - val () = List.app emitPushReg (rev regsToSave) - in + fun emitEpilogue { regsToSave, stackOffset, ... } = ( if stackOffset <> 0 then ( fprinttn `"mov rsp, rbp" %; fprinttn `"pop rbp" % ) else (); + List.app (emitPushPopReg "pop") (rev regsToSave); fprinttn `"ret" % - end - - fun pr is8 reg out = - let - fun old s = - let - val s = if is8 then s else "e" ^ String.extract (s, 1, NONE) - in - Printf out `s % - end - - fun new s = Printf out `(if is8 then s else s ^ "d") % - in - case reg of - Rcx => old "rcx" - | Rsi => old "rsi" - | Rdi => old "rdi" - | R8 => new "r8" - | R9 => new "r9" - | R10 => new "r10" - | R11 => new "r11" - - | Rbx => old "rbx" - | R12 => new "r12" - | R13 => new "r13" - | R14 => new "r14" - | R15 => new "r15" + ) - | Rax => old "rax" - | Rdx => old "rdx" - | Rsp => old "rsp" - | Rbp => old "rbp" - end fun pm is8 off out = Printf out `(if is8 then "qword" else "dword") `" [rbp-" I off `"]"% @@ -1111,8 +1168,21 @@ functor Emit(I: IL) = struct if is8 then Printf out W w % else - Printf out W (P.extz w 0w32) % - | VAddrConst (id, w) => Printf out PP.? id I.Pwc I.VR8 w % + Printf out W (P.extz w 0w4) % + | VAddrConst (id, w) => + let + val repr = PP.?? id + val repr = + if String.sub (repr, 0) = #"\"" then + ".S" ^ Int.toString id + else + repr + in + if w = 0w0 then + Printf out `repr % + else + Printf out `repr I.Pwc I.VR8 w % + end fun wordFitsInNsx N w = let @@ -1309,7 +1379,7 @@ functor Emit(I: IL) = struct [ movRV Rax c, opRR r Rax ] end - fun truncConst (VConst w) N = VConst $ P.extz w (Word.fromInt N) + fun truncConst (VConst w) N = VConst $ P.extz w N | truncConst (C as (VAddrConst _)) _ = C fun emitShift I op' triple = @@ -1325,9 +1395,9 @@ functor Emit(I: IL) = struct sprintf `op' `"x " Pr r1 `", " Pr r2 `", " Pr r3 % fun shift3m r1 off r2 = - sprintf `op' `" x" Pr r1 `", " A2 pm is8 off `", " Pr r2 % + sprintf `op' `"x " Pr r1 `", " A2 pm is8 off `", " Pr r2 % - fun t v = truncConst v 8 + fun t v = truncConst v 0w1 in case tmp of RRR (r1, r2, r3) => [shift3 r1 r2 r3] @@ -1336,7 +1406,7 @@ functor Emit(I: IL) = struct | RMR (r1, off, r2) => [shift3m r1 off r2] | RMM (r1, off1, off2) => [movRM Rax off1, movRM Rdx off2, shift3 r1 Rax Rdx] - | RMV (r, off, v) => [movRM r off, opRV r (truncConst v 8)] + | RMV (r, off, v) => [movRM r off, opRV r (t v)] | RVR (r1, v, r2) => [movRV Rax v, shift3 r1 Rax r2] | RVM (r, v, off) => [movRV Rax v, movRM Rdx off, shift3 r Rax Rdx] | MRR (off, r1, r2) => [shift3 Rax r1 r2, movMR off Rax] @@ -1401,10 +1471,10 @@ functor Emit(I: IL) = struct else [movRM r1 off, movRV Rax v, opRR r1 Rax] | RVR (r1, v, r2) => - (printfn `"HERE" %; if r1 = r2 andalso isZeroConst v then - [sprintf `"neg " A2 pr is8 r1 %] - else - [movRV r1 v, opRR r1 r2]) + if r1 = r2 andalso isZeroConst v then + [sprintf `"neg " A2 pr is8 r1 %] + else + [movRV r1 v, opRR r1 r2] | RVM (r, v, off) => [movRV r v, opRM r off] | MRR (off, r1, r2) => [movRR Rax r1, opRR Rax r2, movMR off Rax] | MRM (off1, r, off2) => [opRM r off2, movMR off1 r] @@ -1463,7 +1533,7 @@ functor Emit(I: IL) = struct else () - fun emitGenConstraint I (rd, rs1, rs2) op' resInReg = + fun emitDivMod I (rd, rs1, rs2) op' resInReg signExtend = let val (is81, t1) = getType I rd val (is82, t2) = getType I rs1 @@ -1478,12 +1548,22 @@ functor Emit(I: IL) = struct | (_, _) => raise Unreachable in [ + if signExtend then + if is81 then "cqo" else "cdq" + else + "xor edx, edx", mov is81 (VtReg Rax) first, sprintf `op' `" " A2 prm is81 second %, mov is81 t1 (VtReg resInReg) ] end + fun moveBackIfNeeded is8 dest vt = + if dest = Rax then + [mov is8 vt (VtReg Rax)] + else + [] + fun emitIMul I (vd, vs1, vs2) = let val (is81, t1) = getType I vd @@ -1499,12 +1579,6 @@ functor Emit(I: IL) = struct VtReg r => r | _ => Rax - fun moveBackIfNeeded dest = - if dest = Rax then - [mov is81 t1 (VtReg Rax)] - else - [] - fun op2 () = let val form = @@ -1525,7 +1599,7 @@ functor Emit(I: IL) = struct sprintf `"imul " A2 pr is81 dest `", " A2 prm is81 rs2 % ] in - main @ moveBackIfNeeded dest + main @ moveBackIfNeeded is81 dest t1 end fun op3 rs1 c = @@ -1537,7 +1611,7 @@ functor Emit(I: IL) = struct [sprintf `"imul " A2 pr is81 dest `", " A2 prm is81 rs1 `", " A2 pc is81 c %] in - main @ moveBackIfNeeded dest + main @ moveBackIfNeeded is81 dest t1 end else op2 () @@ -1548,6 +1622,183 @@ functor Emit(I: IL) = struct | _ => op2 () end + fun regByAc ac r = + let + fun get16bitName r = + let + val repr = sprintf A2 pr false r % + in + if String.sub (repr, 0) = #"r" then + repr ^ "w" + else + String.extract (repr, 1, NONE) + end + + fun get8bitName r = + let + val repr = sprintf A2 pr false r % + in + if String.sub (repr, 0) = #"r" then + let + val len = size repr + in + String.substring (repr, 0, len - 1) ^ "b" + end + else + case r of + Rbx => "bl" + | Rcx => "cl" + | Rsi => "sil" + | Rdi => "dil" + | R8 | R9 | R10 | R11 | R12 | R13 | R14 | R15 + | Rbp | Rsp | Rax | Rdx => raise Unreachable + end + in + case ac of + I.AC8 => sprintf A2 pr true r % + | I.AC4 => sprintf A2 pr false r % + | I.AC2 => get16bitName r + | I.AC1 => get8bitName r + end + + fun pByAc ac vt out = + case vt of + VtReg r => Printf out `(regByAc ac r) % + | VtStack off => Printf out I.Pac ac `" [rbp-" I off `"]" % + | _ => raise Unreachable + + fun emitLoad I (vd, vs, ac) = + let + val (_, tl) = getType I vd + val (_, tr) = getType I vs + + val (pre, src) = + case tr of + VtReg r => ([], r) + | _ => ([mov true (VtReg Rdx) tr], Rdx) + + val dest = + case tl of + VtReg r => r + | _ => Rax + + val main = + [ + sprintf `"mov " `(regByAc ac dest) `", " + I.Pac ac `" [" A2 pr true src `"]" % + ] + in + pre @ main @ moveBackIfNeeded true dest tl + end + + fun emitStore I (vd, vs, ac) = + let + val (_, tl) = getType I vd + val (_, tr) = getType I vs + val (pre, src) = + case tr of + VtReg r => ([], VtReg r) + | VtConst c => + if fitsInNsx 32 c then + ([], VtConst c) + else + ([mov true (VtReg Rdx) tr], VtReg Rdx) + | _ => ([mov true (VtReg Rdx) tr], VtReg Rdx) + + + val (mid, dest) = + case tl of + VtReg r => ([], r) + | _ => ([mov true (VtReg Rax) tl], Rax) + + fun p vt out = + case vt of + VtReg reg => Printf out `(regByAc ac reg) % + | VtConst c => Printf out A2 pc true c % + | _ => raise Unreachable + + val main = + [ sprintf `"mov " I.Pac ac `" [" A2 pr true dest `"], " A1 p src % ] + in + pre @ mid @ main + end + + fun emitCmp E (cmpop, rd, rs1, rs2) = + let + val (_, td) = getType E rd + val (is82, ts1) = getType E rs1 + val (is83, ts2) = getType E rs2 + + val () = if is82 <> is83 then raise Unreachable else () + + fun RMwithImm vt c = + sprintf `"cmp " A2 prm is82 vt `", " A2 pc is82 c % + + fun RMwithR vt r = + sprintf `"cmp " A2 prm is82 vt `", " A2 pr is82 r % + + fun RwithRM r vt = sprintf `"cmp " A2 pr is82 r `", " A2 prm is82 vt % + + val zeroing = sprintf `"xor " A2 pr false Rax `", " A2 pr false Rax % + + val (pre, main) = + case (ts1, ts2) of + (VtReg _ | VtStack _, VtConst c) => + if fitsInNsx 32 c then + ([], RMwithImm ts1 c) + else + ([movRV is82 Rax c], RMwithR ts1 Rax) + | (VtReg _ | VtStack _, VtReg r) => ([], RMwithR ts1 r) + | (VtReg r, VtStack _) => ([], RwithRM r ts2) + + | (VtConst c, _) => ([movRV is82 Rax c], RwithRM Rax ts2) + | (VtStack off, VtStack _) => ([movRM is82 Rax off], RwithRM Rax ts2) + | (VtUnk, _) | (_, VtUnk) => raise Unreachable + + val flags = + case cmpop of + I.Cmpeq => "e" + | I.Cmpneq => "ne" + | I.Cmpul => "b" + | I.Cmpug => "a" + | I.Cmpule => "be" + | I.Cmpuge => "ae" + | I.Cmpsl => "l" + | I.Cmpsg => "g" + | I.Cmpsle => "le" + | I.Cmpsge => "ge" + + val setPart = sprintf `"set" `flags `" al" % + in + [zeroing] @ pre @ [main] @ [setPart] @ [mov true td (VtReg Rax)] + end + + fun emitExt E (vd, vs, from) op' = + let + val (is81, td) = getType E vd + val (_, ts) = getType E vs + + val to = if is81 then I.AC8 else I.AC4 + val dest = + case td of + VtReg r => r + | _ => Rax + + fun ext () = + sprintf `op' `" " A2 pr is81 dest `", " A2 pByAc from ts % + val main = + case (to, from) of + (I.AC4, I.AC1) | (I.AC4, I.AC2) => ext () + | (I.AC8, I.AC1) | (I.AC8, I.AC2) | (I.AC8, I.AC4) => ext () + + | (I.AC4, I.AC4) | (I.AC4, I.AC8) => raise Unreachable + | (I.AC8, I.AC8) => raise Unreachable + + | (I.AC1, _) | (I.AC2, _) => raise Unreachable + in + [main] @ moveBackIfNeeded is81 dest td + end + fun emitSet I (vrd, I.SaVReg vrs) = let val (is81, t1) = getType I vrd @@ -1563,7 +1814,7 @@ functor Emit(I: IL) = struct [movRR true r1 r2] | (true, VtReg r1, false, VtReg r2) => [movRR false r1 r2] - | (_, VtReg r1, _, VtConst c) => [movRV true r1 c] + | (_, VtReg r1, _, VtConst c) => [movRV true r1 c] | (_, VtReg r1, _, VtStack off) => [movRM true r1 off] | (_, VtStack off, _, VtReg r) => [movMR true off r] | (_, VtStack off1, _, VtStack off2) => @@ -1686,6 +1937,84 @@ functor Emit(I: IL) = struct | VtUnk => raise Unreachable end + fun getRegsWeSave map idx = + let + val row = Array.sub (map, idx) + + fun loop j acc = + if j = callerSavedRegs then + rev acc + else + case Array.sub (row, j) of + NONE => loop (j + 1) acc + | SOME _ => loop (j + 1) (idx2reg j :: acc) + in + loop 0 [] + end + + fun prepFuncPrologue ({ stackOffset, regsToSave, regMap, ... }) idx = + let + val offFromCall = 8 + 8 * length regsToSave + val offFromCall = + if (stackOffset <> 0) then + offFromCall + 8 (* push rbp *) + else + offFromCall + val offFromCall = offFromCall + ~ stackOffset + + fun pushRegs regs = map (fn r => sprintf `"push " A2 pr true r %) regs + val regsWeSave = getRegsWeSave regMap idx + + val registerPush: string list = pushRegs regsWeSave + val offFromCall = offFromCall + 8 * length regsWeSave + + val tail = + if offFromCall mod 16 <> 0 then + [sprintf `"sub rsp, 8" %] + else + [] + in + (not $ null tail, regsWeSave, registerPush @ tail) + end + + fun emitFcall E (rd, rf, _) idx = + let + val (shouldAdd, regsToRestore, prologueSeq) = prepFuncPrologue E idx + val (_, tf) = getType E rf + + val fcall = + case tf of + VtConst (C as VAddrConst _) => [sprintf `"call " A2 pc true C %] + | VtConst (VConst _) => [mov true (VtReg Rax) tf, sprintf `"call rax" %] + | VtReg _ | VtStack _ => [sprintf `"call " A2 prm true tf %] + | VtUnk => raise Unreachable + + val regRestoration = + let + val pre = + if shouldAdd then + [sprintf `"add rsp, 8" %] + else + [] + val restoration = + map (fn r => sprintf `"pop " A2 pr true r %) (rev regsToRestore) + + in + pre @ restoration + end + val assignRes = + if rd = ~1 then + [] + else + let + val (is8, t) = getType E rd + in + [mov is8 t (VtReg Rax)] + end + in + prologueSeq @ fcall @ regRestoration @ assignRes + end + fun emitOpStrList ins E idx = case ins of I.IrSet p => emitSet E p @@ -1702,15 +2031,25 @@ functor Emit(I: IL) = struct | I.IrMul t => emitIMul E t | I.IrIMul t => emitIMul E t - | I.IrDiv t => emitGenConstraint E t "div" Rax - | I.IrIDiv t => emitGenConstraint E t "idiv" Rax - | I.IrMod t => emitGenConstraint E t "div" Rdx - | I.IrIMod t => emitGenConstraint E t "idiv" Rdx + | I.IrDiv t => emitDivMod E t "div" Rax false + | I.IrIDiv t => emitDivMod E t "idiv" Rax true + | I.IrMod t => emitDivMod E t "div" Rdx false + | I.IrIMod t => emitDivMod E t "idiv" Rdx true + + | I.IrCmp q => emitCmp E q + + | I.IrLoad t => emitLoad E t + | I.IrStore t => emitStore E t + + | I.IrExtZero t => emitExt E t "movzx" + | I.IrExtSign t => emitExt E t "movsx" + + | I.IrFcall t => emitFcall E t idx | I.IrAlloc t => emitAlloc E t | I.IrRet vr => emitRet E vr idx | I.IrCopy t => emitCopy E t - | I.IrNopLabel lid => [ sprintf `".L" I lid % ] + | I.IrNopLabel lid => [ sprintf `".L" I lid `":" % ] | I.IrJmp lid => [ jmp lid ] | I.IrJz p => emitJz E p true | I.IrJnz p => emitJz E p false @@ -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 @@ -14,6 +14,11 @@ signature IL = sig 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 @@ signature IL = sig | 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,10 +67,12 @@ signature IL = sig class: vregClass, use: int list, defs: int list, - t: regType + t: regType, + canFold: bool } val Pwc: (vregClass, word, 'a, 'b, 'c) a2printer + val Pac: (accessClass, 'a, 'b, 'c) a1printer datatype funcInfo = Fi of { name: int, @@ -1993,10 +1993,10 @@ functor Parser(structure Tree: TREE; structure P: PPC; and extz w fromSize = let - val minus1 = Word64.notb (Word64.fromInt 0) - val mask = Word64.>> (minus1, 0w64 - fromSize * 0w8) + open Word + val mask = >> (~ 0w1, 0w64 - fromSize * 0w8) - val res = Word64.andb (mask, w) + val res = andb (mask, w) in res end @@ -3253,16 +3253,9 @@ functor Parser(structure Tree: TREE; structure P: PPC; ) end - fun makeDivBy8 v = - let - open Word - in - (v + 0w7) div 0w8 * 0w8 - end - fun registerLayout layout t toplev = let - val size = makeDivBy8 $ sizeOfType t + val size = sizeOfType t in D.pushAndGetId iniLayouts (toplev, size, layout) end |