CVS: sml-dist/src/MLRISC/amd64/instructions amd64-leaf-opt.sml, NONE, 1.1 amd64Cells.sml, NONE, 1.1 amd64Cells.sml.old, NONE, 1.1 amd64FreqProps.sml, NONE, 1.1 amd64Instr.sml, NONE, 1.1 amd64MemRegs.sig, NONE, 1.1 amd64Peephole.peep, NONE, 1.1 amd64Peephole.sml, NONE, 1.1 amd64Props.sml, NONE, 1.1 amd64Shuffle.sig, NONE, 1.1 amd64Shuffle.sml, NONE, 1.1 amd64comp-instr-ext.sml, NONE, 1.1 amd64instr-ext.sml, NONE, 1.1
Matthias Blume <[email protected]> Thu, 05 Oct 2006 08:09:18 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/MLRISC/amd64/instructions
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv621/amd64/instructions
Added Files:
amd64-leaf-opt.sml amd64Cells.sml amd64Cells.sml.old
amd64FreqProps.sml amd64Instr.sml amd64MemRegs.sig
amd64Peephole.peep amd64Peephole.sml amd64Props.sml
amd64Shuffle.sig amd64Shuffle.sml amd64comp-instr-ext.sml
amd64instr-ext.sml
Log Message:
added AMD64 stuff to MLRISC tree
--- NEW FILE: amd64-leaf-opt.sml ---
(* Stolen from John Reppy's Moby compiler:
*
* x86-leaf-opt.sml
*
* COPYRIGHT (c) 2001 Bell Labs, Lucent Technologies
*
* Optimization of leaf procedures for the IA32. We define a leaf procedure
* to be one that does not make calls and does not allocate any extra stack
* space (other than the usual linkage). We optimize by removing the saved
* frame-pointer and rewriting instructions that use the frame-pointer to
* ones that use the stack pointer.
*
* Eventually, we may support tail calls from leaf procedures.
*
*)
functor X86LeafOpt
(structure X86Instr : X86INSTR
structure FlowGraph : FLOWGRAPH where I = X86Instr
val isLeaf : FlowGraph.cluster -> bool
) : CLUSTER_OPTIMIZATION =
struct
structure F = FlowGraph
structure I = X86Instr
structure C = I.C
type flowgraph = F.cluster
val name = "X86LeafOpt"
(* is a register the frame pointer? *)
fun isFP reg = C.sameColor(reg, C.ebp)
(* is a register the stack pointer? *)
fun isSP reg = C.sameColor(reg, C.esp)
fun error msg = MLRiscErrorMsg.error("X86LeafOpt",msg)
fun err (blknum, msg) = error(concat[
"BLOCK ", Int.toString blknum, ": ", msg
])
fun optimize (F.CLUSTER cluster) = let
fun rewriteOpnd (opnd as I.Displace{base, disp, mem}) =
if (isFP base)
then (case disp
of I.Immed n =>
I.Displace{base = C.esp, disp = I.Immed(n-4), mem = mem}
| _ => error "unable to rewrite displacement operand"
(* end case *))
else opnd
| rewriteOpnd (opnd as I.Indexed{base=SOME r, index, scale, disp, mem}) =
if (isFP r)
then (case disp
of I.Immed n => I.Indexed{
base = SOME C.esp, index = index, scale = scale,
disp = I.Immed(n-4), mem = mem
}
| _ => error "unable to rewrite indexed operand"
(* end case *))
else opnd
| rewriteOpnd opnd = opnd
fun rewriteInsn insn = (case insn
of I.JMP(opnd, labs) => I.JMP(rewriteOpnd opnd, labs)
| I.JCC{cond, opnd} => I.JCC{cond = cond, opnd = rewriteOpnd opnd}
| I.CALL _ => error "unexpected call"
| I.MOVE{mvOp, src, dst} => I.MOVE{
mvOp = mvOp,
src = rewriteOpnd src,
dst = rewriteOpnd dst
}
| I.LEA{r32, addr} => I.LEA{r32 = r32, addr = rewriteOpnd addr}
| I.CMPL{lsrc, rsrc} =>
I.CMPL{lsrc = rewriteOpnd lsrc, rsrc = rewriteOpnd rsrc}
| I.CMPW{lsrc, rsrc} =>
I.CMPW{lsrc = rewriteOpnd lsrc, rsrc = rewriteOpnd rsrc}
| I.CMPB{lsrc, rsrc} =>
I.CMPB{lsrc = rewriteOpnd lsrc, rsrc = rewriteOpnd rsrc}
| I.TESTL{lsrc, rsrc} =>
I.TESTL{lsrc = rewriteOpnd lsrc, rsrc = rewriteOpnd rsrc}
| I.TESTW{lsrc, rsrc} =>
I.TESTW{lsrc = rewriteOpnd lsrc, rsrc = rewriteOpnd rsrc}
| I.TESTB{lsrc, rsrc} =>
I.TESTB{lsrc = rewriteOpnd lsrc, rsrc = rewriteOpnd rsrc}
| I.BITOP{bitOp, lsrc, rsrc} => I.BITOP{
bitOp = bitOp,
lsrc = rewriteOpnd lsrc,
rsrc = rewriteOpnd rsrc
}
| I.BINARY{binOp, src, dst} => I.BINARY{
binOp = binOp,
src = rewriteOpnd src,
dst = rewriteOpnd dst
}
| I.MULTDIV{multDivOp, src} => I.MULTDIV{
multDivOp = multDivOp, src = rewriteOpnd src
}
| I.MUL3{dst, src2, src1} => I.MUL3{
dst = dst, src2 = src2, src1 = rewriteOpnd src1
}
| I.UNARY{unOp, opnd} =>
I.UNARY{unOp = unOp, opnd = rewriteOpnd opnd}
| I.SET{cond, opnd} => I.SET{cond = cond, opnd = rewriteOpnd opnd}
| I.CMOV{cond, src, dst} => I.CMOV{
cond = cond, src = rewriteOpnd src, dst = dst
}
| I.PUSHL _ => error "unexpected pushl"
| I.PUSHW _ => error "unexpected pushw"
| I.PUSHB _ => error "unexpected pushb"
| I.POP _ => error "unexpected popl"
| I.COPY _ => error "unexpected copy"
| I.FCOPY _ => error "unexpected fcopy"
| I.FBINARY{binOp, src, dst} => I.FBINARY{
binOp = binOp, src = rewriteOpnd src, dst = rewriteOpnd dst
}
| I.FIBINARY{binOp, src} => I.FIBINARY{
binOp = binOp, src = rewriteOpnd src
}
| I.FUCOM opnd => I.FUCOM(rewriteOpnd opnd)
| I.FUCOMP opnd => I.FUCOMP(rewriteOpnd opnd)
| I.FSTPL opnd => I.FSTPL(rewriteOpnd opnd)
| I.FSTPS opnd => I.FSTPS(rewriteOpnd opnd)
| I.FSTPT opnd => I.FSTPT(rewriteOpnd opnd)
| I.FSTL opnd => I.FSTL(rewriteOpnd opnd)
| I.FSTS opnd => I.FSTS(rewriteOpnd opnd)
| I.FLDL opnd => I.FLDL(rewriteOpnd opnd)
| I.FLDS opnd => I.FLDS(rewriteOpnd opnd)
| I.FLDT opnd => I.FLDT(rewriteOpnd opnd)
| I.FILD opnd => I.FILD(rewriteOpnd opnd)
| I.FILDL opnd => I.FILDL(rewriteOpnd opnd)
| I.FILDLL opnd => I.FILDLL(rewriteOpnd opnd)
| I.FENV{fenvOp, opnd} =>
I.FENV{fenvOp = fenvOp, opnd = rewriteOpnd opnd}
| I.ANNOTATION{i, a} => I.ANNOTATION{i = rewriteInsn i, a = a}
| _ => insn
(* end case *))
(* rewrite the instructions of a block *)
fun rewriteBlock (F.BBLOCK{insns, ...}) =
insns := List.map rewriteInsn (!insns)
| rewriteBlock _ = ()
(* rewrite the exit protocol of an exit block *)
fun rewriteExit (F.BBLOCK{blknum, insns, ...}, _) = (
case !insns
of (ret as I.RET _)::I.LEAVE::rest =>
insns := ret :: rest
| (I.JMP _ :: _) => () (* non-local control flow *)
| _ => err(blknum,"unable to rewrite exit protocol")
(* end case *))
(* rewrite the entry protocol of an entry block *)
fun rewriteEntry (F.BBLOCK{blknum, insns, ...}, _) = let
fun rewrite [
I.BINARY{binOp=I.SUBL, src=I.ImmedLabel _, dst=I.Direct a},
I.MOVE{mvOp=I.MOVL, src=I.Direct b, dst=I.Direct c},
I.PUSHL(I.Direct d)
] = if ((isSP a) andalso (isSP b)
andalso (isFP c) andalso (isFP d))
then []
else err(blknum, "unable to rewrite entry protocol")
| rewrite (insn::rest) = insn :: rewrite rest
| rewrite [] = err(blknum, "unable to rewrite entry protocol")
in
insns := rewrite(!insns)
end
in
(* first, we rewrite the exit and entry blocks *)
case #exit cluster
of F.EXIT{pred, ...} => List.app rewriteExit (!pred)
(* end case *);
case #entry cluster
of F.ENTRY{succ, ...} => List.app rewriteEntry (!succ)
(* end case *);
(* then rewrite the instructions to use the %esp instead of %ebp *)
List.app rewriteBlock (#blocks cluster)
end
fun run cluster =
(if isLeaf cluster then optimize cluster else (); cluster)
end
--- NEW FILE: amd64Cells.sml ---
(*
* WARNING: This file was automatically generated by MDLGen (v3.0)
* from the machine description file "amd64/amd64.mdl".
* DO NOT EDIT this file directly
*)
signature AMD64CELLS =
sig
include CELLS
val EFLAGS : CellsBasis.cellkind
val FFLAGS : CellsBasis.cellkind
val CELLSET : CellsBasis.cellkind
val showGP : CellsBasis.register_id -> string
val showFP : CellsBasis.register_id -> string
val showCC : CellsBasis.register_id -> string
val showEFLAGS : CellsBasis.register_id -> string
val showFFLAGS : CellsBasis.register_id -> string
val showMEM : CellsBasis.register_id -> string
val showCTRL : CellsBasis.register_id -> string
val showCELLSET : CellsBasis.register_id -> string
val showGPWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showFPWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showCCWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showEFLAGSWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showFFLAGSWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showMEMWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showCTRLWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showCELLSETWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val rax : CellsBasis.cell
val rcx : CellsBasis.cell
val rdx : CellsBasis.cell
val rbx : CellsBasis.cell
val rsp : CellsBasis.cell
val rbp : CellsBasis.cell
val rsi : CellsBasis.cell
val rdi : CellsBasis.cell
val ST : int -> CellsBasis.cell
val ST0 : CellsBasis.cell
val eflags : CellsBasis.cell
val addGP : CellsBasis.cell * cellset -> cellset
val addFP : CellsBasis.cell * cellset -> cellset
val addCC : CellsBasis.cell * cellset -> cellset
val addEFLAGS : CellsBasis.cell * cellset -> cellset
val addFFLAGS : CellsBasis.cell * cellset -> cellset
val addMEM : CellsBasis.cell * cellset -> cellset
val addCTRL : CellsBasis.cell * cellset -> cellset
val addCELLSET : CellsBasis.cell * cellset -> cellset
end
structure AMD64Cells : AMD64CELLS =
struct
exception AMD64Cells
fun error msg = MLRiscErrorMsg.error("AMD64Cells",msg)
open CellsBasis
fun showGPWithSize (r, ty) = (fn (0, 8) => "%al"
| (4, 8) => "%ah"
| (1, 8) => "%cl"
| (5, 8) => "%ch"
| (2, 8) => "%dl"
| (6, 8) => "%dh"
| (3, 8) => "%bl"
| (7, 8) => "%bh"
| (r, 8) => ("%r" ^ (Int.toString r)) ^ "b"
| (0, 16) => "%ax"
| (4, 16) => "%sp"
| (1, 16) => "%cx"
| (5, 16) => "%bp"
| (2, 16) => "%dx"
| (6, 16) => "%si"
| (3, 16) => "%bx"
| (7, 16) => "%di"
| (r, 16) => ("%r" ^ (Int.toString r)) ^ "w"
| (0, 32) => "%eax"
| (4, 32) => "%esp"
| (1, 32) => "%ecx"
| (5, 32) => "%ebp"
| (2, 32) => "%edx"
| (6, 32) => "%esi"
| (3, 32) => "%ebx"
| (7, 32) => "%edi"
| (r, 32) => ("%r" ^ (Int.toString r)) ^ "d"
| (0, 64) => "%rax"
| (4, 64) => "%rsp"
| (1, 64) => "%rcx"
| (5, 64) => "%rbp"
| (2, 64) => "%rdx"
| (6, 64) => "%rsi"
| (3, 64) => "%rbx"
| (7, 64) => "%rdi"
| (r, 64) => "%r" ^ (Int.toString r)
| (r, _) => "%" ^ (Int.toString r)
) (r, ty)
and showFPWithSize (r, ty) = (fn (f, _) => (if (f < 8)
then (("%st(" ^ (Int.toString f)) ^ ")")
else ("%f" ^ (Int.toString f)))
) (r, ty)
and showCCWithSize (r, ty) = (fn _ => "cc"
) (r, ty)
and showEFLAGSWithSize (r, ty) = (fn _ => "$eflags"
) (r, ty)
and showFFLAGSWithSize (r, ty) = (fn _ => "$fflags"
) (r, ty)
and showMEMWithSize (r, ty) = (fn _ => "mem"
) (r, ty)
and showCTRLWithSize (r, ty) = (fn _ => "ctrl"
) (r, ty)
and showCELLSETWithSize (r, ty) = (fn _ => "CELLSET"
) (r, ty)
fun showGP r = showGPWithSize (r, 64)
fun showFP r = showFPWithSize (r, 64)
fun showCC r = showCCWithSize (r, 32)
fun showEFLAGS r = showEFLAGSWithSize (r, 32)
fun showFFLAGS r = showFFLAGSWithSize (r, 32)
fun showMEM r = showMEMWithSize (r, 8)
fun showCTRL r = showCTRLWithSize (r, 0)
fun showCELLSET r = showCELLSETWithSize (r, 0)
val EFLAGS = CellsBasis.newCellKind {name="EFLAGS", nickname="eflags"}
and FFLAGS = CellsBasis.newCellKind {name="FFLAGS", nickname="fflags"}
and CELLSET = CellsBasis.newCellKind {name="CELLSET", nickname="cellset"}
structure MyCells = Cells
(exception Cells = AMD64Cells
val firstPseudo = 256
val desc_GP = CellsBasis.DESC {low=0, high=15, kind=CellsBasis.GP, defaultValues=[],
zeroReg=NONE, toString=showGP, toStringWithSize=showGPWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_FP = CellsBasis.DESC {low=16, high=47, kind=CellsBasis.FP,
defaultValues=[], zeroReg=NONE, toString=showFP, toStringWithSize=showFPWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_EFLAGS = CellsBasis.DESC {low=48, high=48, kind=EFLAGS, defaultValues=[],
zeroReg=NONE, toString=showEFLAGS, toStringWithSize=showEFLAGSWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_FFLAGS = CellsBasis.DESC {low=49, high=49, kind=FFLAGS, defaultValues=[],
zeroReg=NONE, toString=showFFLAGS, toStringWithSize=showFFLAGSWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_MEM = CellsBasis.DESC {low=50, high=49, kind=CellsBasis.MEM,
defaultValues=[], zeroReg=NONE, toString=showMEM, toStringWithSize=showMEMWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_CTRL = CellsBasis.DESC {low=50, high=49, kind=CellsBasis.CTRL,
defaultValues=[], zeroReg=NONE, toString=showCTRL, toStringWithSize=showCTRLWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_CELLSET = CellsBasis.DESC {low=50, high=49, kind=CELLSET, defaultValues=[],
zeroReg=NONE, toString=showCELLSET, toStringWithSize=showCELLSETWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
val cellKindDescs = [(CellsBasis.GP, desc_GP), (CellsBasis.FP, desc_FP),
(CellsBasis.CC, desc_GP), (EFLAGS, desc_EFLAGS), (FFLAGS, desc_FFLAGS),
(CellsBasis.MEM, desc_MEM), (CellsBasis.CTRL, desc_CTRL), (CELLSET,
desc_CELLSET)]
)
open MyCells
val addGP = CellSet.add
and addFP = CellSet.add
and addCC = CellSet.add
and addEFLAGS = CellSet.add
and addFFLAGS = CellSet.add
and addMEM = CellSet.add
and addCTRL = CellSet.add
and addCELLSET = CellSet.add
val RegGP = Reg GP
and RegFP = Reg FP
and RegCC = Reg CC
and RegEFLAGS = Reg EFLAGS
and RegFFLAGS = Reg FFLAGS
and RegMEM = Reg MEM
and RegCTRL = Reg CTRL
and RegCELLSET = Reg CELLSET
val rax = RegGP 0
val rcx = RegGP 1
val rdx = RegGP 2
val rbx = RegGP 3
val rsp = RegGP 4
val rbp = RegGP 5
val rsi = RegGP 6
val rdi = RegGP 7
val stackptrR = RegGP 4
val ST = (fn x => RegFP x
)
val ST0 = RegFP 0
val asmTmpR = RegGP 0
val fasmTmp = RegFP 0
val eflags = RegEFLAGS 0
end
--- NEW FILE: amd64Cells.sml.old ---
(*
* WARNING: This file was automatically generated by MDLGen (v3.0)
* from the machine description file "amd64/amd64.mdl".
* DO NOT EDIT this file directly
*)
signature AMD64CELLS =
sig
include CELLS
val EFLAGS : CellsBasis.cellkind
val FFLAGS : CellsBasis.cellkind
val CELLSET : CellsBasis.cellkind
val showGP : CellsBasis.register_id -> string
val showFP : CellsBasis.register_id -> string
val showCC : CellsBasis.register_id -> string
val showEFLAGS : CellsBasis.register_id -> string
val showFFLAGS : CellsBasis.register_id -> string
val showMEM : CellsBasis.register_id -> string
val showCTRL : CellsBasis.register_id -> string
val showCELLSET : CellsBasis.register_id -> string
val showGPWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showFPWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showCCWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showEFLAGSWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showFFLAGSWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showMEMWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showCTRLWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val showCELLSETWithSize : CellsBasis.register_id * CellsBasis.sz -> string
val rax : CellsBasis.cell
val rcx : CellsBasis.cell
val rdx : CellsBasis.cell
val rbx : CellsBasis.cell
val rsp : CellsBasis.cell
val rbp : CellsBasis.cell
val rsi : CellsBasis.cell
val rdi : CellsBasis.cell
val eax : CellsBasis.cell
val ecx : CellsBasis.cell
val edx : CellsBasis.cell
val ebx : CellsBasis.cell
val esp : CellsBasis.cell
val ebp : CellsBasis.cell
val esi : CellsBasis.cell
val edi : CellsBasis.cell
val ST : int -> CellsBasis.cell
val ST0 : CellsBasis.cell
val eflags : CellsBasis.cell
val addGP : CellsBasis.cell * cellset -> cellset
val addFP : CellsBasis.cell * cellset -> cellset
val addCC : CellsBasis.cell * cellset -> cellset
val addEFLAGS : CellsBasis.cell * cellset -> cellset
val addFFLAGS : CellsBasis.cell * cellset -> cellset
val addMEM : CellsBasis.cell * cellset -> cellset
val addCTRL : CellsBasis.cell * cellset -> cellset
val addCELLSET : CellsBasis.cell * cellset -> cellset
end
structure AMD64Cells : AMD64CELLS =
struct
exception AMD64Cells
fun error msg = MLRiscErrorMsg.error("AMD64Cells",msg)
open CellsBasis
fun showGPWithSize (r, ty) = (fn (0, 8) => "%al"
| (0, 16) => "%ax"
| (0, 32) => "%eax"
| (1, 8) => "%cl"
| (1, 16) => "%cx"
| (1, 32) => "%ecx"
| (2, 8) => "%dl"
| (2, 16) => "%dx"
| (2, 32) => "%edx"
| (3, 8) => "%bl"
| (3, 16) => "%bx"
| (3, 32) => "%ebx"
| (4, 16) => "%sp"
| (4, 32) => "%esp"
| (0, 64) => "%rax"
| (5, 16) => "%bp"
| (5, 32) => "%ebp"
| (1, 64) => "%rcx"
| (6, 16) => "%si"
| (6, 32) => "%esi"
| (2, 64) => "%rdx"
| (7, 16) => "%di"
| (7, 32) => "%edi"
| (3, 64) => "%rbx"
| (r, 32) => ("%r" ^ (Int.toString r)) ^ "d"
| (r, 64) => "%r" ^ (Int.toString r)
| (r, _) => "%" ^ (Int.toString r)
) (r, ty)
and showFPWithSize (r, ty) = (fn (f, _) => (if (f < 8)
then (("%st(" ^ (Int.toString f)) ^ ")")
else ("%f" ^ (Int.toString f)))
) (r, ty)
and showCCWithSize (r, ty) = (fn _ => "cc"
) (r, ty)
and showEFLAGSWithSize (r, ty) = (fn _ => "$eflags"
) (r, ty)
and showFFLAGSWithSize (r, ty) = (fn _ => "$fflags"
) (r, ty)
and showMEMWithSize (r, ty) = (fn _ => "mem"
) (r, ty)
and showCTRLWithSize (r, ty) = (fn _ => "ctrl"
) (r, ty)
and showCELLSETWithSize (r, ty) = (fn _ => "CELLSET"
) (r, ty)
fun showGP r = showGPWithSize (r, 32)
fun showFP r = showFPWithSize (r, 64)
fun showCC r = showCCWithSize (r, 32)
fun showEFLAGS r = showEFLAGSWithSize (r, 32)
fun showFFLAGS r = showFFLAGSWithSize (r, 32)
fun showMEM r = showMEMWithSize (r, 8)
fun showCTRL r = showCTRLWithSize (r, 0)
fun showCELLSET r = showCELLSETWithSize (r, 0)
val EFLAGS = CellsBasis.newCellKind {name="EFLAGS", nickname="eflags"}
and FFLAGS = CellsBasis.newCellKind {name="FFLAGS", nickname="fflags"}
and CELLSET = CellsBasis.newCellKind {name="CELLSET", nickname="cellset"}
structure MyCells = Cells
(exception Cells = AMD64Cells
val firstPseudo = 256
val desc_GP = CellsBasis.DESC {low=0, high=15, kind=CellsBasis.GP, defaultValues=[],
zeroReg=NONE, toString=showGP, toStringWithSize=showGPWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_FP = CellsBasis.DESC {low=16, high=47, kind=CellsBasis.FP,
defaultValues=[], zeroReg=NONE, toString=showFP, toStringWithSize=showFPWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_EFLAGS = CellsBasis.DESC {low=48, high=48, kind=EFLAGS, defaultValues=[],
zeroReg=NONE, toString=showEFLAGS, toStringWithSize=showEFLAGSWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_FFLAGS = CellsBasis.DESC {low=49, high=49, kind=FFLAGS, defaultValues=[],
zeroReg=NONE, toString=showFFLAGS, toStringWithSize=showFFLAGSWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_MEM = CellsBasis.DESC {low=50, high=49, kind=CellsBasis.MEM,
defaultValues=[], zeroReg=NONE, toString=showMEM, toStringWithSize=showMEMWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_CTRL = CellsBasis.DESC {low=50, high=49, kind=CellsBasis.CTRL,
defaultValues=[], zeroReg=NONE, toString=showCTRL, toStringWithSize=showCTRLWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
and desc_CELLSET = CellsBasis.DESC {low=50, high=49, kind=CELLSET, defaultValues=[],
zeroReg=NONE, toString=showCELLSET, toStringWithSize=showCELLSETWithSize,
counter=ref 0, dedicated=ref 0, physicalRegs=ref CellsBasis.array0}
val cellKindDescs = [(CellsBasis.GP, desc_GP), (CellsBasis.FP, desc_FP),
(CellsBasis.CC, desc_GP), (EFLAGS, desc_EFLAGS), (FFLAGS, desc_FFLAGS),
(CellsBasis.MEM, desc_MEM), (CellsBasis.CTRL, desc_CTRL), (CELLSET,
desc_CELLSET)]
)
open MyCells
val addGP = CellSet.add
and addFP = CellSet.add
and addCC = CellSet.add
and addEFLAGS = CellSet.add
and addFFLAGS = CellSet.add
and addMEM = CellSet.add
and addCTRL = CellSet.add
and addCELLSET = CellSet.add
val RegGP = Reg GP
and RegFP = Reg FP
and RegCC = Reg CC
and RegEFLAGS = Reg EFLAGS
and RegFFLAGS = Reg FFLAGS
and RegMEM = Reg MEM
and RegCTRL = Reg CTRL
and RegCELLSET = Reg CELLSET
val rax = RegGP 0
val rcx = RegGP 1
val rdx = RegGP 2
val rbx = RegGP 3
val rsp = RegGP 4
val rbp = RegGP 5
val rsi = RegGP 6
val rdi = RegGP 7
val eax = RegGP 0
val ecx = RegGP 1
val edx = RegGP 2
val ebx = RegGP 3
val esp = RegGP 4
val ebp = RegGP 5
val esi = RegGP 6
val edi = RegGP 7
val stackptrR = RegGP 4
val ST = (fn x => RegFP x
)
val ST0 = RegFP 0
val asmTmpR = RegGP 0
val fasmTmp = RegFP 0
val eflags = RegEFLAGS 0
end
--- NEW FILE: amd64FreqProps.sml ---
(* amd64FreqProps.sml
*
* COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
*
* Extract frequency information from the AMD64 architecture
*
* -- Allen
*)
functor AMD64FreqProps(AMD64Instr : AMD64INSTR) : FREQUENCY_PROPERTIES =
struct
structure I = AMD64Instr
val p0_001 = Probability.prob(1,1000)
val p10 = Probability.percent 10
val p50 = Probability.percent 50
val p90 = Probability.percent 90
val p100 = Probability.always
fun amd64BranchProb(I.JCC{cond=I.EQ,...}) = p10
| amd64BranchProb(I.JCC{cond=I.O,...}) = p0_001
| amd64BranchProb(I.JCC{cond=I.NE,...}) = p90
| amd64BranchProb(I.JCC{cond=I.NO,...}) = p100
| amd64BranchProb(I.JCC{cond=I.P,...}) = p0_001 (* fp unordered test *)
| amd64BranchProb(I.JCC{cond=I.NP,...}) = p100
| amd64BranchProb(I.JCC _) = p50 (* default *)
| amd64BranchProb(I.JMP _) = p100
| amd64BranchProb _ = Probability.never (* non-branch *)
and branchProb(I.ANNOTATION{a, i, ...}) =
(case #peek MLRiscAnnotations.BRANCH_PROB a of
SOME b => b
| NONE => branchProb i
)
| branchProb (I.INSTR i) = amd64BranchProb i
| branchProb _ = Probability.never
end
--- NEW FILE: amd64Instr.sml ---
(*
* WARNING: This file was automatically generated by MDLGen (v3.0)
* from the machine description file "amd64/amd64.mdl".
* DO NOT EDIT this file directly
*)
signature AMD64INSTR =
sig
structure C : AMD64CELLS
structure CB : CELLS_BASIS = CellsBasis
structure T : MLTREE
structure Constant: CONSTANT
structure Region : REGION
sharing Constant = T.Constant
sharing Region = T.Region
datatype operand =
Immed of Int32.int
| ImmedLabel of T.labexp
| Relative of int
| LabelEA of T.labexp
| Direct of int * (CellsBasis.cell)
| FDirect of CellsBasis.cell
| FPR of CellsBasis.cell
| ST of CellsBasis.cell
| Displace of {base:CellsBasis.cell, disp:operand, mem:Region.region}
| Indexed of {base:(CellsBasis.cell) option, index:CellsBasis.cell, scale:int,
disp:operand, mem:Region.region}
type addressing_mode = operand
type ea = operand
datatype cond =
EQ
| NE
| LT
| LE
| GT
| GE
| B
| BE
| A
| AE
| C
| NC
| P
| NP
| O
| NO
datatype binaryOp =
ADDQ
| SUBQ
| ANDQ
| ORQ
| XORQ
| SHLQ
| SARQ
| SHRQ
| MULQ
| IMULQ
| ADCQ
| SBBQ
| ADDL
| SUBL
| ANDL
| ORL
| XORL
| SHLL
| SARL
| SHRL
| MULL
| IMULL
| ADCL
| SBBL
| ADDW
| SUBW
| ANDW
| ORW
| XORW
| SHLW
| SARW
| SHRW
| MULW
| IMULW
| ADDB
| SUBB
| ANDB
| ORB
| XORB
| SHLB
| SARB
| SHRB
| MULB
| IMULB
| BTSW
| BTCW
| BTRW
| BTSL
| BTCL
| BTRL
| ROLW
| RORW
| ROLL
| RORL
| XCHGB
| XCHGW
| XCHGL
| LOCK_ADCW
| LOCK_ADCL
| LOCK_ADDW
| LOCK_ADDL
| LOCK_ANDW
| LOCK_ANDL
| LOCK_BTSW
| LOCK_BTSL
| LOCK_BTRW
| LOCK_BTRL
| LOCK_BTCW
| LOCK_BTCL
| LOCK_ORW
| LOCK_ORL
| LOCK_SBBW
| LOCK_SBBL
| LOCK_SUBW
| LOCK_SUBL
| LOCK_XORW
| LOCK_XORL
| LOCK_XADDB
| LOCK_XADDW
| LOCK_XADDL
datatype multDivOp =
IMULL1
| MULL1
| IDIVL1
| DIVL1
| IMULQ1
| MULQ1
| IDIVQ1
| DIVQ1
datatype unaryOp =
DECQ
| INCQ
| NEGQ
| NOTQ
| DECL
| INCL
| NEGL
| NOTL
| DECW
| INCW
| NEGW
| NOTW
| DECB
| INCB
| NEGB
| NOTB
| LOCK_DECQ
| LOCK_INCQ
| LOCK_NEGQ
| LOCK_NOTQ
datatype shiftOp =
SHLDL
| SHRDL
datatype bitOp =
BTW
| BTL
| BTQ
| LOCK_BTW
| LOCK_BTL
datatype move =
MOVQ
| MOVL
| MOVB
| MOVW
| MOVSWQ
| MOVZWQ
| MOVSWL
| MOVZWL
| MOVSBQ
| MOVZBQ
| MOVSBL
| MOVZBL
| MOVSLQ
datatype fbinOp =
FADDP
| FADDS
| FMULP
| FMULS
| FCOMS
| FCOMPS
| FSUBP
| FSUBS
| FSUBRP
| FSUBRS
| FDIVP
| FDIVS
| FDIVRP
| FDIVRS
| FADDL
| FMULL
| FCOML
| FCOMPL
| FSUBL
| FSUBRL
| FDIVL
| FDIVRL
datatype fibinOp =
FIADDS
| FIMULS
| FICOMS
| FICOMPS
| FISUBS
| FISUBRS
| FIDIVS
| FIDIVRS
| FIADDL
| FIMULL
| FICOML
| FICOMPL
| FISUBL
| FISUBRL
| FIDIVL
| FIDIVRL
datatype funOp =
FCHS
| FABS
| FTST
| FXAM
| FPTAN
| FPATAN
| FXTRACT
| FPREM1
| FDECSTP
| FINCSTP
| FPREM
| FYL2XP1
| FSQRT
| FSINCOS
| FRNDINT
| FSCALE
| FSIN
| FCOS
datatype fenvOp =
FLDENV
| FNLDENV
| FSTENV
| FNSTENV
datatype fsize =
FP32
| FP64
| FP80
datatype isize =
I8
| I16
| I32
| I64
datatype instr =
NOP
| JMP of operand * Label.label list
| JCC of {cond:cond, opnd:operand}
| CALL of {opnd:operand, defs:C.cellset, uses:C.cellset, return:C.cellset,
cutsTo:Label.label list, mem:Region.region, pops:Int32.int}
| CALLQ of {opnd:operand, defs:C.cellset, uses:C.cellset, return:C.cellset,
cutsTo:Label.label list, mem:Region.region, pops:Int32.int}
| ENTER of {src1:operand, src2:operand}
| LEAVE
| RET of operand option
| MOVE of {mvOp:move, src:operand, dst:operand}
| LEA of {r32:CellsBasis.cell, addr:operand}
| LEAQ of {r64:CellsBasis.cell, addr:operand}
| CMPQ of {lsrc:operand, rsrc:operand}
| CMPL of {lsrc:operand, rsrc:operand}
| CMPW of {lsrc:operand, rsrc:operand}
| CMPB of {lsrc:operand, rsrc:operand}
| TESTQ of {lsrc:operand, rsrc:operand}
| TESTL of {lsrc:operand, rsrc:operand}
| TESTW of {lsrc:operand, rsrc:operand}
| TESTB of {lsrc:operand, rsrc:operand}
| BITOP of {bitOp:bitOp, lsrc:operand, rsrc:operand}
| BINARY of {binOp:binaryOp, src:operand, dst:operand}
| SHIFT of {shiftOp:shiftOp, src:operand, dst:operand, count:operand}
| CMPXCHG of {lock:bool, sz:isize, src:operand, dst:operand}
| MULTDIV of {multDivOp:multDivOp, src:operand}
| MUL3 of {dst:CellsBasis.cell, src2:Int32.int, src1:operand}
| MULQ3 of {dst:CellsBasis.cell, src2:Int32.int, src1:operand}
| UNARY of {unOp:unaryOp, opnd:operand}
| SET of {cond:cond, opnd:operand}
| CMOV of {cond:cond, src:operand, dst:CellsBasis.cell}
| CMOVQ of {cond:cond, src:operand, dst:CellsBasis.cell}
| PUSHQ of operand
| PUSHL of operand
| PUSHW of operand
| PUSHB of operand
| PUSHFD
| POPFD
| POP of operand
| CDQ
| INTO
| FBINARY of {binOp:fbinOp, src:operand, dst:operand}
| FIBINARY of {binOp:fibinOp, src:operand}
| FUNARY of funOp
| FUCOM of operand
| FUCOMP of operand
| FUCOMPP
| FCOMPP
| FCOMI of operand
| FCOMIP of operand
| FUCOMI of operand
| FUCOMIP of operand
| FXCH of {opnd:CellsBasis.cell}
| FSTPL of operand
| FSTPS of operand
| FSTPT of operand
| FSTL of operand
| FSTS of operand
| FLD1
| FLDL2E
| FLDL2T
| FLDLG2
| FLDLN2
| FLDPI
| FLDZ
| FLDL of operand
| FLDS of operand
| FLDT of operand
| FILD of operand
| FILDL of operand
| FILDLL of operand
| FNSTSW
| FENV of {fenvOp:fenvOp, opnd:operand}
| FMOVE of {fsize:fsize, src:operand, dst:operand}
| FILOAD of {isize:isize, ea:operand, dst:operand}
| FBINOP of {fsize:fsize, binOp:fbinOp, lsrc:operand, rsrc:operand, dst:operand}
| FIBINOP of {isize:isize, binOp:fibinOp, lsrc:operand, rsrc:operand, dst:operand}
| FUNOP of {fsize:fsize, unOp:funOp, src:operand, dst:operand}
| FCMP of {i:bool, fsize:fsize, lsrc:operand, rsrc:operand}
| SAHF
| LAHF
| SOURCE of {}
| SINK of {}
| PHI of {}
and instruction =
LIVE of {regs: C.cellset, spilled: C.cellset}
| KILL of {regs: C.cellset, spilled: C.cellset}
| COPY of {k: CellsBasis.cellkind,
sz: int, (* in bits *)
dst: CellsBasis.cell list,
src: CellsBasis.cell list,
tmp: ea option (* NONE if |dst| = {src| = 1 *)}
| ANNOTATION of {i:instruction, a:Annotations.annotation}
| INSTR of instr
val nop : instruction
val jmp : operand * Label.label list -> instruction
val jcc : {cond:cond, opnd:operand} -> instruction
val call : {opnd:operand, defs:C.cellset, uses:C.cellset, return:C.cellset,
cutsTo:Label.label list, mem:Region.region, pops:Int32.int} -> instruction
val callq : {opnd:operand, defs:C.cellset, uses:C.cellset, return:C.cellset,
cutsTo:Label.label list, mem:Region.region, pops:Int32.int} -> instruction
val enter : {src1:operand, src2:operand} -> instruction
val leave : instruction
val ret : operand option -> instruction
val move : {mvOp:move, src:operand, dst:operand} -> instruction
val lea : {r32:CellsBasis.cell, addr:operand} -> instruction
val leaq : {r64:CellsBasis.cell, addr:operand} -> instruction
val cmpq : {lsrc:operand, rsrc:operand} -> instruction
val cmpl : {lsrc:operand, rsrc:operand} -> instruction
val cmpw : {lsrc:operand, rsrc:operand} -> instruction
val cmpb : {lsrc:operand, rsrc:operand} -> instruction
val testq : {lsrc:operand, rsrc:operand} -> instruction
val testl : {lsrc:operand, rsrc:operand} -> instruction
val testw : {lsrc:operand, rsrc:operand} -> instruction
val testb : {lsrc:operand, rsrc:operand} -> instruction
val bitop : {bitOp:bitOp, lsrc:operand, rsrc:operand} -> instruction
val binary : {binOp:binaryOp, src:operand, dst:operand} -> instruction
val shift : {shiftOp:shiftOp, src:operand, dst:operand, count:operand} -> instruction
val cmpxchg : {lock:bool, sz:isize, src:operand, dst:operand} -> instruction
val multdiv : {multDivOp:multDivOp, src:operand} -> instruction
val mul3 : {dst:CellsBasis.cell, src2:Int32.int, src1:operand} -> instruction
val mulq3 : {dst:CellsBasis.cell, src2:Int32.int, src1:operand} -> instruction
val unary : {unOp:unaryOp, opnd:operand} -> instruction
val set : {cond:cond, opnd:operand} -> instruction
val cmov : {cond:cond, src:operand, dst:CellsBasis.cell} -> instruction
val cmovq : {cond:cond, src:operand, dst:CellsBasis.cell} -> instruction
val pushq : operand -> instruction
val pushl : operand -> instruction
val pushw : operand -> instruction
val pushb : operand -> instruction
val pushfd : instruction
val popfd : instruction
val pop : operand -> instruction
val cdq : instruction
val into : instruction
val fbinary : {binOp:fbinOp, src:operand, dst:operand} -> instruction
val fibinary : {binOp:fibinOp, src:operand} -> instruction
val funary : funOp -> instruction
val fucom : operand -> instruction
val fucomp : operand -> instruction
val fucompp : instruction
val fcompp : instruction
val fcomi : operand -> instruction
val fcomip : operand -> instruction
val fucomi : operand -> instruction
val fucomip : operand -> instruction
val fxch : {opnd:CellsBasis.cell} -> instruction
val fstpl : operand -> instruction
val fstps : operand -> instruction
val fstpt : operand -> instruction
val fstl : operand -> instruction
val fsts : operand -> instruction
val fld1 : instruction
val fldl2e : instruction
val fldl2t : instruction
val fldlg2 : instruction
val fldln2 : instruction
val fldpi : instruction
val fldz : instruction
val fldl : operand -> instruction
val flds : operand -> instruction
val fldt : operand -> instruction
val fild : operand -> instruction
val fildl : operand -> instruction
val fildll : operand -> instruction
val fnstsw : instruction
val fenv : {fenvOp:fenvOp, opnd:operand} -> instruction
val fmove : {fsize:fsize, src:operand, dst:operand} -> instruction
val fiload : {isize:isize, ea:operand, dst:operand} -> instruction
val fbinop : {fsize:fsize, binOp:fbinOp, lsrc:operand, rsrc:operand, dst:operand} -> instruction
val fibinop : {isize:isize, binOp:fibinOp, lsrc:operand, rsrc:operand, dst:operand} -> instruction
val funop : {fsize:fsize, unOp:funOp, src:operand, dst:operand} -> instruction
val fcmp : {i:bool, fsize:fsize, lsrc:operand, rsrc:operand} -> instruction
val sahf : instruction
val lahf : instruction
val source : {} -> instruction
val sink : {} -> instruction
val phi : {} -> instruction
end
functor AMD64Instr(T: MLTREE
) : AMD64INSTR =
struct
structure C = AMD64Cells
structure CB = CellsBasis
structure T = T
structure Region = T.Region
structure Constant = T.Constant
datatype operand =
Immed of Int32.int
| ImmedLabel of T.labexp
| Relative of int
| LabelEA of T.labexp
| Direct of int * (CellsBasis.cell)
| FDirect of CellsBasis.cell
| FPR of CellsBasis.cell
| ST of CellsBasis.cell
| Displace of {base:CellsBasis.cell, disp:operand, mem:Region.region}
| Indexed of {base:(CellsBasis.cell) option, index:CellsBasis.cell, scale:int,
disp:operand, mem:Region.region}
type addressing_mode = operand
type ea = operand
datatype cond =
EQ
| NE
| LT
| LE
| GT
| GE
| B
| BE
| A
| AE
| C
| NC
| P
| NP
| O
| NO
datatype binaryOp =
ADDQ
| SUBQ
| ANDQ
| ORQ
| XORQ
| SHLQ
| SARQ
| SHRQ
| MULQ
| IMULQ
| ADCQ
| SBBQ
| ADDL
| SUBL
| ANDL
| ORL
| XORL
| SHLL
| SARL
| SHRL
| MULL
| IMULL
| ADCL
| SBBL
| ADDW
| SUBW
| ANDW
| ORW
| XORW
| SHLW
| SARW
| SHRW
| MULW
| IMULW
| ADDB
| SUBB
| ANDB
| ORB
| XORB
| SHLB
| SARB
| SHRB
| MULB
| IMULB
| BTSW
| BTCW
| BTRW
| BTSL
| BTCL
| BTRL
| ROLW
| RORW
| ROLL
| RORL
| XCHGB
| XCHGW
| XCHGL
| LOCK_ADCW
| LOCK_ADCL
| LOCK_ADDW
| LOCK_ADDL
| LOCK_ANDW
| LOCK_ANDL
| LOCK_BTSW
| LOCK_BTSL
| LOCK_BTRW
| LOCK_BTRL
| LOCK_BTCW
| LOCK_BTCL
| LOCK_ORW
| LOCK_ORL
| LOCK_SBBW
| LOCK_SBBL
| LOCK_SUBW
| LOCK_SUBL
| LOCK_XORW
| LOCK_XORL
| LOCK_XADDB
| LOCK_XADDW
| LOCK_XADDL
datatype multDivOp =
IMULL1
| MULL1
| IDIVL1
| DIVL1
| IMULQ1
| MULQ1
| IDIVQ1
| DIVQ1
datatype unaryOp =
DECQ
| INCQ
| NEGQ
| NOTQ
| DECL
| INCL
| NEGL
| NOTL
| DECW
| INCW
| NEGW
| NOTW
| DECB
| INCB
| NEGB
| NOTB
| LOCK_DECQ
| LOCK_INCQ
| LOCK_NEGQ
| LOCK_NOTQ
datatype shiftOp =
SHLDL
| SHRDL
datatype bitOp =
BTW
| BTL
| BTQ
| LOCK_BTW
| LOCK_BTL
datatype move =
MOVQ
| MOVL
| MOVB
| MOVW
| MOVSWQ
| MOVZWQ
| MOVSWL
| MOVZWL
| MOVSBQ
| MOVZBQ
| MOVSBL
| MOVZBL
| MOVSLQ
datatype fbinOp =
FADDP
| FADDS
| FMULP
| FMULS
| FCOMS
| FCOMPS
| FSUBP
| FSUBS
| FSUBRP
| FSUBRS
| FDIVP
| FDIVS
| FDIVRP
| FDIVRS
| FADDL
| FMULL
| FCOML
| FCOMPL
| FSUBL
| FSUBRL
| FDIVL
| FDIVRL
datatype fibinOp =
FIADDS
| FIMULS
| FICOMS
| FICOMPS
| FISUBS
| FISUBRS
| FIDIVS
| FIDIVRS
| FIADDL
| FIMULL
| FICOML
| FICOMPL
| FISUBL
| FISUBRL
| FIDIVL
| FIDIVRL
datatype funOp =
FCHS
| FABS
| FTST
| FXAM
| FPTAN
| FPATAN
| FXTRACT
| FPREM1
| FDECSTP
| FINCSTP
| FPREM
| FYL2XP1
| FSQRT
| FSINCOS
| FRNDINT
| FSCALE
| FSIN
| FCOS
datatype fenvOp =
FLDENV
| FNLDENV
| FSTENV
| FNSTENV
datatype fsize =
FP32
| FP64
| FP80
datatype isize =
I8
| I16
| I32
| I64
datatype instr =
NOP
| JMP of operand * Label.label list
| JCC of {cond:cond, opnd:operand}
| CALL of {opnd:operand, defs:C.cellset, uses:C.cellset, return:C.cellset,
cutsTo:Label.label list, mem:Region.region, pops:Int32.int}
| CALLQ of {opnd:operand, defs:C.cellset, uses:C.cellset, return:C.cellset,
cutsTo:Label.label list, mem:Region.region, pops:Int32.int}
| ENTER of {src1:operand, src2:operand}
| LEAVE
| RET of operand option
| MOVE of {mvOp:move, src:operand, dst:operand}
| LEA of {r32:CellsBasis.cell, addr:operand}
| LEAQ of {r64:CellsBasis.cell, addr:operand}
| CMPQ of {lsrc:operand, rsrc:operand}
| CMPL of {lsrc:operand, rsrc:operand}
| CMPW of {lsrc:operand, rsrc:operand}
| CMPB of {lsrc:operand, rsrc:operand}
| TESTQ of {lsrc:operand, rsrc:operand}
| TESTL of {lsrc:operand, rsrc:operand}
| TESTW of {lsrc:operand, rsrc:operand}
| TESTB of {lsrc:operand, rsrc:operand}
| BITOP of {bitOp:bitOp, lsrc:operand, rsrc:operand}
| BINARY of {binOp:binaryOp, src:operand, dst:operand}
| SHIFT of {shiftOp:shiftOp, src:operand, dst:operand, count:operand}
| CMPXCHG of {lock:bool, sz:isize, src:operand, dst:operand}
| MULTDIV of {multDivOp:multDivOp, src:operand}
| MUL3 of {dst:CellsBasis.cell, src2:Int32.int, src1:operand}
| MULQ3 of {dst:CellsBasis.cell, src2:Int32.int, src1:operand}
| UNARY of {unOp:unaryOp, opnd:operand}
| SET of {cond:cond, opnd:operand}
| CMOV of {cond:cond, src:operand, dst:CellsBasis.cell}
| CMOVQ of {cond:cond, src:operand, dst:CellsBasis.cell}
| PUSHQ of operand
| PUSHL of operand
| PUSHW of operand
| PUSHB of operand
| PUSHFD
| POPFD
| POP of operand
| CDQ
| INTO
| FBINARY of {binOp:fbinOp, src:operand, dst:operand}
| FIBINARY of {binOp:fibinOp, src:operand}
| FUNARY of funOp
| FUCOM of operand
| FUCOMP of operand
| FUCOMPP
| FCOMPP
| FCOMI of operand
| FCOMIP of operand
| FUCOMI of operand
| FUCOMIP of operand
| FXCH of {opnd:CellsBasis.cell}
| FSTPL of operand
| FSTPS of operand
| FSTPT of operand
| FSTL of operand
| FSTS of operand
| FLD1
| FLDL2E
| FLDL2T
| FLDLG2
| FLDLN2
| FLDPI
| FLDZ
| FLDL of operand
| FLDS of operand
| FLDT of operand
| FILD of operand
| FILDL of operand
| FILDLL of operand
| FNSTSW
| FENV of {fenvOp:fenvOp, opnd:operand}
| FMOVE of {fsize:fsize, src:operand, dst:operand}
| FILOAD of {isize:isize, ea:operand, dst:operand}
| FBINOP of {fsize:fsize, binOp:fbinOp, lsrc:operand, rsrc:operand, dst:operand}
| FIBINOP of {isize:isize, binOp:fibinOp, lsrc:operand, rsrc:operand, dst:operand}
| FUNOP of {fsize:fsize, unOp:funOp, src:operand, dst:operand}
| FCMP of {i:bool, fsize:fsize, lsrc:operand, rsrc:operand}
| SAHF
| LAHF
| SOURCE of {}
| SINK of {}
| PHI of {}
and instruction =
LIVE of {regs: C.cellset, spilled: C.cellset}
| KILL of {regs: C.cellset, spilled: C.cellset}
| COPY of {k: CellsBasis.cellkind,
sz: int, (* in bits *)
dst: CellsBasis.cell list,
src: CellsBasis.cell list,
tmp: ea option (* NONE if |dst| = {src| = 1 *)}
| ANNOTATION of {i:instruction, a:Annotations.annotation}
| INSTR of instr
val nop = INSTR NOP
and jmp = INSTR o JMP
and jcc = INSTR o JCC
and call = INSTR o CALL
and callq = INSTR o CALLQ
and enter = INSTR o ENTER
and leave = INSTR LEAVE
and ret = INSTR o RET
and move = INSTR o MOVE
and lea = INSTR o LEA
and leaq = INSTR o LEAQ
and cmpq = INSTR o CMPQ
and cmpl = INSTR o CMPL
and cmpw = INSTR o CMPW
and cmpb = INSTR o CMPB
and testq = INSTR o TESTQ
and testl = INSTR o TESTL
and testw = INSTR o TESTW
and testb = INSTR o TESTB
and bitop = INSTR o BITOP
and binary = INSTR o BINARY
and shift = INSTR o SHIFT
and cmpxchg = INSTR o CMPXCHG
and multdiv = INSTR o MULTDIV
and mul3 = INSTR o MUL3
and mulq3 = INSTR o MULQ3
and unary = INSTR o UNARY
and set = INSTR o SET
and cmov = INSTR o CMOV
and cmovq = INSTR o CMOVQ
and pushq = INSTR o PUSHQ
and pushl = INSTR o PUSHL
and pushw = INSTR o PUSHW
and pushb = INSTR o PUSHB
and pushfd = INSTR PUSHFD
and popfd = INSTR POPFD
and pop = INSTR o POP
and cdq = INSTR CDQ
and into = INSTR INTO
and fbinary = INSTR o FBINARY
and fibinary = INSTR o FIBINARY
and funary = INSTR o FUNARY
and fucom = INSTR o FUCOM
and fucomp = INSTR o FUCOMP
and fucompp = INSTR FUCOMPP
and fcompp = INSTR FCOMPP
and fcomi = INSTR o FCOMI
and fcomip = INSTR o FCOMIP
and fucomi = INSTR o FUCOMI
and fucomip = INSTR o FUCOMIP
and fxch = INSTR o FXCH
and fstpl = INSTR o FSTPL
and fstps = INSTR o FSTPS
and fstpt = INSTR o FSTPT
and fstl = INSTR o FSTL
and fsts = INSTR o FSTS
and fld1 = INSTR FLD1
and fldl2e = INSTR FLDL2E
and fldl2t = INSTR FLDL2T
and fldlg2 = INSTR FLDLG2
and fldln2 = INSTR FLDLN2
and fldpi = INSTR FLDPI
and fldz = INSTR FLDZ
and fldl = INSTR o FLDL
and flds = INSTR o FLDS
and fldt = INSTR o FLDT
and fild = INSTR o FILD
and fildl = INSTR o FILDL
and fildll = INSTR o FILDLL
and fnstsw = INSTR FNSTSW
and fenv = INSTR o FENV
and fmove = INSTR o FMOVE
and fiload = INSTR o FILOAD
and fbinop = INSTR o FBINOP
and fibinop = INSTR o FIBINOP
and funop = INSTR o FUNOP
and fcmp = INSTR o FCMP
and sahf = INSTR SAHF
and lahf = INSTR LAHF
and source = INSTR o SOURCE
and sink = INSTR o SINK
and phi = INSTR o PHI
end
--- NEW FILE: amd64MemRegs.sig ---
signature MEMORY_REGISTERS = sig
structure I : AMD64INSTR
val memReg : {reg:I.operand, base: CellsBasis.cell} -> I.ea
end
--- NEW FILE: amd64Peephole.peep ---
(*
* Note, this file contains conditional pattern matching rules.
* You'll have to run it thru the tool wheregen
* (source for this is in the directory Tools/WhereGen)
* to generate the output.
*
* -- Allen
*)
local
structure I =
struct
include "amd64Instr.sml" (* import instruction definitions *)
end
in
functor AMD64Peephole
(structure Instr : AMD64INSTR
structure Eval : MLTREE_EVAL
sharing Instr.T = Eval.T
) : PEEPHOLE =
struct
structure I = Instr
structure C = I.C
structure CBase = CellsBasis
(* IMPORTANT: instructions are given in forward order *)
fun peephole instrs =
let fun isStackPtr(I.Direct r) = CBase.sameColor(r, C.esp)
| isStackPtr _ = false
fun isZeroLE le = (Eval.valueOf le = 0) handle _ => false
fun isZero(I.Immed n) = n = 0
| isZero(I.ImmedLabel le) = isZeroLE le
| isZero _ = false
fun isZeroOpt NONE = true
| isZeroOpt (SOME opn) = isZero opn
fun loop(code, instrs) =
(case code of
[] => instrs
(* x <- x +/- 0;
*)
| I.INSTR(I.BINARY{binOp=(I.ADDL | I.SUBL),
src=I.ImmedLabel le, ...})::rest
where isZeroLE le => loop(rest, instrs)
(* remove lea 0(r), r *)
| I.INSTR(I.LEA{r32,
addr=I.Displace{base, disp=I.ImmedLabel le,...}})::rest
where (isZeroLE le) andalso
CBase.sameColor(r32,base) => loop(rest, instrs)
(* addl n, %esp; subl m, %esp
* => addl (n-m), %esp ;; when m < n
* => - ;; when m = n
* => subl (m-n), %esp ;; when m > n
*)
| I.INSTR(I.BINARY{binOp=I.ADDL, src=I.Immed n, dst=I.Direct d_i})::
I.INSTR(I.BINARY{binOp=I.SUBL, src=I.Immed m, dst=I.Direct d_j})::
rest
where CBase.sameColor(d_i, C.esp) andalso
CBase.sameColor(d_j, C.esp) =>
if (m = n) then loop (rest, instrs)
else if (m < n) then
loop(rest,
I.binary{binOp=I.ADDL, src=I.Immed(n-m),
dst=I.Direct(C.esp)}::instrs)
else
loop(rest,
I.binary{binOp=I.SUBL, src=I.Immed(m-n),
dst=I.Direct(C.esp)}::instrs)
(* push folding:
* subl 4, %esp
* movl src, 0(%esp) (where src <> %esp !!! )
* =>
* pushl src
*)
| I.INSTR(I.BINARY{binOp=I.SUBL,src=I.Immed 4,dst=I.Direct dst_i})::
I.INSTR(I.MOVE{mvOp=I.MOVL,src,
dst=I.Displace{base,disp=I.Immed 0,...}})
::rest
where CBase.sameColor(base, C.esp) andalso
CBase.sameColor(dst_i, C.esp) andalso
not(isStackPtr src) =>
loop(rest, I.pushl src::instrs)
(* pop folding:
* movl 0(%esp), dst (where dst <> %esp!!!!)
* addl 4, %esp
* =>
* popl dst
*)
| I.INSTR(I.MOVE{mvOp=I.MOVL,
src=I.Displace{base, disp=I.Immed 0, ...}, dst})::
I.INSTR(I.BINARY{binOp=I.ADDL, src=I.Immed 4,
dst=I.Direct dst_i})::
rest
where CBase.sameColor(base, C.esp) andalso
CBase.sameColor(dst_i,C.esp) andalso
not(isStackPtr dst) =>
loop(rest, I.pop dst::instrs)
| I.INSTR(I.MOVE{mvOp=I.MOVL, src, dst as I.Direct _})::rest
where isZero src =>
loop(rest, I.binary{binOp=I.XORL, src=dst, dst=dst}::instrs)
| i::rest => loop(rest, i::instrs)
)
in loop(instrs, [])
end
end
end
--- NEW FILE: amd64Peephole.sml ---
(* WARNING: this is generated by running 'nowhere amd64Peephole.peep'.
* Do not edit this file directly.
* Version 1.2.2
*)
(*#line 20.1 "amd64Peephole.peep"*)
functor AMD64Peephole(
(*#line 21.5 "amd64Peephole.peep"*)
structure Instr : AMD64INSTR
(*#line 22.5 "amd64Peephole.peep"*)
structure Eval : MLTREE_EVAL
(*#line 23.7 "amd64Peephole.peep"*)
sharing Instr.T = Eval.T
): PEEPHOLE =
struct
(*#line 26.4 "amd64Peephole.peep"*)
structure I = Instr
(*#line 27.4 "amd64Peephole.peep"*)
structure C = I.C
(*#line 28.4 "amd64Peephole.peep"*)
structure CBase = CellsBasis
(*#line 31.4 "amd64Peephole.peep"*)
fun peephole instrs =
let
(*#line 32.8 "amd64Peephole.peep"*)
fun isStackPtr (I.Direct r) = CBase.sameColor (r, C.esp)
| isStackPtr _ = false
(*#line 35.8 "amd64Peephole.peep"*)
fun isZeroLE le = (((Eval.valueOf le) = 0) handle _ => false
)
(*#line 37.8 "amd64Peephole.peep"*)
fun isZero (I.Immed n) = n = 0
| isZero (I.ImmedLabel le) = isZeroLE le
| isZero _ = false
(*#line 41.8 "amd64Peephole.peep"*)
fun isZeroOpt NONE = true
| isZeroOpt (SOME opn) = isZero opn
(*#line 44.8 "amd64Peephole.peep"*)
fun loop (code, instrs) =
let val v_34 = code
fun state_9 (v_0, v_3) =
let val i = v_0
and rest = v_3
in loop (rest, i :: instrs)
end
fun state_22 (v_0, v_17, v_3) =
let val le = v_17
and rest = v_3
in (if (isZeroLE le)
then (loop (rest, instrs))
else (state_9 (v_0, v_3)))
end
fun state_51 (v_0, v_1, v_2, v_3) =
(case v_1 of
I.Direct v_26 =>
let val dst = v_1
and rest = v_3
and src = v_2
in (if (isZero src)
then (loop (rest, (I.binary {binOp=I.XORL, src=dst, dst=dst}) :: instrs))
else (state_9 (v_0, v_3)))
end
| _ => state_9 (v_0, v_3)
)
in
(case v_34 of
op :: v_33 =>
let val (v_0, v_3) = v_33
in
(case v_0 of
I.INSTR v_32 =>
(case v_32 of
I.BINARY v_19 =>
let val {binOp=v_31, dst=v_1, src=v_2, ...} = v_19
in
(case v_31 of
I.ADDL =>
(case v_2 of
I.Immed v_17 =>
(case v_1 of
I.Direct v_26 =>
(case v_3 of
op :: v_14 =>
let val (v_13, v_4) = v_14
in
(case v_13 of
I.INSTR v_12 =>
(case v_12 of
I.BINARY v_11 =>
let val {binOp=v_10, dst=v_9, src=v_8, ...} = v_11
in
(case v_10 of
I.SUBL =>
(case v_9 of
I.Direct v_5 =>
(case v_8 of
I.Immed v_7 =>
let val d_i = v_26
and d_j = v_5
and m = v_7
and n = v_17
and rest = v_4
in (if ((CBase.sameColor (d_i, C.esp)) andalso (CBase.sameColor (d_j, C.esp)))
then (if (m = n)
then (loop (rest, instrs))
else (if (m < n)
then (loop (rest, (I.binary {binOp=I.ADDL, src=I.Immed (n - m), dst=I.Direct C.esp}) :: instrs))
else (loop (rest, (I.binary {binOp=I.SUBL, src=I.Immed (m - n), dst=I.Direct C.esp}) :: instrs))))
else (state_9 (v_0, v_3)))
end
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
end
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
end
| nil => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
| I.ImmedLabel v_17 => state_22 (v_0, v_17, v_3)
| _ => state_9 (v_0, v_3)
)
| I.SUBL =>
(case v_2 of
I.Immed v_17 =>
(case v_1 of
I.Direct v_26 =>
(case v_17 of
4 =>
(case v_3 of
op :: v_14 =>
let val (v_13, v_4) = v_14
in
(case v_13 of
I.INSTR v_12 =>
(case v_12 of
I.MOVE v_11 =>
let val {dst=v_9, mvOp=v_28, src=v_8, ...} = v_11
in
(case v_9 of
I.Displace v_5 =>
let val {base=v_27, disp=v_30, ...} = v_5
in
(case v_30 of
I.Immed v_29 =>
(case v_29 of
0 =>
(case v_28 of
I.MOVL =>
let val base = v_27
and dst_i = v_26
and rest = v_4
and src = v_8
in (if (((CBase.sameColor (base, C.esp)) andalso (CBase.sameColor (dst_i, C.esp))) andalso (not (isStackPtr src)))
then (loop (rest, (I.pushl src) :: instrs))
else (state_9 (v_0, v_3)))
end
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
end
| _ => state_9 (v_0, v_3)
)
end
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
end
| nil => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
| I.ImmedLabel v_17 => state_22 (v_0, v_17, v_3)
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
end
| I.LEA v_19 =>
let val {addr=v_25, r32=v_20, ...} = v_19
in
(case v_25 of
I.Displace v_24 =>
let val {base=v_22, disp=v_23, ...} = v_24
in
(case v_23 of
I.ImmedLabel v_21 =>
let val base = v_22
and le = v_21
and r32 = v_20
and rest = v_3
in (if ((isZeroLE le) andalso (CBase.sameColor (r32, base)))
then (loop (rest, instrs))
else (state_9 (v_0, v_3)))
end
| _ => state_9 (v_0, v_3)
)
end
| _ => state_9 (v_0, v_3)
)
end
| I.MOVE v_19 =>
let val {dst=v_1, mvOp=v_18, src=v_2, ...} = v_19
in
(case v_18 of
I.MOVL =>
(case v_2 of
I.Displace v_17 =>
let val {base=v_6, disp=v_16, ...} = v_17
in
(case v_16 of
I.Immed v_15 =>
(case v_15 of
0 =>
(case v_3 of
op :: v_14 =>
let val (v_13, v_4) = v_14
in
(case v_13 of
I.INSTR v_12 =>
(case v_12 of
I.BINARY v_11 =>
let val {binOp=v_10, dst=v_9, src=v_8, ...} = v_11
in
(case v_10 of
I.ADDL =>
(case v_9 of
I.Direct v_5 =>
(case v_8 of
I.Immed v_7 =>
(case v_7 of
4 =>
let val base = v_6
and dst = v_1
and dst_i = v_5
and rest = v_4
in (if (((CBase.sameColor (base, C.esp)) andalso (CBase.sameColor (dst_i, C.esp))) andalso (not (isStackPtr dst)))
then (loop (rest, (I.pop dst) :: instrs))
else (state_51 (v_0, v_1, v_2, v_3)))
end
| _ => state_51 (v_0, v_1, v_2, v_3)
)
| _ => state_51 (v_0, v_1, v_2, v_3)
)
| _ => state_51 (v_0, v_1, v_2, v_3)
)
| _ => state_51 (v_0, v_1, v_2, v_3)
)
end
| _ => state_51 (v_0, v_1, v_2, v_3)
)
| _ => state_51 (v_0, v_1, v_2, v_3)
)
end
| nil => state_51 (v_0, v_1, v_2, v_3)
)
| _ => state_51 (v_0, v_1, v_2, v_3)
)
| _ => state_51 (v_0, v_1, v_2, v_3)
)
end
| _ => state_51 (v_0, v_1, v_2, v_3)
)
| _ => state_9 (v_0, v_3)
)
end
| _ => state_9 (v_0, v_3)
)
| _ => state_9 (v_0, v_3)
)
end
| nil => instrs
)
end
in loop (instrs, [])
end
end
--- NEW FILE: amd64Props.sml ---
(* amd64Props.sml -- 32bit, amd64 instruction semantic properties
*
* COPYRIGHT (c) 1997 Bell Laboratories.
*)
functor AMD64Props
(structure Instr : AMD64INSTR
structure MLTreeHash : MLTREE_HASH where T = Instr.T
structure MLTreeEval : MLTREE_EVAL where T = Instr.T
) : INSN_PROPERTIES =
struct
structure I = Instr
structure C = I.C
structure T = I.T
structure CB = CellsBasis
exception NegateConditional
fun error msg = MLRiscErrorMsg.error("AMD64Props",msg)
datatype kind = IK_JUMP | IK_NOP | IK_INSTR | IK_COPY | IK_CALL
| IK_CALL_WITH_CUTS | IK_PHI | IK_SOURCE | IK_SINK
datatype target = LABELLED of Label.label | FALLTHROUGH | ESCAPES
(*========================================================================
* Instruction Kinds
*========================================================================*)
fun instrKind (I.ANNOTATION{i, ...}) = instrKind i
| instrKind (I.COPY _) = IK_COPY
| instrKind (I.INSTR i) =
(case i
of I.JMP _ => IK_JUMP
| I.JCC _ => IK_JUMP
| I.CALL{cutsTo=_::_,...} => IK_CALL_WITH_CUTS
| I.CALL _ => IK_CALL
| I.CALLQ{cutsTo=_::_,...} => IK_CALL_WITH_CUTS
| I.CALLQ _ => IK_CALL
| I.PHI _ => IK_PHI
| I.SOURCE _ => IK_SOURCE
| I.SINK _ => IK_SINK
| I.RET _ => IK_JUMP
| I.INTO => IK_JUMP
| _ => IK_INSTR)
| instrKind _ = IK_INSTR
fun moveInstr(I.ANNOTATION{i, ...}) = moveInstr i
| moveInstr(I.LIVE _) = false
| moveInstr(I.KILL _) = false
| moveInstr(I.COPY _) = true
| moveInstr(I.INSTR i) =
(case i
of (*I.MOVE{mvOp=I.MOVL, src=I.Direct _, dst=I.MemReg _, ...} => true
| I.MOVE{mvOp=I.MOVL, src=I.MemReg _, dst=I.Direct _, ...} => true
|*) I.FMOVE{fsize=I.FP64,src=I.FPR _,dst=I.FPR _, ...} => true
| I.FMOVE{fsize=I.FP64,src=I.FPR _,dst=I.FDirect _, ...} => true
| I.FMOVE{fsize=I.FP64,src=I.FDirect _,dst=I.FPR _, ...} => true
| I.FMOVE{fsize=I.FP64,src=I.FDirect _,dst=I.FDirect _, ...} => true
| _ => false )
fun isMemMove(I.INSTR(i)) =
(case i
of (*I.MOVE{mvOp=I.MOVL, src=I.Direct _, dst=I.MemReg _, ...} => true
| I.MOVE{mvOp=I.MOVL, src=I.MemReg _, dst=I.Direct _, ...} => true
|*) I.FMOVE{fsize=I.FP64,src=I.FPR _,dst=I.FPR _, ...} => true
| I.FMOVE{fsize=I.FP64,src=I.FPR _,dst=I.FDirect _, ...} => true
| I.FMOVE{fsize=I.FP64,src=I.FDirect _,dst=I.FPR _, ...} => true
| I.FMOVE{fsize=I.FP64,src=I.FDirect _,dst=I.FDirect _, ...} => true
| _ => false
(*esac*))
| isMemMove _ = false
fun memMove(I.INSTR(i)) =
(case i
of (*I.MOVE{src=I.Direct rs, dst=I.MemReg rd, ...} => ([rd], [rs])
| I.MOVE{src=I.MemReg rs, dst=I.Direct rd, ...} => ([rd], [rs])
| *) I.FMOVE{src=I.FPR rs, dst=I.FPR rd, ...} => ([rd], [rs])
| I.FMOVE{src=I.FDirect rs, dst=I.FPR rd, ...} => ([rd], [rs])
| I.FMOVE{src=I.FPR rs, dst=I.FDirect rd, ...} => ([rd], [rs])
| I.FMOVE{src=I.FDirect rs, dst=I.FDirect rd, ...} => ([rd], [rs])
| _ => error "memMove: INSTR"
(*esac*))
| memMove _ = error "memMove"
val nop = fn () => I.nop
(*========================================================================
* Parallel Move
*========================================================================*)
fun moveTmpR(I.ANNOTATION{i,...}) = moveTmpR i
| moveTmpR(I.COPY{k=CB.GP, tmp=SOME(I.Direct (_, r)), ...}) = SOME r
| moveTmpR(I.COPY{k=CB.FP, tmp=SOME(I.FDirect f), ...}) = SOME f
| moveTmpR(I.COPY{k=CB.FP, tmp=SOME(I.FPR f), ...}) = SOME f
| moveTmpR _ = NONE
fun moveDstSrc(I.ANNOTATION{i,...}) = moveDstSrc i
| moveDstSrc(I.COPY{src, dst, ...}) = (dst, src)
| moveDstSrc(I.INSTR i) =
(case i
of (*I.MOVE{src=I.Direct rs, dst=I.MemReg rd, ...} => ([rd], [rs])
| I.MOVE{src=I.MemReg rs, dst=I.Direct rd, ...} => ([rd], [rs])
| *) I.FMOVE{src=I.FPR rs, dst=I.FPR rd, ...} => ([rd], [rs])
| I.FMOVE{src=I.FDirect rs, dst=I.FPR rd, ...} => ([rd], [rs])
| I.FMOVE{src=I.FPR rs, dst=I.FDirect rd, ...} => ([rd], [rs])
| I.FMOVE{src=I.FDirect rs, dst=I.FDirect rd, ...} => ([rd], [rs])
| _ => error "moveDstSrc")
| moveDstSrc _ = error "moveDstSrc2"
(*=====================================================================
* Branches and Calls/Returns
*=====================================================================*)
fun branchTargets(I.ANNOTATION{i,...}) = branchTargets i
| branchTargets(I.INSTR i) =
(case i
of I.JMP(_, []) => [ESCAPES]
| I.JMP(_, labs) => map LABELLED labs
| I.RET _ => [ESCAPES]
| I.JCC{opnd=I.ImmedLabel(T.LABEL(lab)), ...} =>
[FALLTHROUGH, LABELLED lab]
| I.CALL{cutsTo, ...} => FALLTHROUGH :: map LABELLED cutsTo
| I.CALLQ{cutsTo, ...} => FALLTHROUGH :: map LABELLED cutsTo
| I.INTO => [ESCAPES]
| _ => error "branchTargets")
| branchTargets _ = error "branchTargets"
fun jump label = I.jmp (I.ImmedLabel(T.LABEL label), [label])
exception NotImplemented
fun setJumpTarget(I.ANNOTATION{a,i}, l) = I.ANNOTATION{a=a, i=setJumpTarget(i,l)}
| setJumpTarget(I.INSTR(I.JMP(I.ImmedLabel _, _)), lab) = jump lab
| setJumpTarget _ = error "setJumpTarget"
fun setBranchTargets{i=I.ANNOTATION{a,i}, t, f} =
I.ANNOTATION{a=a, i=setBranchTargets{i=i, t=t, f=f}}
| setBranchTargets{i=I.INSTR(I.JCC{cond,opnd=I.ImmedLabel _}), t, ...} =
I.jcc{cond=cond,opnd=I.ImmedLabel(T.LABEL t)}
| setBranchTargets _ = error "setBranchTargets"
fun negateConditional (I.ANNOTATION{i,a}, lab) =
I.ANNOTATION{i=negateConditional(i,lab), a=a}
| negateConditional (I.INSTR(I.JCC{cond,opnd=I.ImmedLabel(T.LABEL _)}), lab) =
let
val cond' = (case cond
of I.EQ => I.NE
| I.NE => I.EQ
| I.LT => I.GE
| I.LE => I.GT
| I.GT => I.LE
| I.GE => I.LT
| I.B => I.AE
| I.BE => I.A
| I.A => I.BE
| I.AE => I.B
| I.C => I.NC
| I.NC => I.C
| I.P => I.NP
| I.NP => I.P
| I.O => I.NO
| I.NO => I.O
(* end case *))
in
I.INSTR(I.JCC{cond=cond', opnd=I.ImmedLabel(T.LABEL lab)})
end
| negateConditional _ = error "negateConditional"
val immedRange={lo= ~1073741824, hi=1073741823}
val toInt32 = Int32.fromLarge o Int.toLarge
(* immediate values are restricted to 32 bits, and are zero extended by MOVL *)
fun loadImmed{immed,t} =
I.move{mvOp=I.MOVL,src=I.Immed(toInt32 immed),dst=I.Direct (32, t)}
fun loadOperand{opn,t} = I.move{mvOp=I.MOVQ,src=opn,dst=I.Direct (64, t)}
(*=====================================================================
* Hashing and Equality on operands
*=====================================================================*)
fun hashOpn(I.Immed i) = Word.fromInt(Int32.toInt i)
| hashOpn(I.ImmedLabel le) = MLTreeHash.hash le + 0w123
| hashOpn(I.Relative i) = Word.fromInt i + 0w1232
| hashOpn(I.LabelEA le) = MLTreeHash.hash le + 0w44444
| hashOpn(I.Direct (_, r)) = CB.hashCell r
(* | hashOpn(I.MemReg r) = CB.hashCell r + 0w2123*)
| hashOpn(I.ST f) = CB.hashCell f + 0w88
| hashOpn(I.FPR f) = CB.hashCell f + 0w881
| hashOpn(I.FDirect f) = CB.hashCell f + 0w31245
| hashOpn(I.Displace {base, disp, ...}) =
hashOpn disp + CB.hashCell base
| hashOpn(I.Indexed {base, index, scale, disp, ...}) =
CB.hashCell index + Word.fromInt scale + hashOpn disp
fun eqOpn(I.Immed a,I.Immed b) = a = b
| eqOpn(I.ImmedLabel a,I.ImmedLabel b) = MLTreeEval.==(a,b)
| eqOpn(I.Relative a,I.Relative b) = a = b
| eqOpn(I.LabelEA a,I.LabelEA b) = MLTreeEval.==(a,b)
| eqOpn(I.Direct (_,a),I.Direct (_,b)) = CB.sameColor(a,b)
(* | eqOpn(I.MemReg a,I.MemReg b) = CB.sameColor(a,b)*)
| eqOpn(I.FDirect a,I.FDirect b) = CB.sameColor(a,b)
| eqOpn(I.ST a,I.ST b) = CB.sameColor(a,b)
| eqOpn(I.FPR a,I.FPR b) = CB.sameColor(a,b)
| eqOpn(I.Displace{base=a,disp=b,...},I.Displace{base=c,disp=d,...}) =
CB.sameColor(a,c) andalso eqOpn(b,d)
| eqOpn(I.Indexed{base=a,index=b,scale=c,disp=d,...},
I.Indexed{base=e,index=f,scale=g,disp=h,...}) =
CB.sameColor(b,f) andalso c = g
andalso sameCellOption(a,e) andalso eqOpn(d,h)
| eqOpn _ = false
and sameCellOption(NONE, NONE) = true
| sameCellOption(SOME x, SOME y) = CB.sameColor(x,y)
| sameCellOption _ = false
(*========================================================================
* Definition and use (for register allocation mainly)
*========================================================================*)
val raxPair = [C.rdx, C.rax]
fun defUseR instr = let
fun operandAcc(I.Direct (_,r), acc) = r::acc
(* | operandAcc(I.MemReg r, acc) = r::acc*)
| operandAcc(I.Displace{base, ...}, acc) = base::acc
| operandAcc(I.Indexed{base=SOME b, index, ...}, acc) = b::index::acc
| operandAcc(I.Indexed{base=NONE, index, ...}, acc) = index::acc
| operandAcc(_, acc) = acc
fun amd64DefUseR instr = let
fun operandUse opnd = operandAcc(opnd, [])
fun operandUse2(src1, src2) = ([], operandAcc(src1, operandUse src2))
fun operandUse3(x, y, z) = ([], operandAcc(x, operandAcc(y, operandUse y)))
fun operandDef(I.Direct (_,r)) = [r]
(* | operandDef(I.MemReg r) = [r]*)
| operandDef _ = []
fun multdiv{src, multDivOp} = let
val uses = operandUse src
in
case multDivOp
of (I.IDIVL1 | I.DIVL1 | I.IDIVQ1 | I.DIVQ1) => (raxPair, C.rdx::C.rax::uses)
| (I.IMULL1 | I.MULL1 | I.IMULQ1 | I.MULQ1) => (raxPair, C.rax::uses)
end
fun unary opnd = (operandDef opnd, operandUse opnd)
fun cmptest{lsrc, rsrc} = ([], operandAcc(lsrc, operandUse rsrc))
fun rspOnly() = let val sp = [C.stackptrR] in (sp, sp) end
fun push arg = ([C.stackptrR], operandAcc(arg, [C.stackptrR]))
fun float opnd = ([], operandUse opnd)
in
case instr
of I.JMP(opnd, _) => ([], operandUse opnd)
| I.JCC{opnd, ...} => ([], operandUse opnd)
| I.CALL{opnd,defs,uses,...} =>
(C.getReg defs, operandAcc(opnd, C.getReg uses))
| I.CALLQ{opnd,defs,uses,...} =>
(C.getReg defs, operandAcc(opnd, C.getReg uses))
| I.MOVE{src, dst=I.Direct (_,r), ...} => ([r], operandUse src)
(* | I.MOVE{src, dst=I.MemReg r, ...} => ([r], operandUse src)*)
| I.MOVE{src, dst, ...} => ([], operandAcc(dst, operandUse src))
| I.LEA{r32, addr} => ([r32], operandUse addr)
| I.LEAQ{r64, addr} => ([r64], operandUse addr)
| ( I.CMPQ arg | I.CMPL arg | I.CMPW arg | I.CMPB arg
| I.TESTQ arg | I.TESTL arg | I.TESTW arg | I.TESTB arg ) => cmptest arg
| I.BITOP{lsrc, rsrc, ...} => cmptest{lsrc=lsrc,rsrc=rsrc}
| I.BINARY{binOp=I.XORL,src=I.Direct (_,rs),dst=I.Direct (_,rd),...} =>
if CB.sameColor(rs,rd) then ([rd],[]) else ([rd],[rs,rd])
| I.BINARY{binOp=I.XORQ,src=I.Direct (_,rs),dst=I.Direct (_,rd),...} =>
if CB.sameColor(rs,rd) then ([rd],[]) else ([rd],[rs,rd])
| I.BINARY{src,dst,...} =>
(operandDef dst, operandAcc(src, operandUse dst))
| I.SHIFT{src,dst,count,...} =>
(operandDef dst,
operandAcc(count, operandAcc(src, operandUse dst)))
| I.CMPXCHG{src, dst, ...} =>
(C.rax::operandDef dst, C.rax::operandAcc(src, operandUse dst))
| I.ENTER _ => ([C.rsp, C.rbp], [C.rsp, C.rbp])
| I.LEAVE => ([C.rsp, C.rbp], [C.rsp, C.rbp])
| I.MULTDIV arg => multdiv arg
| I.MUL3{src1, dst, ...}=> ([dst], operandUse src1)
| I.MULQ3{src1, dst, ...}=> ([dst], operandUse src1)
| I.UNARY{opnd, ...} => unary opnd
| I.SET{opnd, ...} => unary opnd
| (I.PUSHQ arg | I.PUSHL arg | I.PUSHW arg | I.PUSHB arg ) => push arg
| I.POP arg => (C.stackptrR::operandDef arg, [C.stackptrR])
| I.PUSHFD => rspOnly()
| I.POPFD => rspOnly()
| I.CDQ => ([C.rdx], [C.rax])
| I.FSTPT opnd => float opnd
| I.FSTPL opnd => float opnd
| I.FSTPS opnd => float opnd
| I.FSTL opnd => float opnd
| I.FSTS opnd => float opnd
| I.FLDL opnd => float opnd
| I.FLDS opnd => float opnd
| I.FILD opnd => float opnd
| I.FILDL opnd => float opnd
| I.FILDLL opnd => float opnd
| I.FBINARY{src, ...} => ([], operandUse src)
| I.FIBINARY{src, ...} => ([], operandUse src)
| I.FENV{opnd, ...} => ([], operandUse opnd)
| I.FNSTSW => ([C.rax], [])
| I.FUCOM opnd => float opnd
| I.FUCOMP opnd => float opnd
| I.FCOMI opnd => float opnd
| I.FCOMIP opnd => float opnd
| I.FUCOMI opnd => float opnd
| I.FUCOMIP opnd => float opnd
| I.FMOVE{src, dst, ...} => operandUse2(src, dst)
| I.FILOAD{ea, dst, ...} => operandUse2(ea, dst)
| I.FCMP{lsrc, rsrc, ...} => operandUse2(lsrc, rsrc)
| I.FBINOP{lsrc, rsrc, dst, ...} => operandUse3(lsrc, rsrc, dst)
| I.FIBINOP{lsrc, rsrc, dst, ...} => operandUse3(lsrc, rsrc, dst)
| I.FUNOP{src, dst, ...} => operandUse2(src, dst)
| I.SAHF => ([], [C.rax])
| I.LAHF => ([C.rax], [])
(* This sets the low order byte,
* do potentially it may define *and* use
*)
| I.CMOV{src,dst,...} => ([dst], operandAcc(src, [dst]))
| I.CMOVQ{src,dst,...} => ([dst], operandAcc(src, [dst]))
| _ => ([], [])
end
in
case instr
of I.ANNOTATION{i, ...} => defUseR i
| I.LIVE{regs, ...} => ([], C.getReg regs)
| I.KILL{regs, ...} => (C.getReg regs, [])
| I.COPY{k=CB.GP, dst, src, tmp, ...} =>
(case tmp
of NONE => (dst, src)
| SOME(I.Direct (_,r)) => (r::dst, src)
(* | SOME(I.MemReg r) => (r::dst, src)*)
| SOME(ea) => (dst, operandAcc(ea, src))
(*esac*))
| I.COPY _ => ([], [])
| I.INSTR i => amd64DefUseR(i)
end
fun defUseF instr = let
fun amd64DefUseF instr = let
fun operand(I.FDirect f) = [f]
| operand(I.FPR f) = [f]
| operand _ = []
fun operandAcc(I.FDirect f, acc) = f::acc
| operandAcc(I.FPR f, acc) = f::acc
| operandAcc(_ , acc) = acc
fun fbinop(lsrc, rsrc, dst) =
let val def = operand dst
val use = operandAcc(lsrc, operand rsrc)
in (def, use)
end
val fcmpTmp = [C.ST 0]
in
case instr
of I.FSTPT opnd => (operand opnd, [])
| I.FSTPL opnd => (operand opnd, [])
| I.FSTPS opnd => (operand opnd, [])
| I.FSTL opnd => (operand opnd, [])
| I.FSTS opnd => (operand opnd, [])
| I.FLDT opnd => ([], operand opnd)
| I.FLDL opnd => ([], operand opnd)
| I.FLDS opnd => ([], operand opnd)
| I.FUCOM opnd => ([], operand opnd)
| I.FUCOMP opnd => ([], operand opnd)
| I.FCOMI opnd => ([], operand opnd)
| I.FCOMIP opnd => ([], operand opnd)
| I.FUCOMI opnd => ([], operand opnd)
| I.FUCOMIP opnd => ([], operand opnd)
| I.CALL{defs, uses, ...} => (C.getFreg defs, C.getFreg uses)
| I.CALLQ{defs, uses, ...} => (C.getFreg defs, C.getFreg uses)
| I.FBINARY{dst, src, ...}=> (operand dst, operand dst @ operand src)
| I.FMOVE{src, dst, ...} => (operand dst, operand src)
| I.FILOAD{ea, dst, ...} => (operand dst, [])
| I.FCMP{lsrc, rsrc, ...} => (fcmpTmp, operandAcc(lsrc, operand rsrc))
| I.FBINOP{lsrc, rsrc, dst, ...} => fbinop(lsrc, rsrc, dst)
| I.FIBINOP{lsrc, rsrc, dst, ...} => fbinop(lsrc, rsrc, dst)
| I.FUNOP{src, dst, ...} => (operand dst, operand src)
| _ => ([], [])
end
in
case instr
of (I.ANNOTATION{i, ...}) => defUseF(i)
| I.LIVE{regs, ...} => ([], C.getFreg regs)
| I.KILL{regs, ...} => (C.getFreg regs, [])
| I.COPY{k=CB.FP, dst, src, tmp, ...} =>
(case tmp
of NONE => (dst, src)
| SOME(I.FDirect f) => (f::dst, src)
| SOME(I.FPR f) => (f::dst, src)
| _ => (dst, src)
(*esac*))
| I.COPY _ => ([], [])
| (I.INSTR i) => amd64DefUseF(i)
end
fun defUse CB.GP = defUseR
| defUse CB.FP = defUseF
| defUse _ = error "defUse"
(*========================================================================
* Annotations
*========================================================================*)
fun getAnnotations(I.ANNOTATION{i,a}) =
let val (i,an) = getAnnotations i in (i,a::an) end
| getAnnotations i = (i,[])
fun annotate(i,a) = I.ANNOTATION{i=i,a=a}
(*========================================================================
* Replicate an instruction
*========================================================================*)
fun replicate(I.ANNOTATION{i,a}) = I.ANNOTATION{i=replicate i,a=a}
(*
| replicate(I.COPY{tmp=SOME _, dst, src}) =
I.COPY{tmp=SOME(I.Direct(C.newReg())), dst=dst, src=src}
| replicate(I.FCOPY{tmp=SOME _, dst, src}) =
I.FCOPY{tmp=SOME(I.FDirect(C.newFreg())), dst=dst, src=src}
*)
| replicate i = i
end
--- NEW FILE: amd64Shuffle.sig ---
signature AMD64SHUFFLE = sig
structure I : AMD64INSTR
type t = {tmp:I.operand option, dst:CellsBasis.cell list, src:CellsBasis.cell list}
val shuffle : t -> I.instruction list
val shufflefp : t -> I.instruction list
end
--- NEW FILE: amd64Shuffle.sml ---
(* NOTE on xchg on the amd64
*
* From Allen Leung:
* Here's why I didn't use xchg:
*
* o According to the optimization guide xchg mem, reg is complex,
* cannot be pipelined or paired at all. xchg reg, reg requires 3 uops.
* In contrast, mov mem, reg requires 1 or 2 uops.
* So xchgs loses out, at least on paper.
* [I haven't done any measurements though]
*
* o Secondly, unlike other architectures, parallel copies are split
* into individual copies during instruction selection. Here's why
* I did this: I found that more copies are retained and more spills
* are generated when keeping the parallel copies. My guess on this is
* that the copy temporary for parallel copies create addition
* interferences [even when they are not needed.]
* This is not a problem on RISC machines, because of plentiful registers.
*
* o Spilling of parallel copies is also a very complex business when
* memory coalescing is turned on. I think I have implemented a solution
* to this, but not using parallel copies keep life simple. This problem
* could be simpler with xchg...but I haven't thought about it much.
*
* From Fermin Reig:
* In the java-/[email protected], GC mailing lists there's been a discussion about
* the costs of xcgh. Here's some extracts of it:
*
* ----------------
* > From: Emery Berger [mailto:[email protected]]
* >
* > http://developer.intel.com/design/pentium4/manuals/24547203.pdf
* >
* > See Chapter 7.1. "For the P6 family processors, locked
* > operations serialize
* > all outstanding load and store operations (that is, wait for them to
* > complete). This rule is also true for the Pentium 4
* > processor, with one
* > exception: load operations that reference weakly ordered
* > memory types (such
* > as the WC memory type) may not be serialized. "
* >
* -----------------
* I just tried this on a 500 MHz Pentium III. I get about 23 cycles for
*
* lock; cmpxchg
*
* :
* and about 19 or 20 cycles for xchg (which has an implicit lock prefix).
*
* I got consistent results by timing a loop and by looking at an instruction
* level profile. Putting other stuff in the loop didn't seem to affect the
* time taken by xchg much. Here's the code in case someone else wants to try.
* (This requires Linux/gcc)
* -------------------
* Chris Dodd pointed out on the GC mailing list that on recent Intel AMD64
* processors:
*
* - cmpxchg without a lock prefix is much faster (roughly 3x or close to 15
* cycles by my measurements) than either xchg (implied lock prefix) or lock;
* cmpxchg .
*
* - cmpxchg without the lock prefix is atomic on uniprocessors, i.e. it's not
* interruptable.
*
* As far as I can tell, none of the GNU libraries currently take advantage of
* this fact. Should they?
*
* This argues, for example, that I could get noticable additional speedup from
* Java hash synchronization on AMD64 by overwriting a few strategic "lock"
* prefixes with "nop"s when I notice that there's only one processor
*
*
* From John Reppy:
*
* Disregard what I said. The xchg instruction has an implicit lock prefix,
* so it is not useful for normal programming tasks.
*)
functor AMD64Shuffle(I : AMD64INSTR) : AMD64SHUFFLE =
struct
structure I = I
structure C = I.C
structure CB = CellsBasis
structure Shuffle = Shuffle(I)
type t = {tmp:I.operand option, dst:CellsBasis.cell list, src:CellsBasis.cell list}
exception foo
val shuffle =Shuffle.shuffle
{mvInstr=fn{dst, src} => [I.move{mvOp=I.MOVQ, src=src, dst=dst}],
ea=fn r => I.Direct (64, r)}
(*
* These assume that the ''registers'' are mapped onto the memory
*)
(* Note, this only works with double precision floating point *)
val shufflefpNormalAndSlow =
Shuffle.shuffle
{mvInstr=fn{dst, src} => [I.fldl src, I.fstpl dst],
ea = I.FDirect}
(*
* This version makes use of the amd64 floating point stack for hardware
* renaming!
*)
fun shufflefpNormal{tmp, src, dst} = let
val n = length src
in
if n <= 7 then let
fun gen(s::ss, d::ds, pushes, pops) =
if CB.sameColor(s,d) then gen(ss, ds, pushes, pops)
else
gen(ss, ds,
I.fldl(I.FDirect s)::pushes,
I.fstpl(I.FDirect d)::pops)
| gen(_, _, pushes, pops) = List.revAppend(pushes, pops)
in gen(src, dst, [], [])
end
else shufflefpNormalAndSlow{tmp=tmp, src=src, dst=dst}
end
(*
* These assume that the ''registers'' are mapped onto the pseudo
* %fpr register. Only works with double precision floating point for
* now...
*)
val shufflefpFast =
Shuffle.shuffle
{mvInstr=fn{dst, src} => [I.fmove{fsize=I.FP64,src=src, dst=dst}],
ea = I.FPR}
fun shufflefp(x as {tmp=SOME(I.FPR _), ...}) = shufflefpFast x
| shufflefp x = shufflefpNormal x
end
--- NEW FILE: amd64comp-instr-ext.sml ---
(* amd64comp-instr-ext.sml
*
* COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
*
* emit code for extensions to the amd64 instruction set.
*)
signature AMD64COMP_INSTR_EXT = sig
structure I : AMD64INSTR
structure TS : MLTREE_STREAM
where T = I.T
structure CFG : CONTROL_FLOW_GRAPH
where I = I
and P = TS.S.P
type reducer =
(I.instruction, I.C.cellset, I.operand, I.addressing_mode, CFG.cfg) TS.reducer
val compileSext :
reducer
-> {stm: (I.T.stm, I.T.rexp, I.T.fexp, I.T.ccexp) AMD64InstrExt.sext,
an: I.T.an list}
-> unit
end
functor AMD64CompInstrExt
( structure I : AMD64INSTR
structure TS : MLTREE_STREAM
where T = I.T
structure CFG : CONTROL_FLOW_GRAPH
where P = TS.S.P
and I = I
) : AMD64COMP_INSTR_EXT =
struct
structure CFG = CFG
structure T = TS.T
structure I = I
structure C = I.C
structure X = AMD64InstrExt
structure TS = TS
type stm = (T.stm, T.rexp, T.fexp, T.ccexp) X.sext
type reducer =
(I.instruction, I.C.cellset, I.operand, I.addressing_mode, CFG.cfg) TS.reducer
val esp = C.esp
val espOpnd = I.Direct(esp)
fun error msg = MLRiscErrorMsg.error("AMD64CompInstrExt", msg)
val stackArea = I.Region.stack
fun compileSext reducer {stm: stm, an:T.an list} = let
val TS.REDUCER{operand, emit, reduceFexp, instrStream, reduceOperand,
...} = reducer
val TS.S.STREAM{emit=emitI, ...} = instrStream
fun fstp(sz, fstpInstr, fexp) =
(case fexp
of T.FREG(sz', f) =>
if sz <> sz' then error "fstp: sz"
else emitI(I.INSTR(fstpInstr(I.FDirect f)))
| _ => error "fstp: fexp"
(*esac*))
in
case stm
of X.PUSHL(rexp) => emit(I.pushl(operand rexp), an)
| X.POP(rexp) => emit(I.pop(operand rexp), an)
| X.FSTPS(fexp) => fstp(32, I.FSTPS, fexp)
| X.FSTPL(fexp) => fstp(64, I.FSTPL, fexp)
| X.FSTPT(fexp) => fstp(80, I.FSTPT, fexp)
| X.LEAVE => emit(I.leave, an)
| X.RET(rexp) => emit(I.ret(SOME(operand rexp)), an)
| X.LOCK_CMPXCHGL(src, dst) =>
(* src must in a register *)
emit(I.cmpxchg{lock=true,sz=I.I32,
src=I.Direct(reduceOperand(operand src)),
dst=operand dst},an)
end
end
--- NEW FILE: amd64instr-ext.sml ---
(* amd64instr-ext.sml
*
* COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
*
* extensions to the amd64 instruction set.
*)
structure AMD64InstrExt = struct
datatype fsz = single | double | extended
datatype ('s, 'r, 'f, 'c) sext
(* push an integer value onto the H/W stack *)
= PUSHL of 'r
| POP of 'r
(* FSTPS/L/T is a way of pulling things off the floating point
* stack and must therefore take FREG f as argument
*)
| FSTPS of 'f
| FSTPL of 'f
| FSTPT of 'f
| LEAVE
| RET of 'r
| LOCK_CMPXCHGL of ('r * 'r)
end
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys -- and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV