[MLton-commit] r7150
Matthew Fluet
fluet at mlton.org
Tue Jun 16 09:03:01 PDT 2009
Update SML/NJ libraries to SML/NJ 110.70.
----------------------------------------------------------------------
U mlton/trunk/lib/ckit-lib/ckit.patch
U mlton/trunk/lib/ckit-lib/ckit.tgz
U mlton/trunk/lib/mlrisc-lib/MLRISC.patch
U mlton/trunk/lib/mlrisc-lib/MLRISC.tgz
U mlton/trunk/lib/smlnj-lib/smlnj-lib.patch
U mlton/trunk/lib/smlnj-lib/smlnj-lib.tgz
----------------------------------------------------------------------
Modified: mlton/trunk/lib/ckit-lib/ckit.patch
===================================================================
--- mlton/trunk/lib/ckit-lib/ckit.patch 2009-06-15 22:33:32 UTC (rev 7149)
+++ mlton/trunk/lib/ckit-lib/ckit.patch 2009-06-16 16:02:52 UTC (rev 7150)
@@ -1,13 +1,6 @@
-diff -N -C 2 -r ckit/ckit-lib.mlb ckit-mlton/ckit-lib.mlb
-*** ckit/ckit-lib.mlb 1969-12-31 18:00:00.000000000 -0600
---- ckit-mlton/ckit-lib.mlb 2007-07-31 19:39:13.000000000 -0500
-***************
-*** 0 ****
---- 1 ----
-+ src/ckit-lib.mlb
diff -N -C 2 -r ckit/README.mlton ckit-mlton/README.mlton
-*** ckit/README.mlton 1969-12-31 18:00:00.000000000 -0600
---- ckit-mlton/README.mlton 2007-07-31 19:39:13.000000000 -0500
+*** ckit/README.mlton Wed Dec 31 18:00:00 1969
+--- ckit-mlton/README.mlton Fri May 18 16:13:58 2007
***************
*** 0 ****
--- 1,13 ----
@@ -24,9 +17,16 @@
+ * {{{ast/sizeof.sml}}} (modified): Rewrote use of ''or-patterns''.
+ * {{{ast/initializer-normalizer.sml}}} (modified): Rewrote use of ''or-patterns''.
+ * {{{ast/build-ast.sml}}} (modified): Rewrote use of ''or-patterns''.
+diff -N -C 2 -r ckit/ckit-lib.mlb ckit-mlton/ckit-lib.mlb
+*** ckit/ckit-lib.mlb Wed Dec 31 18:00:00 1969
+--- ckit-mlton/ckit-lib.mlb Fri May 18 16:13:58 2007
+***************
+*** 0 ****
+--- 1 ----
++ src/ckit-lib.mlb
diff -N -C 2 -r ckit/src/ast/ast-sig.sml ckit-mlton/src/ast/ast-sig.sml
-*** ckit/src/ast/ast-sig.sml 2001-10-31 14:22:44.000000000 -0600
---- ckit-mlton/src/ast/ast-sig.sml 2007-07-31 19:44:55.000000000 -0500
+*** ckit/src/ast/ast-sig.sml Wed Oct 31 14:22:44 2001
+--- ckit-mlton/src/ast/ast-sig.sml Fri May 18 16:14:04 2007
***************
*** 68,72 ****
= TypeDecl of {shadow: {strct:bool} option, tid:tid}
@@ -124,8 +124,8 @@
{name: Symbol.symbol, (* the name of the member *)
uid : Pid.uid, (* unique identifier *)
diff -N -C 2 -r ckit/src/ast/build-ast.sml ckit-mlton/src/ast/build-ast.sml
-*** ckit/src/ast/build-ast.sml 2003-08-28 16:59:15.000000000 -0500
---- ckit-mlton/src/ast/build-ast.sml 2007-07-31 19:44:55.000000000 -0500
+*** ckit/src/ast/build-ast.sml Thu Aug 28 16:59:15 2003
+--- ckit-mlton/src/ast/build-ast.sml Fri May 18 16:14:04 2007
***************
*** 291,295 ****
| _ => false
@@ -290,8 +290,8 @@
if isPartial tid
then SOME{tid=tid, alreadyDefined=false}
diff -N -C 2 -r ckit/src/ast/initializer-normalizer.sml ckit-mlton/src/ast/initializer-normalizer.sml
-*** ckit/src/ast/initializer-normalizer.sml 2003-08-28 16:59:15.000000000 -0500
---- ckit-mlton/src/ast/initializer-normalizer.sml 2007-07-31 19:44:55.000000000 -0500
+*** ckit/src/ast/initializer-normalizer.sml Thu Aug 28 16:59:15 2003
+--- ckit-mlton/src/ast/initializer-normalizer.sml Fri May 18 16:14:04 2007
***************
*** 157,161 ****
| SOME _ => fail "Incomplete type for union ref"
@@ -312,8 +312,8 @@
feed (scalarNorm ctype, inits)
| Ast.Void => fail "Incomplete type: void"
diff -N -C 2 -r ckit/src/ast/pp/pp-ast-adornment-sig.sml ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml
-*** ckit/src/ast/pp/pp-ast-adornment-sig.sml 2000-04-05 13:34:51.000000000 -0500
---- ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml 2007-07-31 19:49:19.000000000 -0500
+*** ckit/src/ast/pp/pp-ast-adornment-sig.sml Wed Apr 5 13:34:51 2000
+--- ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml Fri May 18 16:14:15 2007
***************
*** 1,9 ****
(* Copyright (c) 1998 by Lucent Technologies *)
@@ -345,8 +345,8 @@
end
! (* end *)
diff -N -C 2 -r ckit/src/ast/pp/pp-ast-ext-sig.sml ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml
-*** ckit/src/ast/pp/pp-ast-ext-sig.sml 2000-04-05 13:34:51.000000000 -0500
---- ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml 2007-07-31 19:49:19.000000000 -0500
+*** ckit/src/ast/pp/pp-ast-ext-sig.sml Wed Apr 5 13:34:51 2000
+--- ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml Fri May 18 16:14:15 2007
***************
*** 1,5 ****
(* Copyright (c) 1998 by Lucent Technologies *)
@@ -383,8 +383,8 @@
! (* end *)
diff -N -C 2 -r ckit/src/ast/pp/pp-lib.sml ckit-mlton/src/ast/pp/pp-lib.sml
-*** ckit/src/ast/pp/pp-lib.sml 2000-04-05 13:34:51.000000000 -0500
---- ckit-mlton/src/ast/pp/pp-lib.sml 2007-07-31 19:49:19.000000000 -0500
+*** ckit/src/ast/pp/pp-lib.sml Wed Apr 5 13:34:51 2000
+--- ckit-mlton/src/ast/pp/pp-lib.sml Fri May 18 16:14:15 2007
***************
*** 116,120 ****
fun ppId pps ({name,uid,kind,stClass,global,...}: Ast.id) =
@@ -402,8 +402,8 @@
if !suppressPidGlobalUnderscores then ppSymbol' pps name
else ppSymbol pps (name,uid)
diff -N -C 2 -r ckit/src/ast/sizeof.sml ckit-mlton/src/ast/sizeof.sml
-*** ckit/src/ast/sizeof.sml 2000-04-05 13:34:51.000000000 -0500
---- ckit-mlton/src/ast/sizeof.sml 2007-07-31 19:44:55.000000000 -0500
+*** ckit/src/ast/sizeof.sml Wed Apr 5 13:34:51 2000
+--- ckit-mlton/src/ast/sizeof.sml Fri May 18 16:14:04 2007
***************
*** 322,326 ****
case ty
@@ -420,8 +420,8 @@
processTid sizesErrWarnBug tidtab tid
| Ast.EnumRef _ =>
diff -N -C 2 -r ckit/src/ast/type-util-sig.sml ckit-mlton/src/ast/type-util-sig.sml
-*** ckit/src/ast/type-util-sig.sml 2001-10-31 14:22:44.000000000 -0600
---- ckit-mlton/src/ast/type-util-sig.sml 2007-07-31 19:44:55.000000000 -0500
+*** ckit/src/ast/type-util-sig.sml Wed Oct 31 14:22:44 2001
+--- ckit-mlton/src/ast/type-util-sig.sml Fri May 18 16:14:04 2007
***************
*** 1,9 ****
(* Copyright (c) 1998 by Lucent Technologies *)
@@ -453,8 +453,8 @@
! (* end (* local *) *)
diff -N -C 2 -r ckit/src/ast/type-util.sml ckit-mlton/src/ast/type-util.sml
-*** ckit/src/ast/type-util.sml 2001-10-31 14:22:44.000000000 -0600
---- ckit-mlton/src/ast/type-util.sml 2007-07-31 19:44:55.000000000 -0500
+*** ckit/src/ast/type-util.sml Wed Oct 31 14:22:44 2001
+--- ckit-mlton/src/ast/type-util.sml Fri May 18 16:14:04 2007
***************
*** 283,287 ****
case reduceTypedef tidtab ty
@@ -522,8 +522,8 @@
| (nil, argl, _) => (["Type Warning: function call has too many args"]
, 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-15 21:45:10.000000000 -0500
+*** ckit/src/ckit-lib.mlb Wed Dec 31 18:00:00 1969
+--- ckit-mlton/src/ckit-lib.mlb Tue Jun 16 10:57:17 2009
***************
*** 0 ****
--- 1,888 ----
@@ -1416,8 +1416,8 @@
+
+ end
diff -N -C 2 -r ckit/src/parser/grammar/c.lex.sml ckit-mlton/src/parser/grammar/c.lex.sml
-*** ckit/src/parser/grammar/c.lex.sml 2007-06-06 21:44:54.000000000 -0500
---- ckit-mlton/src/parser/grammar/c.lex.sml 2007-08-12 21:21:02.000000000 -0500
+*** ckit/src/parser/grammar/c.lex.sml Wed Jun 6 21:44:54 2007
+--- ckit-mlton/src/parser/grammar/c.lex.sml Mon Aug 13 18:51:19 2007
***************
*** 230,234 ****
@@ -1432,8 +1432,8 @@
]
diff -N -C 2 -r ckit/src/parser/parse-tree-sig.sml ckit-mlton/src/parser/parse-tree-sig.sml
-*** ckit/src/parser/parse-tree-sig.sml 2000-04-05 13:34:51.000000000 -0500
---- ckit-mlton/src/parser/parse-tree-sig.sml 2007-07-31 19:44:54.000000000 -0500
+*** ckit/src/parser/parse-tree-sig.sml Wed Apr 5 13:34:51 2000
+--- ckit-mlton/src/parser/parse-tree-sig.sml Fri May 18 16:14:04 2007
***************
*** 28,33 ****
| LshiftAssign | RshiftAssign
@@ -1640,8 +1640,8 @@
(specifier, declarator, ctype, decltype, operator, expression, statement)
ParseTreeExt.externalDeclExt
diff -N -C 2 -r ckit/src/parser/parse-tree.sml ckit-mlton/src/parser/parse-tree.sml
-*** ckit/src/parser/parse-tree.sml 2000-04-05 13:34:51.000000000 -0500
---- ckit-mlton/src/parser/parse-tree.sml 2007-07-31 19:44:54.000000000 -0500
+*** ckit/src/parser/parse-tree.sml Wed Apr 5 13:34:51 2000
+--- ckit-mlton/src/parser/parse-tree.sml Fri May 18 16:14:04 2007
***************
*** 24,29 ****
| LshiftAssign | RshiftAssign
Modified: mlton/trunk/lib/ckit-lib/ckit.tgz
===================================================================
(Binary files differ)
Modified: mlton/trunk/lib/mlrisc-lib/MLRISC.patch
===================================================================
--- mlton/trunk/lib/mlrisc-lib/MLRISC.patch 2009-06-15 22:33:32 UTC (rev 7149)
+++ mlton/trunk/lib/mlrisc-lib/MLRISC.patch 2009-06-16 16:02:52 UTC (rev 7150)
@@ -1,3056 +1,6 @@
-diff -N -C 2 -r MLRISC/aliasing/pointsTo.sig MLRISC-mlton/aliasing/pointsTo.sig
-*** MLRISC/aliasing/pointsTo.sig 2000-12-07 22:11:42.000000000 -0600
---- MLRISC-mlton/aliasing/pointsTo.sig 2007-07-31 19:42:48.000000000 -0500
-***************
-*** 8,23 ****
-
- eqtype edgekind
-! structure C : CELLS_BASIS = CellsBasis
-
- datatype cell =
-! LINK of region
-! | SREF of C.cell * edges ref
-! | WREF of C.cell * edges ref
-! | SCELL of C.cell * edges ref
-! | WCELL of C.cell * edges ref
- | TOP of {mutable:bool, id:C.cell, name:string}
- (* a collapsed node *)
-! withtype region = cell ref
-! and edges = (edgekind * int * region) list
-
- val reset : (unit -> C.cell) -> unit
---- 8,32 ----
-
- eqtype edgekind
-! structure C : 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
-
- datatype cell =
-! LINK of cell ref
-! | SREF of C.cell * (edgekind * int * cell ref) list ref
-! | WREF of C.cell * (edgekind * int * cell ref) list ref
-! | SCELL of C.cell * (edgekind * int * cell ref) list ref
-! | WCELL of C.cell * (edgekind * int * cell ref) list ref
- | TOP of {mutable:bool, id:C.cell, name:string}
- (* a collapsed node *)
-! type region = cell ref
-! type edges = (edgekind * int * region) list
-
- val reset : (unit -> C.cell) -> unit
-diff -N -C 2 -r MLRISC/aliasing/pointsTo.sml MLRISC-mlton/aliasing/pointsTo.sml
-*** MLRISC/aliasing/pointsTo.sml 2002-03-07 15:16:28.000000000 -0600
---- MLRISC-mlton/aliasing/pointsTo.sml 2007-07-31 19:42:48.000000000 -0500
-***************
-*** 11,24 ****
-
- datatype cell =
-! LINK of region
-! | SREF of C.cell * edges ref
-! | WREF of C.cell * edges ref
-! | SCELL of C.cell * edges ref
-! | WCELL of C.cell * edges ref
- | TOP of {mutable:bool, id:C.cell, name:string}
- (* a collapsed node *)
-!
-! withtype region = cell ref
-! and edges = (edgekind * int * region) list
-
- fun error msg = MLRiscErrorMsg.error("PointsTo",msg)
---- 11,23 ----
-
- datatype cell =
-! LINK of cell ref
-! | SREF of C.cell * (edgekind * int * cell ref) list ref
-! | WREF of C.cell * (edgekind * int * cell ref) list ref
-! | SCELL of C.cell * (edgekind * int * cell ref) list ref
-! | WCELL of C.cell * (edgekind * int * cell ref) list ref
- | TOP of {mutable:bool, id:C.cell, name:string}
- (* a collapsed node *)
-! type region = cell ref
-! type edges = (edgekind * int * region) list
-
- fun error msg = MLRiscErrorMsg.error("PointsTo",msg)
-***************
-*** 27,33 ****
- fun greaterKind(PI,_) = false
- | greaterKind(DOM,PI) = false
-! | greaterKind(RAN,(PI | DOM)) = false
-! | greaterKind(RECORD,(PI | DOM | RAN)) = false
-! | greaterKind(MARK,(PI | DOM | RAN | RECORD)) = false
- | greaterKind _ = true
-
---- 26,38 ----
- fun greaterKind(PI,_) = false
- | greaterKind(DOM,PI) = false
-! | greaterKind(RAN,PI) = false
-! | greaterKind(RAN,DOM) = false
-! | greaterKind(RECORD,PI) = false
-! | greaterKind(RECORD,DOM) = false
-! | greaterKind(RECORD,RAN) = false
-! | greaterKind(MARK,PI) = false
-! | greaterKind(MARK,DOM) = false
-! | greaterKind(MARK,RAN) = false
-! | greaterKind(MARK,RECORD) = false
- | greaterKind _ = true
-
-diff -N -C 2 -r MLRISC/alpha/backpatch/alphaJumps.sml MLRISC-mlton/alpha/backpatch/alphaJumps.sml
-*** MLRISC/alpha/backpatch/alphaJumps.sml 2003-05-22 17:46:30.000000000 -0500
---- MLRISC-mlton/alpha/backpatch/alphaJumps.sml 2007-07-31 19:45:23.000000000 -0500
-***************
-*** 6,13 ****
- functor AlphaJumps
- (structure Instr : ALPHAINSTR
-! structure Shuffle : ALPHASHUFFLE
-! where I = Instr
-! structure MLTreeEval : MLTREE_EVAL
-! where T = Instr.T
- ) : SDI_JUMPS =
- struct
---- 6,70 ----
- functor AlphaJumps
- (structure Instr : ALPHAINSTR
-! structure Shuffle : ALPHASHUFFLE (* 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.branch = Instr.branch
-! and type I.cmove = Instr.cmove
-! and type I.ea = Instr.ea
-! and type I.fbranch = Instr.fbranch
-! and type I.fcmove = Instr.fcmove
-! and type I.fload = Instr.fload
-! and type I.foperate = Instr.foperate
-! and type I.foperateV = Instr.foperateV
-! and type I.fstore = Instr.fstore
-! and type I.funary = Instr.funary
-! and type I.instr = Instr.instr
-! and type I.instruction = Instr.instruction
-! and type I.load = Instr.load
-! and type I.operand = Instr.operand
-! and type I.operate = Instr.operate
-! and type I.operateV = Instr.operateV
-! and type I.osf_user_palcode = Instr.osf_user_palcode
-! and type I.pseudo_op = Instr.pseudo_op
-! and type I.store = Instr.store
-! 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
- ) : SDI_JUMPS =
- struct
-diff -N -C 2 -r MLRISC/alpha/emit/alphaAsm.sml MLRISC-mlton/alpha/emit/alphaAsm.sml
-*** MLRISC/alpha/emit/alphaAsm.sml 2002-03-07 15:16:28.000000000 -0600
---- MLRISC-mlton/alpha/emit/alphaAsm.sml 2007-07-31 19:45:22.000000000 -0500
-***************
-*** 7,16 ****
-
- functor AlphaAsmEmitter(structure S : INSTRUCTION_STREAM
-! structure Instr : ALPHAINSTR
-! where T = S.P.T
-! structure Shuffle : ALPHASHUFFLE
-! where I = Instr
-! structure MLTreeEval : MLTREE_EVAL
-! where T = Instr.T
- ) : INSTRUCTION_EMITTER =
- struct
---- 7,92 ----
-
- functor AlphaAsmEmitter(structure S : INSTRUCTION_STREAM
-! structure Instr : ALPHAINSTR (* 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 : ALPHASHUFFLE (* 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.branch = Instr.branch
-! and type I.cmove = Instr.cmove
-! and type I.ea = Instr.ea
-! and type I.fbranch = Instr.fbranch
-! and type I.fcmove = Instr.fcmove
-! and type I.fload = Instr.fload
-! and type I.foperate = Instr.foperate
-! and type I.foperateV = Instr.foperateV
-! and type I.fstore = Instr.fstore
-! and type I.funary = Instr.funary
-! and type I.instr = Instr.instr
-! and type I.instruction = Instr.instruction
-! and type I.load = Instr.load
-! and type I.operand = Instr.operand
-! and type I.operate = Instr.operate
-! and type I.operateV = Instr.operateV
-! and type I.osf_user_palcode = Instr.osf_user_palcode
-! and type I.pseudo_op = Instr.pseudo_op
-! and type I.store = Instr.store
-! 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
-diff -N -C 2 -r MLRISC/alpha/emit/alphaMC.sml MLRISC-mlton/alpha/emit/alphaMC.sml
-*** MLRISC/alpha/emit/alphaMC.sml 2002-01-09 13:44:22.000000000 -0600
---- MLRISC-mlton/alpha/emit/alphaMC.sml 2007-07-31 19:45:23.000000000 -0500
-***************
-*** 7,11 ****
-
- functor AlphaMCEmitter(structure Instr : ALPHAINSTR
-! structure MLTreeEval : MLTREE_EVAL where T = Instr.T
- structure Stream : INSTRUCTION_STREAM
- structure CodeString : CODE_STRING
---- 7,31 ----
-
- functor AlphaMCEmitter(structure Instr : ALPHAINSTR
-! 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 Stream : INSTRUCTION_STREAM
- structure CodeString : CODE_STRING
-***************
-*** 48,51 ****
---- 68,72 ----
- fun eByteW w =
- let val i = !loc
-+ val w = W.toLargeWord w
- in loc := i + 1; CodeString.update(i,Word8.fromLargeWord w) end
-
-diff -N -C 2 -r MLRISC/alpha/flowgraph/alphaGasPseudoOps.sml MLRISC-mlton/alpha/flowgraph/alphaGasPseudoOps.sml
-*** MLRISC/alpha/flowgraph/alphaGasPseudoOps.sml 2001-11-21 12:41:49.000000000 -0600
---- MLRISC-mlton/alpha/flowgraph/alphaGasPseudoOps.sml 2007-07-31 19:45:23.000000000 -0500
-***************
-*** 1,5 ****
- functor AlphaGasPseudoOps
- ( structure T : MLTREE
-! structure MLTreeEval : MLTREE_EVAL where T = T
- ) : PSEUDO_OPS_BASIS =
-
---- 1,25 ----
- functor AlphaGasPseudoOps
- ( 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/alpha/instructions/alphaInstr.sml MLRISC-mlton/alpha/instructions/alphaInstr.sml
-*** MLRISC/alpha/instructions/alphaInstr.sml 2002-01-23 23:45:18.000000000 -0600
---- MLRISC-mlton/alpha/instructions/alphaInstr.sml 2007-07-31 19:45:22.000000000 -0500
-***************
-*** 9,13 ****
- sig
- structure C : ALPHACELLS
-! structure CB : CELLS_BASIS = CellsBasis
- structure T : MLTREE
- structure Constant: CONSTANT
---- 9,22 ----
- sig
- structure C : ALPHACELLS
-! 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/alpha/instructions/alphaProps.sml MLRISC-mlton/alpha/instructions/alphaProps.sml
-*** MLRISC/alpha/instructions/alphaProps.sml 2002-03-11 21:56:23.000000000 -0600
---- MLRISC-mlton/alpha/instructions/alphaProps.sml 2007-07-31 19:45:23.000000000 -0500
-***************
-*** 7,12 ****
- functor AlphaProps
- (structure Instr : ALPHAINSTR
-! structure MLTreeHash : MLTREE_HASH where T = Instr.T
-! structure MLTreeEval : MLTREE_EVAL where T = Instr.T
- ):INSN_PROPERTIES =
- struct
---- 7,52 ----
- functor AlphaProps
- (structure Instr : ALPHAINSTR
-! 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
- ):INSN_PROPERTIES =
- struct
-diff -N -C 2 -r MLRISC/alpha/mltree/alphaPseudoInstr.sig MLRISC-mlton/alpha/mltree/alphaPseudoInstr.sig
-*** MLRISC/alpha/mltree/alphaPseudoInstr.sig 2001-07-19 15:35:20.000000000 -0500
---- MLRISC-mlton/alpha/mltree/alphaPseudoInstr.sig 2007-07-31 19:45:23.000000000 -0500
-***************
-*** 5,12 ****
- structure I : ALPHAINSTR
- structure T : MLTREE
- structure C : ALPHACELLS
-! sharing C = I.C
-! sharing I.T = T
-! structure CB: CELLS_BASIS = CellsBasis
-
- type reduceOpnd = I.operand -> CB.cell
---- 5,41 ----
- structure I : ALPHAINSTR
- structure T : MLTREE
-+ where type Basis.cond = I.T.Basis.cond
-+ and type Basis.div_rounding_mode = I.T.Basis.div_rounding_mode
-+ and type Basis.ext = I.T.Basis.ext
-+ and type Basis.fcond = I.T.Basis.fcond
-+ and type Basis.rounding_mode = I.T.Basis.rounding_mode
-+ and type Constant.const = I.T.Constant.const
-+ and type ('s,'r,'f,'c) Extension.ccx = ('s,'r,'f,'c) I.T.Extension.ccx
-+ and type ('s,'r,'f,'c) Extension.fx = ('s,'r,'f,'c) I.T.Extension.fx
-+ and type ('s,'r,'f,'c) Extension.rx = ('s,'r,'f,'c) I.T.Extension.rx
-+ and type ('s,'r,'f,'c) Extension.sx = ('s,'r,'f,'c) I.T.Extension.sx
-+ and type I.div_rounding_mode = I.T.I.div_rounding_mode
-+ and type Region.region = I.T.Region.region
-+ and type ccexp = I.T.ccexp
-+ and type fexp = I.T.fexp
-+ (* and type labexp = I.T.labexp *)
-+ and type mlrisc = I.T.mlrisc
-+ and type oper = I.T.oper
-+ and type rep = I.T.rep
-+ and type rexp = I.T.rexp
-+ and type stm = I.T.stm
- structure C : ALPHACELLS
-! (* sharing C = I.C *)
-! (* sharing I.T = T *)
-! 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
-
- type reduceOpnd = I.operand -> CB.cell
-diff -N -C 2 -r MLRISC/alpha/mltree/alpha.sml MLRISC-mlton/alpha/mltree/alpha.sml
-*** MLRISC/alpha/mltree/alpha.sml 2003-08-28 16:59:15.000000000 -0500
---- MLRISC-mlton/alpha/mltree/alpha.sml 2007-07-31 19:45:23.000000000 -0500
-***************
-*** 12,20 ****
- functor Alpha
- (structure AlphaInstr : ALPHAINSTR
-! structure PseudoInstrs : ALPHA_PSEUDO_INSTR
-! where I = AlphaInstr
-! structure ExtensionComp : MLTREE_EXTENSION_COMP
-! where I = AlphaInstr
-! and T = AlphaInstr.T
-
- (* Cost of multiplication in cycles *)
---- 12,81 ----
- functor Alpha
- (structure AlphaInstr : ALPHAINSTR
-! structure PseudoInstrs : ALPHA_PSEUDO_INSTR (* where I = AlphaInstr *)
-! where type I.Constant.const = AlphaInstr.Constant.const
-! and type I.Region.region = AlphaInstr.Region.region
-! and type I.T.Basis.cond = AlphaInstr.T.Basis.cond
-! and type I.T.Basis.div_rounding_mode = AlphaInstr.T.Basis.div_rounding_mode
-! and type I.T.Basis.ext = AlphaInstr.T.Basis.ext
-! and type I.T.Basis.fcond = AlphaInstr.T.Basis.fcond
-! and type I.T.Basis.rounding_mode = AlphaInstr.T.Basis.rounding_mode
-! and type ('s,'r,'f,'c) I.T.Extension.ccx = ('s,'r,'f,'c) AlphaInstr.T.Extension.ccx
-! and type ('s,'r,'f,'c) I.T.Extension.fx = ('s,'r,'f,'c) AlphaInstr.T.Extension.fx
-! and type ('s,'r,'f,'c) I.T.Extension.rx = ('s,'r,'f,'c) AlphaInstr.T.Extension.rx
-! and type ('s,'r,'f,'c) I.T.Extension.sx = ('s,'r,'f,'c) AlphaInstr.T.Extension.sx
-! and type I.T.I.div_rounding_mode = AlphaInstr.T.I.div_rounding_mode
-! and type I.T.ccexp = AlphaInstr.T.ccexp
-! and type I.T.fexp = AlphaInstr.T.fexp
-! (* and type I.T.labexp = AlphaInstr.T.labexp *)
-! and type I.T.mlrisc = AlphaInstr.T.mlrisc
-! and type I.T.oper = AlphaInstr.T.oper
-! and type I.T.rep = AlphaInstr.T.rep
-! and type I.T.rexp = AlphaInstr.T.rexp
-! and type I.T.stm = AlphaInstr.T.stm
-! and type I.branch = AlphaInstr.branch
-! and type I.cmove = AlphaInstr.cmove
-! and type I.ea = AlphaInstr.ea
-! and type I.fbranch = AlphaInstr.fbranch
-! and type I.fcmove = AlphaInstr.fcmove
-! and type I.fload = AlphaInstr.fload
-! and type I.foperate = AlphaInstr.foperate
-! and type I.foperateV = AlphaInstr.foperateV
-! and type I.fstore = AlphaInstr.fstore
-! and type I.funary = AlphaInstr.funary
-! and type I.instr = AlphaInstr.instr
-! and type I.instruction = AlphaInstr.instruction
-! and type I.load = AlphaInstr.load
-! and type I.operand = AlphaInstr.operand
-! and type I.operate = AlphaInstr.operate
-! and type I.operateV = AlphaInstr.operateV
-! and type I.osf_user_palcode = AlphaInstr.osf_user_palcode
-! and type I.pseudo_op = AlphaInstr.pseudo_op
-! and type I.store = AlphaInstr.store
-! structure ExtensionComp : MLTREE_EXTENSION_COMP (* where I = AlphaInstr and T = AlphaInstr.T *)
-! where type I.addressing_mode = AlphaInstr.addressing_mode
-! and type I.ea = AlphaInstr.ea
-! and type I.instr = AlphaInstr.instr
-! and type I.instruction = AlphaInstr.instruction
-! and type I.operand = AlphaInstr.operand
-! where type T.Basis.cond = AlphaInstr.T.Basis.cond
-! and type T.Basis.div_rounding_mode = AlphaInstr.T.Basis.div_rounding_mode
-! and type T.Basis.ext = AlphaInstr.T.Basis.ext
-! and type T.Basis.fcond = AlphaInstr.T.Basis.fcond
-! and type T.Basis.rounding_mode = AlphaInstr.T.Basis.rounding_mode
-! and type T.Constant.const = AlphaInstr.T.Constant.const
-! and type ('s,'r,'f,'c) T.Extension.ccx = ('s,'r,'f,'c) AlphaInstr.T.Extension.ccx
-! and type ('s,'r,'f,'c) T.Extension.fx = ('s,'r,'f,'c) AlphaInstr.T.Extension.fx
-! and type ('s,'r,'f,'c) T.Extension.rx = ('s,'r,'f,'c) AlphaInstr.T.Extension.rx
-! and type ('s,'r,'f,'c) T.Extension.sx = ('s,'r,'f,'c) AlphaInstr.T.Extension.sx
-! and type T.I.div_rounding_mode = AlphaInstr.T.I.div_rounding_mode
-! and type T.Region.region = AlphaInstr.T.Region.region
-! and type T.ccexp = AlphaInstr.T.ccexp
-! and type T.fexp = AlphaInstr.T.fexp
-! (* and type T.labexp = AlphaInstr.T.labexp *)
-! and type T.mlrisc = AlphaInstr.T.mlrisc
-! and type T.oper = AlphaInstr.T.oper
-! and type T.rep = AlphaInstr.T.rep
-! and type T.rexp = AlphaInstr.T.rexp
-! and type T.stm = AlphaInstr.T.stm
-
- (* Cost of multiplication in cycles *)
-***************
-*** 216,220 ****
- * by constant optimizations.
- *)
-! functor Multiply32 = MLTreeMult
- (structure I = I
- structure T = T
---- 277,283 ----
- * by constant optimizations.
- *)
-!
-! (* signed, trapping version of multiply and divide *)
-! structure Mult32 = MLTreeMult
- (structure I = I
- structure T = T
-***************
-*** 257,294 ****
- I.operate{oper=I.SRA,ra=tmp,rb=I.IMMop i,rc=d}]
- end
-! )
-
-! functor Multiply64 = MLTreeMult
- (structure I = I
- structure T = T
- structure CB = CellsBasis
--
-- val intTy = 64
-
-! type arg = {r1:CB.cell, r2:CB.cell, d:CB.cell}
-! type argi = {r:CB.cell, i:int, d:CB.cell}
-
- fun mov{r,d} = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
-! fun add{r1,r2,d}= I.operate{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}
-! fun slli{r,i,d} = [I.operate{oper=I.SLL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srli{r,i,d} = [I.operate{oper=I.SRL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srai{r,i,d} = [I.operate{oper=I.SRA,ra=r,rb=I.IMMop i,rc=d}]
-! )
-
-! (* signed, trapping version of multiply and divide *)
-! structure Mult32 = Multiply32
-! (val trapping = true
- val multCost = multCost
-! fun addv{r1,r2,d} = [I.operatev{oper=I.ADDLV,ra=r1,rb=I.REGop r2,rc=d}]
-! fun subv{r1,r2,d} = [I.operatev{oper=I.SUBLV,ra=r1,rb=I.REGop r2,rc=d}]
- val sh1addv = NONE
-! val sh2addv = NONE
-! val sh3addv = NONE
-! )
-! (val signed = true)
-
-! (* non-trapping version of multiply and divide *)
-! functor Mul32 = Multiply32
-! (val trapping = false
- val multCost = multCost
- fun addv{r1,r2,d} = [I.operate{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}]
---- 320,432 ----
- I.operate{oper=I.SRA,ra=tmp,rb=I.IMMop i,rc=d}]
- end
-!
-! val trapping = true
-! val multCost = multCost
-! fun addv{r1,r2,d} = [I.operatev{oper=I.ADDLV,ra=r1,rb=I.REGop r2,rc=d}]
-! fun subv{r1,r2,d} = [I.operatev{oper=I.SUBLV,ra=r1,rb=I.REGop r2,rc=d}]
-! val sh1addv = NONE
-! val sh2addv = NONE
-! val sh3addv = NONE
-!
-! val signed = true)
-
-! (* unsigned, non-trapping version of multiply and divide *)
-! structure Mulu32 = MLTreeMult
- (structure I = I
- structure T = T
- structure CB = CellsBasis
-
-! val intTy = 32
-!
-! type arg = {r1:CB.cell,r2:CB.cell,d:CB.cell}
-! type argi = {r:CB.cell,i:int,d:CB.cell}
-
- fun mov{r,d} = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
-! fun add{r1,r2,d} = I.operate{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}
-! (*
-! * How to left shift by a constant (32bits)
-! *)
-! fun slli{r,i=1,d} = [I.operate{oper=I.ADDL,ra=r,rb=I.REGop r,rc=d}]
-! | slli{r,i=2,d} = [I.operate{oper=I.S4ADDL,ra=r,rb=zeroOpn,rc=d}]
-! | slli{r,i=3,d} = [I.operate{oper=I.S8ADDL,ra=r,rb=zeroOpn,rc=d}]
-! | slli{r,i,d} =
-! let val tmp = C.newReg()
-! in [I.operate{oper=I.SLL,ra=r,rb=I.IMMop i,rc=tmp},
-! I.operate{oper=I.ADDL,ra=tmp,rb=zeroOpn,rc=d}]
-! end
-
-! (*
-! * How to right shift (unsigned) by a constant (32bits)
-! *)
-! fun srli{r,i,d} =
-! let val tmp = C.newReg()
-! in [I.operate{oper=I.ZAP,ra=r,rb=I.IMMop 0xf0,rc=tmp},
-! I.operate{oper=I.SRL,ra=tmp,rb=I.IMMop i,rc=d}]
-! end
-!
-! (*
-! * How to right shift (signed) by a constant (32bits)
-! *)
-! fun srai{r,i,d} =
-! let val tmp = C.newReg()
-! in [I.operate{oper=I.ADDL,ra=r,rb=zeroOpn,rc=tmp},
-! I.operate{oper=I.SRA,ra=tmp,rb=I.IMMop i,rc=d}]
-! end
-!
-! val trapping = false
- val multCost = multCost
-! fun addv{r1,r2,d} = [I.operate{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}]
-! fun subv{r1,r2,d} = [I.operate{oper=I.SUBL,ra=r1,rb=I.REGop r2,rc=d}]
- val sh1addv = NONE
-! val sh2addv = SOME(fn {r1,r2,d} =>
-! [I.operate{oper=I.S4ADDL,ra=r1,rb=I.REGop r2,rc=d}])
-! val sh3addv = SOME(fn {r1,r2,d} =>
-! [I.operate{oper=I.S8ADDL,ra=r1,rb=I.REGop r2,rc=d}])
-!
-! val signed = false)
-! (* signed, non-trapping version of multiply and divide *)
-! structure Muls32 = MLTreeMult
-! (structure I = I
-! structure T = T
-! structure CB = CellsBasis
-
-! val intTy = 32
-!
-! type arg = {r1:CB.cell,r2:CB.cell,d:CB.cell}
-! type argi = {r:CB.cell,i:int,d:CB.cell}
-!
-! fun mov{r,d} = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
-! fun add{r1,r2,d} = I.operate{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}
-! (*
-! * How to left shift by a constant (32bits)
-! *)
-! fun slli{r,i=1,d} = [I.operate{oper=I.ADDL,ra=r,rb=I.REGop r,rc=d}]
-! | slli{r,i=2,d} = [I.operate{oper=I.S4ADDL,ra=r,rb=zeroOpn,rc=d}]
-! | slli{r,i=3,d} = [I.operate{oper=I.S8ADDL,ra=r,rb=zeroOpn,rc=d}]
-! | slli{r,i,d} =
-! let val tmp = C.newReg()
-! in [I.operate{oper=I.SLL,ra=r,rb=I.IMMop i,rc=tmp},
-! I.operate{oper=I.ADDL,ra=tmp,rb=zeroOpn,rc=d}]
-! end
-!
-! (*
-! * How to right shift (unsigned) by a constant (32bits)
-! *)
-! fun srli{r,i,d} =
-! let val tmp = C.newReg()
-! in [I.operate{oper=I.ZAP,ra=r,rb=I.IMMop 0xf0,rc=tmp},
-! I.operate{oper=I.SRL,ra=tmp,rb=I.IMMop i,rc=d}]
-! end
-!
-! (*
-! * How to right shift (signed) by a constant (32bits)
-! *)
-! fun srai{r,i,d} =
-! let val tmp = C.newReg()
-! in [I.operate{oper=I.ADDL,ra=r,rb=zeroOpn,rc=tmp},
-! I.operate{oper=I.SRA,ra=tmp,rb=I.IMMop i,rc=d}]
-! end
-!
-! val trapping = false
- val multCost = multCost
- fun addv{r1,r2,d} = [I.operate{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}]
-***************
-*** 299,309 ****
- val sh3addv = SOME(fn {r1,r2,d} =>
- [I.operate{oper=I.S8ADDL,ra=r1,rb=I.REGop r2,rc=d}])
-! )
-! structure Mulu32 = Mul32(val signed = false)
-! structure Muls32 = Mul32(val signed = true)
-
- (* signed, trapping version of multiply and divide *)
-! structure Mult64 = Multiply64
-! (val trapping = true
- val multCost = multCost
- fun addv{r1,r2,d} = [I.operatev{oper=I.ADDQV,ra=r1,rb=I.REGop r2,rc=d}]
---- 437,461 ----
- val sh3addv = SOME(fn {r1,r2,d} =>
- [I.operate{oper=I.S8ADDL,ra=r1,rb=I.REGop r2,rc=d}])
-!
-! val signed = true)
-
- (* signed, trapping version of multiply and divide *)
-! structure Mult64 = MLTreeMult
-! (structure I = I
-! structure T = T
-! structure CB = CellsBasis
-!
-! val intTy = 64
-!
-! type arg = {r1:CB.cell, r2:CB.cell, d:CB.cell}
-! type argi = {r:CB.cell, i:int, d:CB.cell}
-!
-! fun mov{r,d} = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
-! fun add{r1,r2,d}= I.operate{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}
-! fun slli{r,i,d} = [I.operate{oper=I.SLL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srli{r,i,d} = [I.operate{oper=I.SRL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srai{r,i,d} = [I.operate{oper=I.SRA,ra=r,rb=I.IMMop i,rc=d}]
-!
-! val trapping = true
- val multCost = multCost
- fun addv{r1,r2,d} = [I.operatev{oper=I.ADDQV,ra=r1,rb=I.REGop r2,rc=d}]
-***************
-*** 312,321 ****
- val sh2addv = NONE
- val sh3addv = NONE
-! )
-! (val signed = true)
-
- (* unsigned, non-trapping version of multiply and divide *)
-! functor Mul64 = Multiply64
-! (val trapping = false
- val multCost = multCost
- fun addv{r1,r2,d} = [I.operate{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}]
---- 464,516 ----
- val sh2addv = NONE
- val sh3addv = NONE
-!
-! val signed = true)
-
- (* unsigned, non-trapping version of multiply and divide *)
-! structure Mulu64 = MLTreeMult
-! (structure I = I
-! structure T = T
-! structure CB = CellsBasis
-!
-! val intTy = 64
-!
-! type arg = {r1:CB.cell, r2:CB.cell, d:CB.cell}
-! type argi = {r:CB.cell, i:int, d:CB.cell}
-!
-! fun mov{r,d} = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
-! fun add{r1,r2,d}= I.operate{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}
-! fun slli{r,i,d} = [I.operate{oper=I.SLL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srli{r,i,d} = [I.operate{oper=I.SRL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srai{r,i,d} = [I.operate{oper=I.SRA,ra=r,rb=I.IMMop i,rc=d}]
-!
-! val trapping = false
-! val multCost = multCost
-! fun addv{r1,r2,d} = [I.operate{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}]
-! fun subv{r1,r2,d} = [I.operate{oper=I.SUBQ,ra=r1,rb=I.REGop r2,rc=d}]
-! val sh1addv = NONE
-! val sh2addv = SOME(fn {r1,r2,d} =>
-! [I.operate{oper=I.S4ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
-! val sh3addv = SOME(fn {r1,r2,d} =>
-! [I.operate{oper=I.S8ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
-!
-! val signed = false)
-! (* signed, non-trapping version of multiply and divide *)
-! structure Muls64 = MLTreeMult
-! (structure I = I
-! structure T = T
-! structure CB = CellsBasis
-!
-! val intTy = 64
-!
-! type arg = {r1:CB.cell, r2:CB.cell, d:CB.cell}
-! type argi = {r:CB.cell, i:int, d:CB.cell}
-!
-! fun mov{r,d} = I.COPY{k=CB.GP, sz=intTy, dst=[d],src=[r],tmp=NONE}
-! fun add{r1,r2,d}= I.operate{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}
-! fun slli{r,i,d} = [I.operate{oper=I.SLL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srli{r,i,d} = [I.operate{oper=I.SRL,ra=r,rb=I.IMMop i,rc=d}]
-! fun srai{r,i,d} = [I.operate{oper=I.SRA,ra=r,rb=I.IMMop i,rc=d}]
-!
-! val trapping = false
- val multCost = multCost
- fun addv{r1,r2,d} = [I.operate{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}]
-***************
-*** 326,332 ****
- val sh3addv = SOME(fn {r1,r2,d} =>
- [I.operate{oper=I.S8ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
-! )
-! structure Mulu64 = Mul64(val signed = false)
-! structure Muls64 = Mul64(val signed = true)
-
- (*
---- 521,526 ----
- val sh3addv = SOME(fn {r1,r2,d} =>
- [I.operate{oper=I.S8ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
-!
-! val signed = true)
-
- (*
-***************
-*** 972,979 ****
- | T.ADD(64,e,T.LABEXP le) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
- | T.ADD(64,T.LABEXP le,e) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
-! | T.ADD(64,e,x as (T.CONST _ | T.LABEL _)) =>
-! mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
-! | T.ADD(64,x as (T.CONST _ | T.LABEL _),e) =>
-! mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
- | T.ADD(64,e,T.LI i) => loadImmed(i, expr e, d, an)
- | T.ADD(64,T.LI i,e) => loadImmed(i, expr e, d, an)
---- 1166,1173 ----
- | T.ADD(64,e,T.LABEXP le) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
- | T.ADD(64,T.LABEXP le,e) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
-! | T.ADD(64,e,x as T.CONST _) => mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
-! | T.ADD(64,e,x as T.LABEL _) => mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
-! | T.ADD(64,x as T.CONST _,e) => mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
-! | T.ADD(64,x as T.LABEL _,e) => mark(I.LDA{r=d,b=expr e,d=I.LABop x},an)
- | T.ADD(64,e,T.LI i) => loadImmed(i, expr e, d, an)
- | T.ADD(64,T.LI i,e) => loadImmed(i, expr e, d, an)
-***************
-*** 1068,1073 ****
- | T.SX(_,_,T.LOAD(16,ea,mem))=> load16s(ea,d,mem,an)
- | T.SX(_,_,T.LOAD(32,ea,mem))=> load32s(ea,d,mem,an)
-! | T.ZX((8|16|32|64),_,T.LOAD(8,ea,mem)) => load8(ea,d,mem,an)
-! | T.ZX((16|32|64),_,T.LOAD(16,ea,mem))=> load16(ea,d,mem,an)
- | T.ZX(64,_,T.LOAD(64,ea,mem)) => load(I.LDQ,ea,d,mem,an)
- | T.LOAD(8,ea,mem) => load8(ea,d,mem,an)
---- 1262,1272 ----
- | T.SX(_,_,T.LOAD(16,ea,mem))=> load16s(ea,d,mem,an)
- | T.SX(_,_,T.LOAD(32,ea,mem))=> load32s(ea,d,mem,an)
-! | T.ZX(8,_,T.LOAD(8,ea,mem)) => load8(ea,d,mem,an)
-! | T.ZX(16,_,T.LOAD(8,ea,mem)) => load8(ea,d,mem,an)
-! | T.ZX(32,_,T.LOAD(8,ea,mem)) => load8(ea,d,mem,an)
-! | T.ZX(64,_,T.LOAD(8,ea,mem)) => load8(ea,d,mem,an)
-! | T.ZX(16,_,T.LOAD(16,ea,mem))=> load16(ea,d,mem,an)
-! | T.ZX(32,_,T.LOAD(16,ea,mem))=> load16(ea,d,mem,an)
-! | T.ZX(64,_,T.LOAD(16,ea,mem))=> load16(ea,d,mem,an)
- | T.ZX(64,_,T.LOAD(64,ea,mem)) => load(I.LDQ,ea,d,mem,an)
- | T.LOAD(8,ea,mem) => load8(ea,d,mem,an)
-***************
-*** 1392,1397 ****
- (* move the immed operand to b *)
- case a of
-! (T.LI _ | T.CONST _ | T.LABEL _ | T.LABEXP _) =>
-! (T.Basis.swapCond cond,b,a)
- | _ => (cond,a,b)
-
---- 1591,1598 ----
- (* move the immed operand to b *)
- case a of
-! T.LI _ => (T.Basis.swapCond cond,b,a)
-! | T.CONST _ => (T.Basis.swapCond cond,b,a)
-! | T.LABEL _ => (T.Basis.swapCond cond,b,a)
-! | T.LABEXP _ => (T.Basis.swapCond cond,b,a)
- | _ => (cond,a,b)
-
-***************
-*** 1456,1461 ****
- val (cond,e1,e2) =
- case e1 of
-! (T.LI _ | T.CONST _ | T.LABEL _ | T.LABEXP _) =>
-! (T.Basis.swapCond cond,e2,e1)
- | _ => (cond,e1,e2)
- in case cond of
---- 1657,1664 ----
- val (cond,e1,e2) =
- case e1 of
-! T.LI _ => (T.Basis.swapCond cond,e2,e1)
-! | T.CONST _ => (T.Basis.swapCond cond,e2,e1)
-! | T.LABEL _ => (T.Basis.swapCond cond,e2,e1)
-! | 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
-!
More information about the MLton-commit
mailing list