[MLton-commit] r5885
Matthew Fluet
fluet at mlton.org
Wed Aug 15 19:49:19 PDT 2007
Eliminate SML/NJ extensions from AMD64 portions of MLRISC
----------------------------------------------------------------------
U mlton/trunk/lib/ckit-lib/ckit.patch
U mlton/trunk/lib/mlrisc-lib/MLRISC.patch
U mlton/trunk/lib/smlnj-lib/smlnj-lib.patch
----------------------------------------------------------------------
Modified: mlton/trunk/lib/ckit-lib/ckit.patch
===================================================================
--- mlton/trunk/lib/ckit-lib/ckit.patch 2007-08-15 18:24:55 UTC (rev 5884)
+++ mlton/trunk/lib/ckit-lib/ckit.patch 2007-08-16 02:49:12 UTC (rev 5885)
@@ -523,7 +523,7 @@
, List.map (functionArgConv tidtab) argl
diff -N -C 2 -r ckit/src/ckit-lib.mlb ckit-mlton/src/ckit-lib.mlb
*** ckit/src/ckit-lib.mlb 1969-12-31 18:00:00.000000000 -0600
---- ckit-mlton/src/ckit-lib.mlb 2007-08-12 21:28:57.000000000 -0500
+--- ckit-mlton/src/ckit-lib.mlb 2007-08-15 21:45:10.000000000 -0500
***************
*** 0 ****
--- 1,888 ----
Modified: mlton/trunk/lib/mlrisc-lib/MLRISC.patch
===================================================================
--- mlton/trunk/lib/mlrisc-lib/MLRISC.patch 2007-08-15 18:24:55 UTC (rev 5884)
+++ mlton/trunk/lib/mlrisc-lib/MLRISC.patch 2007-08-16 02:49:12 UTC (rev 5885)
@@ -944,6 +944,1666 @@
! | T.LABEXP _ => (T.Basis.swapCond cond,e2,e1)
| _ => (cond,e1,e2)
in case cond of
+diff -N -C 2 -r MLRISC/amd64/amd64MC.sml MLRISC-mlton/amd64/amd64MC.sml
+*** MLRISC/amd64/amd64MC.sml 2007-05-29 16:02:35.000000000 -0500
+--- MLRISC-mlton/amd64/amd64MC.sml 2007-08-15 21:13:01.000000000 -0500
+***************
+*** 1,7 ****
+ functor AMD64MCEmitter
+ (structure Instr : AMD64INSTR
+! structure Shuffle : AMD64SHUFFLE where I = Instr
+! structure MLTreeEval : MLTREE_EVAL where T = Instr.T
+! structure AsmEmitter : INSTRUCTION_EMITTER where I = Instr) : MC_EMIT =
+ struct
+ structure I = Instr
+--- 1,68 ----
+ functor AMD64MCEmitter
+ (structure Instr : AMD64INSTR
+! structure Shuffle : AMD64SHUFFLE (* where I = Instr *)
+! where type I.Constant.const = Instr.Constant.const
+! and type I.Region.region = Instr.Region.region
+! and type I.T.Basis.cond = Instr.T.Basis.cond
+! and type I.T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type I.T.Basis.ext = Instr.T.Basis.ext
+! and type I.T.Basis.fcond = Instr.T.Basis.fcond
+! and type I.T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type ('s,'r,'f,'c) I.T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) I.T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) I.T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) I.T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type I.T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type I.T.ccexp = Instr.T.ccexp
+! and type I.T.fexp = Instr.T.fexp
+! (* and type I.T.labexp = Instr.T.labexp *)
+! and type I.T.mlrisc = Instr.T.mlrisc
+! and type I.T.oper = Instr.T.oper
+! and type I.T.rep = Instr.T.rep
+! and type I.T.rexp = Instr.T.rexp
+! and type I.T.stm = Instr.T.stm
+! (* and type I.addressing_mode = Instr.addressing_mode *)
+! and type I.binaryOp = Instr.binaryOp
+! and type I.bitOp = Instr.bitOp
+! and type I.cond = Instr.cond
+! and type I.fbin_op = Instr.fbin_op
+! and type I.fcom_op = Instr.fcom_op
+! and type I.fmove_op = Instr.fmove_op
+! and type I.fsize = Instr.fsize
+! and type I.instr = Instr.instr
+! and type I.instruction = Instr.instruction
+! and type I.isize = Instr.isize
+! and type I.move = Instr.move
+! and type I.multDivOp = Instr.multDivOp
+! and type I.operand = Instr.operand
+! and type I.shiftOp = Instr.shiftOp
+! and type I.unaryOp = Instr.unaryOp
+! structure MLTreeEval : MLTREE_EVAL (* where T = Instr.T *)
+! where type T.Basis.cond = Instr.T.Basis.cond
+! and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type T.Basis.ext = Instr.T.Basis.ext
+! and type T.Basis.fcond = Instr.T.Basis.fcond
+! and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type T.Constant.const = Instr.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type T.Region.region = Instr.T.Region.region
+! and type T.ccexp = Instr.T.ccexp
+! and type T.fexp = Instr.T.fexp
+! (* and type T.labexp = Instr.T.labexp *)
+! and type T.mlrisc = Instr.T.mlrisc
+! and type T.oper = Instr.T.oper
+! and type T.rep = Instr.T.rep
+! and type T.rexp = Instr.T.rexp
+! and type T.stm = Instr.T.stm
+! structure AsmEmitter : INSTRUCTION_EMITTER (* where I = Instr *)
+! where type I.addressing_mode = Instr.addressing_mode
+! and type I.ea = Instr.ea
+! and type I.instr = Instr.instr
+! and type I.instruction = Instr.instruction
+! and type I.operand = Instr.operand) : MC_EMIT =
+ struct
+ structure I = Instr
+***************
+*** 328,332 ****
+ | I.SARQ => shift(64, 7, src)
+ | I.SHRQ => shift(64, 5, src)
+! | (I.IMULL | I.MULQ) =>
+ let val sz = if binOp = I.IMULQ then 64 else 32
+ in (case (src, dst)
+--- 389,407 ----
+ | I.SARQ => shift(64, 7, src)
+ | I.SHRQ => shift(64, 5, src)
+! | (I.IMULL) =>
+! let val sz = if binOp = I.IMULQ then 64 else 32
+! in (case (src, dst)
+! of (I.Immed(i), I.Direct (_, dstR)) =>
+! (case size i
+! of Bits32 =>
+! encodeLongImm sz (0wx69, reg (rNum dstR), dst, i)
+! | _ => encodeByteImm sz (0wx6b, reg (rNum dstR), dst, i)
+! (* esac *))
+! | (_, I.Direct (_, dstR)) =>
+! eBytes (encode32' ([0wx0f, 0wxaf], reg (rNum dstR), src))
+! | _ => error "imul"
+! (* esac *))
+! end
+! | (I.MULQ) =>
+ let val sz = if binOp = I.IMULQ then 64 else 32
+ in (case (src, dst)
+***************
+*** 380,396 ****
+ | I.CDQ => eByte(0x99)
+ | I.SAHF => eByte(0x9e)
+! | ( I.PUSHL (I.Immed i) | I.PUSHQ (I.Immed i) )=>
+ (case size i
+ of Bits32 => eBytes(0wx68 :: eLong(i))
+ | _ => eBytes [0wx6a, toWord8 i]
+ (* esac *))
+! | ( I.PUSHL (I.Direct (_, r)) |
+! I.PUSHQ (I.Direct (_, r)) ) => eByte (0x50+rNum r)
+! | ( I.PUSHL opnd | I.PUSHQ opnd ) => encode32 (0wxff, opcode 6, opnd)
+ | I.POP (I.Direct (_, r)) => eByte (0x58+rNum r)
+ | I.POP opnd => encode32 (0wx8f, opcode 0, opnd)
+ | I.LEAL{r32, addr} => encodeReg32(0wx8d, r32, addr)
+ | I.LEAQ{r64, addr} => encodeReg64(0wx8d, r64, addr)
+! | I.MOVE{mvOp=mvOp as (I.MOVL | I.MOVQ), src, dst} =>
+ let val sz = case mvOp of I.MOVL => 32 | I.MOVQ => 64
+ fun mv(I.Immed(i), I.Direct (_, r)) =
+--- 455,486 ----
+ | I.CDQ => eByte(0x99)
+ | I.SAHF => eByte(0x9e)
+! | ( I.PUSHL (I.Immed i) )=>
+ (case size i
+ of Bits32 => eBytes(0wx68 :: eLong(i))
+ | _ => eBytes [0wx6a, toWord8 i]
+ (* esac *))
+! | ( I.PUSHQ (I.Immed i) )=>
+! (case size i
+! of Bits32 => eBytes(0wx68 :: eLong(i))
+! | _ => eBytes [0wx6a, toWord8 i]
+! (* esac *))
+! | ( I.PUSHL (I.Direct (_, r)) ) => eByte (0x50+rNum r)
+! | ( I.PUSHQ (I.Direct (_, r)) ) => eByte (0x50+rNum r)
+! | ( I.PUSHL opnd ) => encode32 (0wxff, opcode 6, opnd)
+! | ( I.PUSHQ opnd ) => encode32 (0wxff, opcode 6, opnd)
+ | I.POP (I.Direct (_, r)) => eByte (0x58+rNum r)
+ | I.POP opnd => encode32 (0wx8f, opcode 0, opnd)
+ | I.LEAL{r32, addr} => encodeReg32(0wx8d, r32, addr)
+ | I.LEAQ{r64, addr} => encodeReg64(0wx8d, r64, addr)
+! | I.MOVE{mvOp=mvOp as (I.MOVL), src, dst} =>
+! let val sz = case mvOp of I.MOVL => 32 | I.MOVQ => 64
+! fun mv(I.Immed(i), I.Direct (_, r)) =
+! eBytes(Word8.+(0wxb8, Word8.fromInt(rNum r))::eLong(i))
+! | mv(I.Immed(i), _) = encodeLongImm sz (0wxc7, opcode 0, dst, i)
+! | mv(I.ImmedLabel le,dst) = mv(I.Immed(lexp le),dst)
+! | mv(I.LabelEA le,dst) = error "MOVL: LabelEA"
+! | mv(src,dst) = arith(sz, 0wx88, opcode 0) (src, dst)
+! in mv(src,dst) end
+! | I.MOVE{mvOp=mvOp as (I.MOVQ), src, dst} =>
+ let val sz = case mvOp of I.MOVL => 32 | I.MOVQ => 64
+ fun mv(I.Immed(i), I.Direct (_, r)) =
+***************
+*** 449,453 ****
+ | I.CMPL{lsrc, rsrc} => arith(32, 0wx38, opcode 7) (rsrc, lsrc)
+ | I.CMPQ{lsrc, rsrc} => arith(64, 0wx38, opcode 7) (rsrc, lsrc)
+! | (I.CMPW _ | I.CMPB _) => error "CMP"
+ | I.TESTQ{lsrc, rsrc} => test(64, rsrc, lsrc)
+ | I.TESTL{lsrc, rsrc} => test(32, rsrc, lsrc)
+--- 539,544 ----
+ | I.CMPL{lsrc, rsrc} => arith(32, 0wx38, opcode 7) (rsrc, lsrc)
+ | I.CMPQ{lsrc, rsrc} => arith(64, 0wx38, opcode 7) (rsrc, lsrc)
+! | (I.CMPW _) => error "CMP"
+! | (I.CMPB _) => error "CMP"
+ | I.TESTQ{lsrc, rsrc} => test(64, rsrc, lsrc)
+ | I.TESTL{lsrc, rsrc} => test(32, rsrc, lsrc)
+diff -N -C 2 -r MLRISC/amd64/amd64.mdl MLRISC-mlton/amd64/amd64.mdl
+*** MLRISC/amd64/amd64.mdl 2007-05-30 16:34:40.000000000 -0500
+--- MLRISC-mlton/amd64/amd64.mdl 2007-08-15 21:21:20.000000000 -0500
+***************
+*** 533,537 ****
+ let val n = size fbinOp
+ in case Char.toLower(String.sub(fbinOp,n-1)) of
+! (#"s" | #"l") => String.substring(fbinOp,0,n-1)
+ | _ => fbinOp
+ end
+--- 533,538 ----
+ let val n = size fbinOp
+ in case Char.toLower(String.sub(fbinOp,n-1)) of
+! (#"s") => String.substring(fbinOp,0,n-1)
+! | (#"l") => String.substring(fbinOp,0,n-1)
+ | _ => fbinOp
+ end
+***************
+*** 666,673 ****
+ asm: (case (src,binOp) of
+ (I.Direct _, (* tricky business here for shifts *)
+! (I.SARQ | I.SHRQ | I.SHLQ |
+! I.SARL | I.SHRL | I.SHLL |
+! I.SARW | I.SHRW | I.SHLW |
+! I.SARB | I.SHRB | I.SHLB)) => ``<binOp>\t%cl, <dst>''
+ | _ => ``<binOp>\t<src>, <dst>''
+ )
+--- 667,693 ----
+ asm: (case (src,binOp) of
+ (I.Direct _, (* tricky business here for shifts *)
+! I.SARQ) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHRQ) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHLQ) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SARL) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHRL) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHLL) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SARW) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHRW) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHLW) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SARB) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHRB) => ``<binOp>\t%cl, <dst>''
+! | (I.Direct _, (* tricky business here for shifts *)
+! I.SHLB) => ``<binOp>\t%cl, <dst>''
+ | _ => ``<binOp>\t<src>, <dst>''
+ )
+diff -N -C 2 -r MLRISC/amd64/backpatch/amd64Jumps.sml MLRISC-mlton/amd64/backpatch/amd64Jumps.sml
+*** MLRISC/amd64/backpatch/amd64Jumps.sml 2007-05-29 16:02:35.000000000 -0500
+--- MLRISC-mlton/amd64/backpatch/amd64Jumps.sml 2007-08-13 23:34:12.000000000 -0500
+***************
+*** 6,12 ****
+ functor AMD64Jumps
+ (structure Instr : AMD64INSTR
+! structure Eval : MLTREE_EVAL where T = Instr.T
+! structure Shuffle : AMD64SHUFFLE where I = Instr
+! structure MCEmitter : MC_EMIT where I = Instr) : SDI_JUMPS =
+ struct
+ structure I = Instr
+--- 6,74 ----
+ functor AMD64Jumps
+ (structure Instr : AMD64INSTR
+! structure Eval : MLTREE_EVAL (* where T = Instr.T *)
+! where type T.Basis.cond = Instr.T.Basis.cond
+! and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type T.Basis.ext = Instr.T.Basis.ext
+! and type T.Basis.fcond = Instr.T.Basis.fcond
+! and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type T.Constant.const = Instr.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type T.Region.region = Instr.T.Region.region
+! and type T.ccexp = Instr.T.ccexp
+! and type T.fexp = Instr.T.fexp
+! (* and type T.labexp = Instr.T.labexp *)
+! and type T.mlrisc = Instr.T.mlrisc
+! and type T.oper = Instr.T.oper
+! and type T.rep = Instr.T.rep
+! and type T.rexp = Instr.T.rexp
+! and type T.stm = Instr.T.stm
+! structure Shuffle : AMD64SHUFFLE (* where I = Instr *)
+! where type I.Constant.const = Instr.Constant.const
+! and type I.Region.region = Instr.Region.region
+! and type I.T.Basis.cond = Instr.T.Basis.cond
+! and type I.T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type I.T.Basis.ext = Instr.T.Basis.ext
+! and type I.T.Basis.fcond = Instr.T.Basis.fcond
+! and type I.T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type ('s,'r,'f,'c) I.T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) I.T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) I.T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) I.T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type I.T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type I.T.ccexp = Instr.T.ccexp
+! and type I.T.fexp = Instr.T.fexp
+! (* and type I.T.labexp = Instr.T.labexp *)
+! and type I.T.mlrisc = Instr.T.mlrisc
+! and type I.T.oper = Instr.T.oper
+! and type I.T.rep = Instr.T.rep
+! and type I.T.rexp = Instr.T.rexp
+! and type I.T.stm = Instr.T.stm
+! (* and type I.addressing_mode = Instr.addressing_mode *)
+! and type I.binaryOp = Instr.binaryOp
+! and type I.bitOp = Instr.bitOp
+! and type I.cond = Instr.cond
+! and type I.fbin_op = Instr.fbin_op
+! and type I.fcom_op = Instr.fcom_op
+! and type I.fmove_op = Instr.fmove_op
+! and type I.fsize = Instr.fsize
+! and type I.instr = Instr.instr
+! and type I.instruction = Instr.instruction
+! and type I.isize = Instr.isize
+! and type I.move = Instr.move
+! and type I.multDivOp = Instr.multDivOp
+! and type I.operand = Instr.operand
+! and type I.shiftOp = Instr.shiftOp
+! and type I.unaryOp = Instr.unaryOp
+! structure MCEmitter : MC_EMIT (* where I = Instr *)
+! where type I.addressing_mode = Instr.addressing_mode
+! and type I.ea = Instr.ea
+! and type I.instr = Instr.instr
+! and type I.instruction = Instr.instruction
+! and type I.operand = Instr.operand
+! ) : SDI_JUMPS =
+ struct
+ structure I = Instr
+***************
+*** 40,47 ****
+ | I.MOVE{src, dst, ...} => operand src orelse operand dst
+ | I.LEAL{addr, ...} => operand addr
+! | I.LEAQ{addr, ...} => operand 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.MULTDIV{src, ...} => operand src
+ | I.MUL3{src1, ...} => operand src1
+ | I.MULQ3{src1, ...} => operand src1
+--- 102,115 ----
+ | I.MOVE{src, dst, ...} => operand src orelse operand dst
+ | I.LEAL{addr, ...} => operand addr
+! | I.LEAQ{addr, ...} => operand addr
+! | ( I.CMPQ arg ) => cmptest arg
+! | ( I.CMPL arg ) => cmptest arg
+! | ( I.CMPW arg ) => cmptest arg
+! | ( I.CMPB arg ) => cmptest arg
+! | ( I.TESTQ arg ) => cmptest arg
+! | ( I.TESTL arg ) => cmptest arg
+! | ( I.TESTW arg ) => cmptest arg
+! | ( I.TESTB arg ) => cmptest arg
+! | I.MULTDIV{src, ...} => operand src
+ | I.MUL3{src1, ...} => operand src1
+ | I.MULQ3{src1, ...} => operand src1
+***************
+*** 49,53 ****
+ | I.SET{opnd, ...} => operand opnd
+ | I.CMOV{src, dst, ...} => operand src
+! | (I.PUSHQ opnd | I.PUSHL opnd | I.PUSHW opnd | I.PUSHB opnd) => operand opnd
+ | I.POP opnd => operand opnd
+ | _ => false
+--- 117,124 ----
+ | I.SET{opnd, ...} => operand opnd
+ | I.CMOV{src, dst, ...} => operand src
+! | (I.PUSHQ opnd) => operand opnd
+! | (I.PUSHL opnd) => operand opnd
+! | (I.PUSHW opnd) => operand opnd
+! | (I.PUSHB opnd) => operand opnd
+ | I.POP opnd => operand opnd
+ | _ => false
+diff -N -C 2 -r MLRISC/amd64/emit/amd64Asm.sml MLRISC-mlton/amd64/emit/amd64Asm.sml
+*** MLRISC/amd64/emit/amd64Asm.sml 2007-05-30 16:34:40.000000000 -0500
+--- MLRISC-mlton/amd64/emit/amd64Asm.sml 2007-08-15 21:23:07.000000000 -0500
+***************
+*** 7,16 ****
+
+ functor AMD64AsmEmitter(structure S : INSTRUCTION_STREAM
+! structure Instr : AMD64INSTR
+! where T = S.P.T
+! structure Shuffle : AMD64SHUFFLE
+! where I = Instr
+! structure MLTreeEval : MLTREE_EVAL
+! where T = Instr.T
+ ) : INSTRUCTION_EMITTER =
+ struct
+--- 7,89 ----
+
+ functor AMD64AsmEmitter(structure S : INSTRUCTION_STREAM
+! structure Instr : AMD64INSTR (* where T = S.P.T *)
+! where type T.Basis.cond = S.P.T.Basis.cond
+! and type T.Basis.div_rounding_mode = S.P.T.Basis.div_rounding_mode
+! and type T.Basis.ext = S.P.T.Basis.ext
+! and type T.Basis.fcond = S.P.T.Basis.fcond
+! and type T.Basis.rounding_mode = S.P.T.Basis.rounding_mode
+! and type T.Constant.const = S.P.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) S.P.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) S.P.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) S.P.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) S.P.T.Extension.sx
+! and type T.I.div_rounding_mode = S.P.T.I.div_rounding_mode
+! and type T.Region.region = S.P.T.Region.region
+! and type T.ccexp = S.P.T.ccexp
+! and type T.fexp = S.P.T.fexp
+! (* and type T.labexp = S.P.T.labexp *)
+! and type T.mlrisc = S.P.T.mlrisc
+! and type T.oper = S.P.T.oper
+! and type T.rep = S.P.T.rep
+! and type T.rexp = S.P.T.rexp
+! and type T.stm = S.P.T.stm
+! structure Shuffle : AMD64SHUFFLE (* where I = Instr *)
+! where type I.Constant.const = Instr.Constant.const
+! and type I.Region.region = Instr.Region.region
+! and type I.T.Basis.cond = Instr.T.Basis.cond
+! and type I.T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type I.T.Basis.ext = Instr.T.Basis.ext
+! and type I.T.Basis.fcond = Instr.T.Basis.fcond
+! and type I.T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type ('s,'r,'f,'c) I.T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) I.T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) I.T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) I.T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type I.T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type I.T.ccexp = Instr.T.ccexp
+! and type I.T.fexp = Instr.T.fexp
+! (* and type I.T.labexp = Instr.T.labexp *)
+! and type I.T.mlrisc = Instr.T.mlrisc
+! and type I.T.oper = Instr.T.oper
+! and type I.T.rep = Instr.T.rep
+! and type I.T.rexp = Instr.T.rexp
+! and type I.T.stm = Instr.T.stm
+! (* and type I.addressing_mode = Instr.addressing_mode *)
+! and type I.binaryOp = Instr.binaryOp
+! and type I.bitOp = Instr.bitOp
+! and type I.cond = Instr.cond
+! and type I.fbin_op = Instr.fbin_op
+! and type I.fcom_op = Instr.fcom_op
+! and type I.fmove_op = Instr.fmove_op
+! and type I.fsize = Instr.fsize
+! and type I.instr = Instr.instr
+! and type I.instruction = Instr.instruction
+! and type I.isize = Instr.isize
+! and type I.move = Instr.move
+! and type I.multDivOp = Instr.multDivOp
+! and type I.operand = Instr.operand
+! and type I.shiftOp = Instr.shiftOp
+! and type I.unaryOp = Instr.unaryOp
+! structure MLTreeEval : MLTREE_EVAL (* where T = Instr.T *)
+! where type T.Basis.cond = Instr.T.Basis.cond
+! and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type T.Basis.ext = Instr.T.Basis.ext
+! and type T.Basis.fcond = Instr.T.Basis.fcond
+! and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type T.Constant.const = Instr.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type T.Region.region = Instr.T.Region.region
+! and type T.ccexp = Instr.T.ccexp
+! and type T.fexp = Instr.T.fexp
+! (* and type T.labexp = Instr.T.labexp *)
+! and type T.mlrisc = Instr.T.mlrisc
+! and type T.oper = Instr.T.oper
+! and type T.rep = Instr.T.rep
+! and type T.rexp = Instr.T.rexp
+! and type T.stm = Instr.T.stm
+ ) : INSTRUCTION_EMITTER =
+ struct
+***************
+*** 347,351 ****
+ in
+ (case Char.toLower (String.sub (fbinOp, n - 1)) of
+! (#"s" | #"l") => String.substring (fbinOp, 0, n - 1)
+ | _ => fbinOp
+ )
+--- 420,425 ----
+ in
+ (case Char.toLower (String.sub (fbinOp, n - 1)) of
+! (#"s") => String.substring (fbinOp, 0, n - 1)
+! | (#"l") => String.substring (fbinOp, 0, n - 1)
+ | _ => fbinOp
+ )
+***************
+*** 488,503 ****
+ (case (src, binOp) of
+ (I.Direct _,
+! ( I.SARQ |
+! I.SHRQ |
+! I.SHLQ |
+! I.SARL |
+! I.SHRL |
+! I.SHLL |
+! I.SARW |
+! I.SHRW |
+! I.SHLW |
+! I.SARB |
+! I.SHRB |
+! I.SHLB )) =>
+ ( emit_binaryOp binOp;
+ emit "\t%cl, ";
+--- 562,621 ----
+ (case (src, binOp) of
+ (I.Direct _,
+! ( I.SARQ )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHRQ )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHLQ )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SARL )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHRL )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHLL )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SARW )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHRW )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHLW )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SARB )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHRB )) =>
+! ( emit_binaryOp binOp;
+! emit "\t%cl, ";
+! emit_dst dst )
+! | (I.Direct _,
+! ( I.SHLB )) =>
+ ( emit_binaryOp binOp;
+ emit "\t%cl, ";
+diff -N -C 2 -r MLRISC/amd64/flowgraph/amd64GasPseudoOps.sml MLRISC-mlton/amd64/flowgraph/amd64GasPseudoOps.sml
+*** MLRISC/amd64/flowgraph/amd64GasPseudoOps.sml 2007-05-29 16:02:35.000000000 -0500
+--- MLRISC-mlton/amd64/flowgraph/amd64GasPseudoOps.sml 2007-08-13 23:15:41.000000000 -0500
+***************
+*** 6,10 ****
+ functor AMD64GasPseudoOps
+ ( structure T : MLTREE
+! structure MLTreeEval : MLTREE_EVAL where T = T
+ ) : PSEUDO_OPS_BASIS =
+
+--- 6,30 ----
+ functor AMD64GasPseudoOps
+ ( structure T : MLTREE
+! structure MLTreeEval : MLTREE_EVAL (* where T = T *)
+! where type T.Basis.cond = T.Basis.cond
+! and type T.Basis.div_rounding_mode = T.Basis.div_rounding_mode
+! and type T.Basis.ext = T.Basis.ext
+! and type T.Basis.fcond = T.Basis.fcond
+! and type T.Basis.rounding_mode = T.Basis.rounding_mode
+! and type T.Constant.const = T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) T.Extension.sx
+! and type T.I.div_rounding_mode = T.I.div_rounding_mode
+! and type T.Region.region = T.Region.region
+! and type T.ccexp = T.ccexp
+! and type T.fexp = T.fexp
+! (* and type T.labexp = T.labexp *)
+! and type T.mlrisc = T.mlrisc
+! and type T.oper = T.oper
+! and type T.rep = T.rep
+! and type T.rexp = T.rexp
+! and type T.stm = T.stm
+ ) : PSEUDO_OPS_BASIS =
+
+diff -N -C 2 -r MLRISC/amd64/instructions/amd64CompInstrExt.sml MLRISC-mlton/amd64/instructions/amd64CompInstrExt.sml
+*** MLRISC/amd64/instructions/amd64CompInstrExt.sml 2007-05-29 16:02:35.000000000 -0500
+--- MLRISC-mlton/amd64/instructions/amd64CompInstrExt.sml 2007-08-15 21:10:59.000000000 -0500
+***************
+*** 7,15 ****
+ 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 =
+--- 7,58 ----
+ signature AMD64COMP_INSTR_EXT = sig
+ structure I : AMD64INSTR
+! structure TS : MLTREE_STREAM (* where T = I.T *)
+! where type T.Basis.cond = I.T.Basis.cond
+! and type T.Basis.div_rounding_mode = I.T.Basis.div_rounding_mode
+! and type T.Basis.ext = I.T.Basis.ext
+! and type T.Basis.fcond = I.T.Basis.fcond
+! and type T.Basis.rounding_mode = I.T.Basis.rounding_mode
+! and type T.Constant.const = I.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) I.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) I.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) I.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) I.T.Extension.sx
+! and type T.I.div_rounding_mode = I.T.I.div_rounding_mode
+! and type T.Region.region = I.T.Region.region
+! and type T.ccexp = I.T.ccexp
+! and type T.fexp = I.T.fexp
+! (* and type T.labexp = I.T.labexp *)
+! and type T.mlrisc = I.T.mlrisc
+! and type T.oper = I.T.oper
+! and type T.rep = I.T.rep
+! and type T.rexp = I.T.rexp
+! and type T.stm = I.T.stm
+! structure CFG : CONTROL_FLOW_GRAPH (* where I = I and P = TS.S.P *)
+! where type I.addressing_mode = I.addressing_mode
+! and type I.ea = I.ea
+! and type I.instr = I.instr
+! and type I.instruction = I.instruction
+! and type I.operand = I.operand
+! where type P.Client.pseudo_op = TS.S.P.Client.pseudo_op
+! and type P.T.Basis.cond = TS.S.P.T.Basis.cond
+! and type P.T.Basis.div_rounding_mode = TS.S.P.T.Basis.div_rounding_mode
+! and type P.T.Basis.ext = TS.S.P.T.Basis.ext
+! and type P.T.Basis.fcond = TS.S.P.T.Basis.fcond
+! and type P.T.Basis.rounding_mode = TS.S.P.T.Basis.rounding_mode
+! and type P.T.Constant.const = TS.S.P.T.Constant.const
+! and type ('s,'r,'f,'c) P.T.Extension.ccx = ('s,'r,'f,'c) TS.S.P.T.Extension.ccx
+! and type ('s,'r,'f,'c) P.T.Extension.fx = ('s,'r,'f,'c) TS.S.P.T.Extension.fx
+! and type ('s,'r,'f,'c) P.T.Extension.rx = ('s,'r,'f,'c) TS.S.P.T.Extension.rx
+! and type ('s,'r,'f,'c) P.T.Extension.sx = ('s,'r,'f,'c) TS.S.P.T.Extension.sx
+! and type P.T.I.div_rounding_mode = TS.S.P.T.I.div_rounding_mode
+! and type P.T.Region.region = TS.S.P.T.Region.region
+! and type P.T.ccexp = TS.S.P.T.ccexp
+! and type P.T.fexp = TS.S.P.T.fexp
+! (* and type P.T.labexp = TS.S.P.T.labexp *)
+! and type P.T.mlrisc = TS.S.P.T.mlrisc
+! and type P.T.oper = TS.S.P.T.oper
+! and type P.T.rep = TS.S.P.T.rep
+! and type P.T.rexp = TS.S.P.T.rexp
+! and type P.T.stm = TS.S.P.T.stm
+
+ type reducer =
+***************
+*** 28,36 ****
+ 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
+--- 71,122 ----
+ functor AMD64CompInstrExt
+ ( structure I : AMD64INSTR
+! structure TS : MLTREE_STREAM (* where T = I.T *)
+! where type T.Basis.cond = I.T.Basis.cond
+! and type T.Basis.div_rounding_mode = I.T.Basis.div_rounding_mode
+! and type T.Basis.ext = I.T.Basis.ext
+! and type T.Basis.fcond = I.T.Basis.fcond
+! and type T.Basis.rounding_mode = I.T.Basis.rounding_mode
+! and type T.Constant.const = I.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) I.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) I.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) I.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) I.T.Extension.sx
+! and type T.I.div_rounding_mode = I.T.I.div_rounding_mode
+! and type T.Region.region = I.T.Region.region
+! and type T.ccexp = I.T.ccexp
+! and type T.fexp = I.T.fexp
+! (* and type T.labexp = I.T.labexp *)
+! and type T.mlrisc = I.T.mlrisc
+! and type T.oper = I.T.oper
+! and type T.rep = I.T.rep
+! and type T.rexp = I.T.rexp
+! and type T.stm = I.T.stm
+! structure CFG : CONTROL_FLOW_GRAPH (* where P = TS.S.P and I = I *)
+! where type P.Client.pseudo_op = TS.S.P.Client.pseudo_op
+! and type P.T.Basis.cond = TS.S.P.T.Basis.cond
+! and type P.T.Basis.div_rounding_mode = TS.S.P.T.Basis.div_rounding_mode
+! and type P.T.Basis.ext = TS.S.P.T.Basis.ext
+! and type P.T.Basis.fcond = TS.S.P.T.Basis.fcond
+! and type P.T.Basis.rounding_mode = TS.S.P.T.Basis.rounding_mode
+! and type P.T.Constant.const = TS.S.P.T.Constant.const
+! and type ('s,'r,'f,'c) P.T.Extension.ccx = ('s,'r,'f,'c) TS.S.P.T.Extension.ccx
+! and type ('s,'r,'f,'c) P.T.Extension.fx = ('s,'r,'f,'c) TS.S.P.T.Extension.fx
+! and type ('s,'r,'f,'c) P.T.Extension.rx = ('s,'r,'f,'c) TS.S.P.T.Extension.rx
+! and type ('s,'r,'f,'c) P.T.Extension.sx = ('s,'r,'f,'c) TS.S.P.T.Extension.sx
+! and type P.T.I.div_rounding_mode = TS.S.P.T.I.div_rounding_mode
+! and type P.T.Region.region = TS.S.P.T.Region.region
+! and type P.T.ccexp = TS.S.P.T.ccexp
+! and type P.T.fexp = TS.S.P.T.fexp
+! (* and type P.T.labexp = TS.S.P.T.labexp *)
+! and type P.T.mlrisc = TS.S.P.T.mlrisc
+! and type P.T.oper = TS.S.P.T.oper
+! and type P.T.rep = TS.S.P.T.rep
+! and type P.T.rexp = TS.S.P.T.rexp
+! and type P.T.stm = TS.S.P.T.stm
+! where type I.addressing_mode = I.addressing_mode
+! and type I.ea = I.ea
+! and type I.instr = I.instr
+! and type I.instruction = I.instruction
+! and type I.operand = I.operand
+ ) : AMD64COMP_INSTR_EXT =
+ struct
+diff -N -C 2 -r MLRISC/amd64/instructions/amd64Instr.sml MLRISC-mlton/amd64/instructions/amd64Instr.sml
+*** MLRISC/amd64/instructions/amd64Instr.sml 2007-05-30 16:34:40.000000000 -0500
+--- MLRISC-mlton/amd64/instructions/amd64Instr.sml 2007-08-13 22:49:20.000000000 -0500
+***************
+*** 9,13 ****
+ sig
+ structure C : AMD64CELLS
+! structure CB : CELLS_BASIS = CellsBasis
+ structure T : MLTREE
+ structure Constant: CONSTANT
+--- 9,22 ----
+ sig
+ structure C : AMD64CELLS
+! structure CB : CELLS_BASIS (* = CellsBasis *)
+! where type CellSet.cellset = CellsBasis.CellSet.cellset
+! and type 'a ColorTable.hash_table = 'a CellsBasis.ColorTable.hash_table
+! and type 'a HashTable.hash_table = 'a CellsBasis.HashTable.hash_table
+! and type SortedCells.sorted_cells = CellsBasis.SortedCells.sorted_cells
+! and type cell = CellsBasis.cell
+! and type cellColor = CellsBasis.cellColor
+! and type cellkind = CellsBasis.cellkind
+! and type cellkindDesc = CellsBasis.cellkindDesc
+! and type cellkindInfo = CellsBasis.cellkindInfo
+ structure T : MLTREE
+ structure Constant: CONSTANT
+diff -N -C 2 -r MLRISC/amd64/instructions/amd64Peephole.peep MLRISC-mlton/amd64/instructions/amd64Peephole.peep
+*** MLRISC/amd64/instructions/amd64Peephole.peep 2007-05-29 16:53:56.000000000 -0500
+--- MLRISC-mlton/amd64/instructions/amd64Peephole.peep 2007-08-15 21:43:01.000000000 -0500
+***************
+*** 21,25 ****
+ (structure Instr : AMD64INSTR
+ structure Eval : MLTREE_EVAL
+! sharing Instr.T = Eval.T
+ ) : PEEPHOLE =
+ struct
+--- 21,45 ----
+ (structure Instr : AMD64INSTR
+ structure Eval : MLTREE_EVAL
+! (* sharing Instr.T = Eval.T *)
+! where type T.Basis.cond = Instr.T.Basis.cond
+! and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type T.Basis.ext = Instr.T.Basis.ext
+! and type T.Basis.fcond = Instr.T.Basis.fcond
+! and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type T.Constant.const = Instr.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type T.Region.region = Instr.T.Region.region
+! and type T.ccexp = Instr.T.ccexp
+! and type T.fexp = Instr.T.fexp
+! (* and type T.labexp = Instr.T.labexp *)
+! and type T.mlrisc = Instr.T.mlrisc
+! and type T.oper = Instr.T.oper
+! and type T.rep = Instr.T.rep
+! and type T.rexp = Instr.T.rexp
+! and type T.stm = Instr.T.stm
+ ) : PEEPHOLE =
+ struct
+diff -N -C 2 -r MLRISC/amd64/instructions/amd64Peephole.sml MLRISC-mlton/amd64/instructions/amd64Peephole.sml
+*** MLRISC/amd64/instructions/amd64Peephole.sml 2007-05-29 16:53:56.000000000 -0500
+--- MLRISC-mlton/amd64/instructions/amd64Peephole.sml 2007-08-15 21:44:02.000000000 -0500
+***************
+*** 13,17 ****
+
+ (*#line 23.7 "amd64Peephole.peep"*)
+! sharing Instr.T = Eval.T
+ ): PEEPHOLE =
+ struct
+--- 13,37 ----
+
+ (*#line 23.7 "amd64Peephole.peep"*)
+! (* sharing Instr.T = Eval.T *)
+! where type T.Basis.cond = Instr.T.Basis.cond
+! and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type T.Basis.ext = Instr.T.Basis.ext
+! and type T.Basis.fcond = Instr.T.Basis.fcond
+! and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type T.Constant.const = Instr.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type T.Region.region = Instr.T.Region.region
+! and type T.ccexp = Instr.T.ccexp
+! and type T.fexp = Instr.T.fexp
+! (* and type T.labexp = Instr.T.labexp *)
+! and type T.mlrisc = Instr.T.mlrisc
+! and type T.oper = Instr.T.oper
+! and type T.rep = Instr.T.rep
+! and type T.rexp = Instr.T.rexp
+! and type T.stm = Instr.T.stm
+ ): PEEPHOLE =
+ struct
+diff -N -C 2 -r MLRISC/amd64/instructions/amd64Props.sml MLRISC-mlton/amd64/instructions/amd64Props.sml
+*** MLRISC/amd64/instructions/amd64Props.sml 2007-05-30 16:34:40.000000000 -0500
+--- MLRISC-mlton/amd64/instructions/amd64Props.sml 2007-08-15 21:08:22.000000000 -0500
+***************
+*** 16,23 ****
+ functor AMD64Props (
+ structure Instr : AMD64INSTR
+! structure MLTreeHash : MLTREE_HASH
+! where T = Instr.T
+! structure MLTreeEval : MLTREE_EVAL
+! where T = Instr.T
+ ) : AMD64INSN_PROPERTIES =
+ struct
+--- 16,61 ----
+ functor AMD64Props (
+ structure Instr : AMD64INSTR
+! structure MLTreeHash : MLTREE_HASH (* where T = Instr.T *)
+! where type T.Basis.cond = Instr.T.Basis.cond
+! and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type T.Basis.ext = Instr.T.Basis.ext
+! and type T.Basis.fcond = Instr.T.Basis.fcond
+! and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type T.Constant.const = Instr.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type T.Region.region = Instr.T.Region.region
+! and type T.ccexp = Instr.T.ccexp
+! and type T.fexp = Instr.T.fexp
+! (* and type T.labexp = Instr.T.labexp *)
+! and type T.mlrisc = Instr.T.mlrisc
+! and type T.oper = Instr.T.oper
+! and type T.rep = Instr.T.rep
+! and type T.rexp = Instr.T.rexp
+! and type T.stm = Instr.T.stm
+! structure MLTreeEval : MLTREE_EVAL (* where T = Instr.T *)
+! where type T.Basis.cond = Instr.T.Basis.cond
+! and type T.Basis.div_rounding_mode = Instr.T.Basis.div_rounding_mode
+! and type T.Basis.ext = Instr.T.Basis.ext
+! and type T.Basis.fcond = Instr.T.Basis.fcond
+! and type T.Basis.rounding_mode = Instr.T.Basis.rounding_mode
+! and type T.Constant.const = Instr.T.Constant.const
+! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) Instr.T.Extension.ccx
+! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) Instr.T.Extension.fx
+! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) Instr.T.Extension.rx
+! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) Instr.T.Extension.sx
+! and type T.I.div_rounding_mode = Instr.T.I.div_rounding_mode
+! and type T.Region.region = Instr.T.Region.region
+! and type T.ccexp = Instr.T.ccexp
+! and type T.fexp = Instr.T.fexp
+! (* and type T.labexp = Instr.T.labexp *)
+! and type T.mlrisc = Instr.T.mlrisc
+! and type T.oper = Instr.T.oper
+! and type T.rep = Instr.T.rep
+! and type T.rexp = Instr.T.rexp
+! and type T.stm = Instr.T.stm
+ ) : AMD64INSN_PROPERTIES =
+ struct
+***************
+*** 40,48 ****
+ | instrKind (I.INSTR instr) = (case instr
+ of I.NOP => IK_NOP
+! | ( I.CALL {cutsTo=_::_, ...} | I.CALLQ {cutsTo=_::_, ...} ) =>
+ IK_CALL_WITH_CUTS
+! | ( I.JMP _ | I.JCC _ | I.RET _ | I.INTO
+! | I.CMOV _ | I.CMOVQ _ ) => IK_JUMP
+! | ( I.CALL _ | I. CALLQ _ ) => IK_CALL
+ | I.PHI {} => IK_PHI
+ | I.SOURCE {} => IK_SOURCE
+--- 78,93 ----
+ | instrKind (I.INSTR instr) = (case instr
+ of I.NOP => IK_NOP
+! | ( I.CALL {cutsTo=_::_, ...} ) =>
+ IK_CALL_WITH_CUTS
+! | ( I.CALLQ {cutsTo=_::_, ...} ) =>
+! IK_CALL_WITH_CUTS
+! | ( I.JMP _ ) => IK_JUMP
+! | ( I.JCC _ ) => IK_JUMP
+! | ( I.RET _ ) => IK_JUMP
+! | ( I.INTO) => IK_JUMP
+! | ( I.CMOV _ ) => IK_JUMP
+! | ( I.CMOVQ _ ) => IK_JUMP
+! | ( I.CALL _ ) => IK_CALL
+! | ( I.CALLQ _ ) => IK_CALL
+ | I.PHI {} => IK_PHI
+ | I.SOURCE {} => IK_SOURCE
+***************
+*** 57,62 ****
+
+ fun moveTmpR (I.ANNOTATION {i, ...}) = moveTmpR i
+! | moveTmpR ( I.COPY {k=CB.GP, tmp=SOME (I.Direct (_, r)), ...}
+! | I.COPY {k=CB.FP, tmp=SOME (I.FDirect r), ...} ) =
+ SOME r
+ | moveTmpR _ = NONE
+--- 102,108 ----
+
+ 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 r), ...} ) =
+ SOME r
+ | moveTmpR _ = NONE
+***************
+*** 176,182 ****
+ 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 case *)
+--- 222,240 ----
+ in
+ case multDivOp
+! of (I.IDIVL1) =>
+! (raxPair, C.rdx::C.rax::uses)
+! | (I.DIVL1) =>
+! (raxPair, C.rdx::C.rax::uses)
+! | (I.IDIVQ1) =>
+! (raxPair, C.rdx::C.rax::uses)
+! | (I.DIVQ1) =>
+ (raxPair, C.rdx::C.rax::uses)
+! | (I.IMULL1) =>
+! (raxPair, C.rax::uses)
+! | (I.MULL1) =>
+! (raxPair, C.rax::uses)
+! | (I.IMULQ1) =>
+! (raxPair, C.rax::uses)
+! | (I.MULQ1) =>
+ (raxPair, C.rax::uses)
+ (* end case *)
+***************
+*** 185,198 ****
+ fun push opnd = ([C.stackptrR], operandAcc (opnd, [C.stackptrR]))
+ fun f i = (case i
+! of ( I.JMP (opnd, _) | I.JCC {opnd, ...} ) => ([], operandUse opnd)
+! | ( I.CALL {opnd, defs, 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, ...} => ([], operandAcc (dst, operandUse src))
+! | ( I.LEAL {r32=r, addr} | I.LEAQ {r64=r, addr} ) =>
+ ([r], 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}
+--- 243,273 ----
+ fun push opnd = ([C.stackptrR], operandAcc (opnd, [C.stackptrR]))
+ fun f i = (case i
+! 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, ...} => ([], operandAcc (dst, operandUse src))
+! | ( I.LEAL {r32=r, addr} ) =>
+! ([r], operandUse addr)
+! | ( I.LEAQ {r64=r, addr} ) =>
+ ([r], operandUse addr)
+! | ( I.CMPQ arg ) =>
+! cmpTest arg
+! | ( I.CMPL arg ) =>
+! cmpTest arg
+! | ( I.CMPW arg ) =>
+! cmpTest arg
+! | ( I.CMPB arg ) =>
+! cmpTest arg
+! | ( I.TESTQ arg ) =>
+! cmpTest arg
+! | ( I.TESTL arg ) =>
+! cmpTest arg
+! | ( I.TESTW arg ) =>
+! cmpTest arg
+! | ( I.TESTB arg ) =>
+ cmpTest arg
+ | I.BITOP{lsrc, rsrc, ...} => cmpTest {lsrc=lsrc,rsrc=rsrc}
+***************
+*** 210,221 ****
+ | I.CMPXCHG {src, dst, ...} =>
+ (C.rax::operandDef dst, C.rax::operandAcc (src, operandUse dst))
+! | ( I.ENTER _ | I.LEAVE ) => ([C.rsp, C.rbp], [C.rsp, C.rbp])
+ | I.MULTDIV arg => multDiv arg
+! | ( I.MUL3 {src1, dst, ...} | I.MULQ3 {src1, dst, ...} ) =>
+ ([dst], operandUse src1)
+! | ( I.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 | I.POPFD )=> rspOnly ()
+ | I.CDQ => ([C.rdx], [C.rax])
+ | I.FMOVE {dst, src, ...} => ([], operandAcc (dst, operandUse src))
+--- 285,304 ----
+ | 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 ) => push arg
+! | ( I.PUSHL arg ) => push arg
+! | ( I.PUSHW arg ) => push arg
+! | ( I.PUSHB arg ) => push arg
+ | I.POP arg => (C.stackptrR::operandDef arg, [C.stackptrR])
+! | ( I.POPFD )=> rspOnly ()
+! | ( I.POPFD )=> rspOnly ()
+ | I.CDQ => ([C.rdx], [C.rax])
+ | I.FMOVE {dst, src, ...} => ([], operandAcc (dst, operandUse src))
+***************
+*** 253,259 ****
+ | I.FBINOP {dst, src, ...} => ([dst], [src])
+ | I.FCOM {dst, src, ...} => ([dst], operand src)
+! | ( I.FSQRTS {dst, src} | I.FSQRTD {dst, src} )=>
+ (operand dst, operand src)
+! | ( I.CALL {defs, uses, ...} | I.CALLQ {defs, uses, ...} ) =>
+ (C.getFreg defs, C.getFreg uses)
+ | _ => ([], [])
+--- 336,346 ----
+ | I.FBINOP {dst, src, ...} => ([dst], [src])
+ | I.FCOM {dst, src, ...} => ([dst], operand src)
+! | ( I.FSQRTS {dst, src} )=>
+ (operand dst, operand src)
+! | ( I.FSQRTD {dst, src} )=>
+! (operand dst, operand src)
+! | ( I.CALL {defs, uses, ...} ) =>
+! (C.getFreg defs, C.getFreg uses)
+! | ( I.CALLQ {defs, uses, ...} ) =>
+ (C.getFreg defs, C.getFreg uses)
+ | _ => ([], [])
+***************
+*** 300,344 ****
+ | I.MOVE {mvOp, ...} =>
+ (case mvOp
+! of ( I.MOVQ | I.MOVSWQ | I.MOVZWQ | I.MOVSBQ |
+! I.MOVZBQ | I.MOVSLQ ) => 64
+! | ( I.MOVL | I.MOVSWL | I.MOVZWL | I.MOVSBL |
+! I.MOVZBL ) => 32
+ | I.MOVW => 16
+ | I.MOVB => 8
+ (* esac *))
+! | ( I.CALL _ | I.LEAL _ | I.CMPL _ | I.TESTL _ | I.CMOV _ | I.MUL3 _ )
+! => 32
+! | ( I.CALLQ _ | I.LEAQ _ | I.CMPQ _ | I.TESTQ _ | I.CMOVQ _ | I.MULQ3 _ )
+! => 64
+! | ( I.CMPW _ | I.TESTW _ ) => 16
+! | ( I.CMPB _ | I.TESTB _ ) => 8
+ | I.SHIFT {shiftOp, ...} => (case shiftOp
+! of ( I.SHLDL | I.SHRDL ) => 32
+ (* esac *))
+ | I.UNARY {unOp, ...} =>
+ (case unOp
+! of ( I.DECQ | I.INCQ | I.NEGQ | I.NOTQ |
+! I.LOCK_DECQ | I.LOCK_INCQ | I.LOCK_NEGQ | I.LOCK_NOTQ ) => 64
+! | ( I.DECL | I.INCL | I.NEGL | I.NOTL ) => 32
+! | ( I.DECW | I.INCW | I.NEGW | I.NOTW ) => 16
+! | ( I.DECB | I.INCB | I.NEGB | I.NOTB ) => 8
+ (* esac *))
+ | I.MULTDIV {multDivOp, ...} =>
+ (case multDivOp
+! of ( I.IMULL1 | I.MULL1 | I.IDIVL1 | I.DIVL1 ) => 32
+! | ( I.IMULQ1 | I.MULQ1 | I.IDIVQ1 | I.DIVQ1 ) => 64
+ (* esac *))
+ | I.BINARY {binOp, ...} =>
+ (case binOp
+! of ( I.ADDQ | I.SUBQ | I.ANDQ | I.ORQ | I.XORQ | I.SHLQ | I.SARQ
+! | I.SHRQ | I.MULQ | I.IMULQ | I.ADCQ | I.SBBQ ) => 64
+! | ( I.ADDL | I.SUBL | I.ANDL | I.ORL | I.XORL | I.SHLL | I.SARL
+! | I.SHRL | I.MULL | I.IMULL | I.ADCL | I.SBBL | I.BTSL | I.BTCL
+! | I.BTRL | I.ROLL | I.RORL | I.XCHGL ) => 32
+! | ( I.ADDW | I.SUBW | I.ANDW | I.ORW | I.XORW | I.SHLW | I.SARW
+! | I.SHRW | I.MULW | I.IMULW | I.BTSW | I.BTCW | I.BTRW | I.ROLW
+! | I.RORW | I.XCHGW ) => 16
+! | ( I.ADDB | I.SUBB | I.ANDB | I.ORB | I.XORB | I.SHLB | I.SARB
+! | I.SHRB | I.MULB | I.IMULB | I.XCHGB ) => 8
+ | _ => raise Fail "" (* 64*)
+ (* esac *))
+--- 387,517 ----
+ | I.MOVE {mvOp, ...} =>
+ (case mvOp
+! of ( I.MOVQ ) => 64
+! | ( I.MOVSWQ ) => 64
+! | ( I.MOVZWQ ) => 64
+! | ( I.MOVSBQ ) => 64
+! | ( I.MOVZBQ ) => 64
+! | ( I.MOVSLQ ) => 64
+! | ( I.MOVL ) => 32
+! | ( I.MOVSWL ) => 32
+! | ( I.MOVZWL ) => 32
+! | ( I.MOVSBL ) => 32
+! | ( I.MOVZBL ) => 32
+ | I.MOVW => 16
+ | I.MOVB => 8
+ (* esac *))
+! | ( I.CALL _ ) => 32
+! | ( I.LEAL _ ) => 32
+! | ( I.CMPL _ ) => 32
+! | ( I.TESTL _ ) => 32
+! | ( I.CMOV _ ) => 32
+! | ( I.MUL3 _ ) => 32
+! | ( I.CALLQ _ ) => 64
+! | ( I.LEAQ _ ) => 64
+! | ( I.CMPQ _ ) => 64
+! | ( I.TESTQ _ ) => 64
+! | ( I.CMOVQ _ ) => 64
+! | ( I.MULQ3 _ ) => 64
+! | ( I.CMPW _ ) => 16
+! | ( I.TESTW _ ) => 16
+! | ( I.CMPB _ ) => 8
+! | ( I.TESTB _ ) => 8
+ | I.SHIFT {shiftOp, ...} => (case shiftOp
+! of ( I.SHLDL ) => 32
+! | ( I.SHRDL ) => 32
+ (* esac *))
+ | I.UNARY {unOp, ...} =>
+ (case unOp
+! of ( I.DECQ ) => 64
+! | ( I.INCQ ) => 64
+! | ( I.NEGQ ) => 64
+! | ( I.NOTQ ) => 64
+! | ( I.LOCK_DECQ ) => 64
+! | ( I.LOCK_INCQ ) => 64
+! | ( I.LOCK_NEGQ ) => 64
+! | ( I.LOCK_NOTQ ) => 64
+! | ( I.DECL ) => 32
+! | ( I.INCL ) => 32
+! | ( I.NEGL ) => 32
+! | ( I.NOTL ) => 32
+! | ( I.DECW ) => 16
+! | ( I.INCW ) => 16
+! | ( I.NEGW ) => 16
+! | ( I.NOTW ) => 16
+! | ( I.DECB ) => 8
+! | ( I.INCB ) => 8
+! | ( I.NEGB ) => 8
+! | ( I.NOTB ) => 8
+ (* esac *))
+ | I.MULTDIV {multDivOp, ...} =>
+ (case multDivOp
+! of ( I.IMULL1 ) => 32
+! | ( I.MULL1 ) => 32
+! | ( I.IDIVL1 ) => 32
+! | ( I.DIVL1 ) => 32
+! | ( I.IMULQ1 ) => 64
+! | ( I.MULQ1 ) => 64
+! | ( I.IDIVQ1 ) => 64
+! | ( I.DIVQ1 ) => 64
+ (* esac *))
+ | I.BINARY {binOp, ...} =>
+ (case binOp
+! of ( I.ADDQ ) => 64
+! | ( I.SUBQ ) => 64
+! | ( I.ANDQ ) => 64
+! | ( I.ORQ ) => 64
+! | ( I.XORQ ) => 64
+! | ( I.SHLQ ) => 64
+! | ( I.SARQ ) => 64
+! | ( I.SHRQ ) => 64
+! | ( I.MULQ ) => 64
+! | ( I.IMULQ ) => 64
+! | ( I.ADCQ ) => 64
+! | ( I.SBBQ ) => 64
+! | ( I.ADDL ) => 32
+! | ( I.SUBL ) => 32
+! | ( I.ANDL ) => 32
+! | ( I.ORL ) => 32
+! | ( I.XORL ) => 32
+! | ( I.SHLL ) => 32
+! | ( I.SARL ) => 32
+! | ( I.SHRL ) => 32
+! | ( I.MULL ) => 32
+! | ( I.IMULL ) => 32
+! | ( I.ADCL ) => 32
+! | ( I.SBBL ) => 32
+! | ( I.BTSL ) => 32
+! | ( I.BTCL ) => 32
+! | ( I.BTRL ) => 32
+! | ( I.ROLL ) => 32
+! | ( I.RORL ) => 32
+! | ( I.XCHGL ) => 32
+! | ( I.ADDW ) => 16
+! | ( I.SUBW ) => 16
+! | ( I.ANDW ) => 16
+! | ( I.ORW ) => 16
+! | ( I.XORW ) => 16
+! | ( I.SHLW ) => 16
+! | ( I.SARW ) => 16
+! | ( I.SHRW ) => 16
+! | ( I.MULW ) => 16
+! | ( I.IMULW ) => 16
+! | ( I.BTSW ) => 16
+! | ( I.BTCW ) => 16
+! | ( I.BTRW ) => 16
+! | ( I.ROLW ) => 16
+! | ( I.RORW ) => 16
+! | ( I.XCHGW ) => 16
+! | ( I.ADDB ) => 8
+! | ( I.SUBB ) => 8
+! | ( I.ANDB ) => 8
+! | ( I.ORB ) => 8
+! | ( I.XORB ) => 8
+! | ( I.SHLB ) => 8
+! | ( I.SARB ) => 8
+! | ( I.SHRB ) => 8
+! | ( I.MULB ) => 8
+! | ( I.IMULB ) => 8
+! | ( I.XCHGB ) => 8
+ | _ => raise Fail "" (* 64*)
+ (* esac *))
+***************
+*** 348,362 ****
+ fun szOfFinstr instr = (case instr
+ of I.FMOVE {fmvOp, ...} => (case fmvOp
+! of ( I.MOVSS | I.CVTSS2SD | I.CVTSS2SI | I.CVTSS2SIQ ) => 32
+! | ( I.MOVSD | I.CVTSD2SS | I.CVTSD2SI | I.CVTSD2SIQ ) => 64
+ | _ => error "AMD64Props.szOfFinstr"
+ (* end case *))
+ | I.FCOM {comOp, ...} => (case comOp
+! of ( I.COMISS | I.UCOMISS ) => 32
+! | ( I.COMISD | I.UCOMISD ) => 64
+ (* end case *))
+ | I.FBINOP {binOp, ...} => (case binOp
+! of ( I.ADDSS | I.SUBSS | I.MULSS | I.DIVSS ) => 32
+! | ( I.ADDSD | I.SUBSD | I.MULSD | I.DIVSD ) => 64
+ (* end case *))
+ | I.FSQRTS _ => 32
+--- 521,549 ----
+ fun szOfFinstr instr = (case instr
+ of I.FMOVE {fmvOp, ...} => (case fmvOp
+! of ( I.MOVSS ) => 32
+! | ( I.CVTSS2SD ) => 32
+! | ( I.CVTSS2S
More information about the MLton-commit
mailing list