Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/mltree/mltree-basis.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/mltree/mltree-basis.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 409, Fri Sep 3 00:21:52 1999 UTC revision 1120, Wed Mar 6 17:16:36 2002 UTC
# Line 1  Line 1 
1    (* mltree-basis.sml
2     *
3     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4     *)
5    
6  structure MLTreeBasis : MLTREE_BASIS =  structure MLTreeBasis : MLTREE_BASIS =
7  struct  struct
8    
9      type attribs = word
10    
11      type misc_op = {name:string, hash:word, attribs:attribs ref}
12    
13    datatype cond = LT | LTU | LE | LEU | EQ | NE | GE | GEU | GT | GTU    datatype cond = LT | LTU | LE | LEU | EQ | NE | GE | GEU | GT | GTU
14                    | SETCC
15                    | MISC_COND of {name:string, hash:word, attribs:attribs ref}
16    
17    datatype fcond = ? | !<=> | == | ?= | !<> | !?>= | < | ?< | !>= | !?> |  (* Floating-point conditions: see mltree-basis.sig for documentation *)
18                     <= | ?<= | !> | !?<= | > | ?> | !<= | !?< | >= | ?>= |    datatype fcond
19                     !< | !?= | <> | != | !? | <=> | ?<>      = == | ?<> | > | >= | < | <= | ? | <> | <=>
20        | ?> | ?>= | ?< | ?<= | ?=
21        | SETFCC
22        | MISC_FCOND of {name:string, hash:word, attribs:word ref}
23    
24    datatype ext = SIGN_EXTEND | ZERO_EXTEND    datatype ext = SIGN_EXTEND | ZERO_EXTEND
25    
26    datatype rounding_mode = TO_NEAREST | TO_NEGINF | TO_POSINF | TO_ZERO    datatype rounding_mode = TO_NEAREST | TO_NEGINF | TO_POSINF | TO_ZERO
27    
28    type attribs = word    fun error(msg, oper) = MLRiscErrorMsg.error("MLTreeBasis",msg^": "^oper)
29    
30    type misc_op = {ty:int,name:string,attribs:attribs,hash:word}    nonfix <> < > >= <=
31    
32    (* Should be datatypes, but FLINT does not optimize them well *)    (* These should be datatypes, but FLINT does not optimize them well *)
33    type ty = int    type ty = int
34    type fty = int    type fty = int
35    
36  end    fun condToString cond =
37          case cond of
38            LT  => "LT" | LTU => "LTU" | LE  => "LE" | LEU => "LEU"
39          | EQ  => "EQ" | NE  => "NE"  | GE  => "GE" | GEU => "GEU"
40          | GT  => "GT" | GTU => "GTU"
41          | SETCC => "SETCC"
42          | MISC_COND{name,...} => name
43    
44      fun fcondToString fcond = case fcond
45         of ==  => "==" | ?<> => "?<>"
46          | > => ">"    | >= => ">="   | <   => "<"  | <=  => "<="
47          | ? => "?"    | <>  => "<>"  | <=> => "<=>"
48          | ?> => "?<"  | ?>= => "?>=" | ?< => "?<"  | ?<= => "?<=" | ?= => "?="
49          | SETFCC => "SETFCC"
50          | MISC_FCOND{name, ...} => name
51    
52      fun swapCond cond =
53          case cond of
54            LT  => GT | LTU => GTU | LE  => GE | LEU => GEU | EQ  => EQ
55          | NE  => NE | GE  => LE | GEU => LEU | GT  => LT | GTU => LTU
56          | cond => error("swapCond",condToString cond)
57    
58    (* swap order of arguments *)
59      fun swapFcond fcond =
60          case fcond of
61            ?     => ?   | ==    => ==
62          | ?=    => ?=
63          | <     => >   | ?<    => ?>
64          | <=    => >=  | ?<=   => ?>=
65          | >     => <
66          | ?>    => ?<
67          | >=    => <=  | ?>=   => ?<=
68          | <>    => <>
69          | <=>   => <=> | ?<>   => ?<>
70          | fcond => error("swapFcond",fcondToString fcond)
71    
72      fun negateCond cond =
73          case cond of
74            LT  => GE | LTU => GEU | LE  => GT | LEU => GTU | EQ  => NE
75          | NE  => EQ | GE  => LT | GEU => LTU | GT  => LE | GTU => LEU
76          | cond => error("negateCond",condToString cond)
77    
78      fun negateFcond fcond =
79          case fcond of
80            ==   => ?<> | ?<>  => ==   | ?    => <=>
81          | <=>  => ?  | >    => ?<=  | >=   => ?<
82          | ?>   => <= | ?>=  => <    | <    => ?>=
83          | <=   => ?> | ?<   => >=   | ?<=  => >
84          | <>   => ?= | ?=   => <>
85          | _    => error("negateFcond", fcondToString fcond)
86    
87      fun hashCond cond =
88          case cond of
89            LT  => 0w123 | LTU => 0w758 | LE  => 0w81823 | LEU => 0w1231
90          | EQ  => 0w987 | NE  => 0w8819 | GE  => 0w88123 | GEU => 0w975
91          | GT  => 0w1287 | GTU => 0w2457
92          | SETCC => 0w23
93          | MISC_COND{hash, ...} => hash
94    
95      fun hashFcond fcond =
96          case fcond of
97            ?     => 0w123 | ==    => 0w12345 | ?=    => 0w123456
98          | <   => 0w23456 | ?<    => 0w345
99          | <=  => 0w456   | ?<=   => 0w4567
100          | >  => 0w5678  | ?>    => 0w56789
101          | >=    => 0w67890 | ?>=   => 0w789
102          | <>    => 0w890
103          | <=>   => 0w991 | ?<>   => 0w391
104          | SETFCC => 0w94
105          | MISC_FCOND{hash, ...} => hash
106    
107      fun hashRoundingMode m =
108          case m of
109            TO_NEAREST => 0w1 | TO_NEGINF => 0w10
110          | TO_POSINF => 0w100 | TO_ZERO     => 0w1000
111    
112      fun roundingModeToString m =
113          case m of
114            TO_NEAREST  => "TO_NEAREST" | TO_NEGINF   => "TO_NEGINF"
115          | TO_POSINF   => "TO_POSINF" | TO_ZERO     => "TO_ZERO"
116    
117    end (* MLTreeBasis *)

Legend:
Removed from v.409  
changed lines
  Added in v.1120

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0