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 651, Thu Jun 1 18:34:03 2000 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)
   
   type misc_op = {name:string,attribs:attribs,hash:word}  
29    
30    nonfix <> < > >= <=    nonfix <> < > >= <=
31    
# Line 21  Line 33 
33    type ty = int    type ty = int
34    type fty = int    type fty = int
35    
36      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 =    fun swapCond cond =
53        case cond of        case cond of
54          LT  => GT | LTU => GTU | LE  => GE | LEU => GEU | EQ  => EQ          LT  => GT | LTU => GTU | LE  => GE | LEU => GEU | EQ  => EQ
55        | NE  => NE | GE  => LE | GEU => LEU | GT  => LT | GTU => LTU        | 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 =    fun negateCond cond =
73        case cond of        case cond of
74          LT  => GE | LTU => GEU | LE  => GT | LEU => GTU | EQ  => NE          LT  => GE | LTU => GEU | LE  => GT | LEU => GTU | EQ  => NE
75        | NE  => EQ | GE  => LT | GEU => LTU | GT  => LE | GTU => LEU        | 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 =    fun hashCond cond =
88        case cond of        case cond of
89          LT  => 0w123 | LTU => 0w758 | LE  => 0w81823 | LEU => 0w1231          LT  => 0w123 | LTU => 0w758 | LE  => 0w81823 | LEU => 0w1231
90        | EQ  => 0w987 | NE  => 0w8819 | GE  => 0w88123 | GEU => 0w975        | EQ  => 0w987 | NE  => 0w8819 | GE  => 0w88123 | GEU => 0w975
91        | GT  => 0w1287 | GTU => 0w2457        | GT  => 0w1287 | GTU => 0w2457
92          | SETCC => 0w23
93    fun condToString cond =        | MISC_COND{hash, ...} => hash
       case cond of  
         LT  => "<" | LTU => "<u" | LE  => "<=" | LEU => "<=u"  
       | EQ  => "=" | NE  => "<>" | GE  => ">=" | GEU => ">=u"  
       | GT  => ">" | GTU => ">u"  
94    
95    fun hashFcond fcond =    fun hashFcond fcond =
96        case fcond of        case fcond of
97          ?     => 0w123 | !<=>  => 0w1234 | ==    => 0w12345 | ?=    => 0w123456          ?     => 0w123 | ==    => 0w12345 | ?=    => 0w123456
98        | !<>   => 0w234 | !?>=  => 0w2345 | <   => 0w23456 | ?<    => 0w345        | <   => 0w23456 | ?<    => 0w345
99        | !>=   => 0w3456 | !?>   => 0w34567 | <=  => 0w456   | ?<=   => 0w4567        | <=  => 0w456   | ?<=   => 0w4567
100        | !>    => 0w45678 | !?<=  => 0w567 | >  => 0w5678  | ?>    => 0w56789        | >  => 0w5678  | ?>    => 0w56789
101        | !<=   => 0w678 | !?<   => 0w6789 | >=    => 0w67890 | ?>=   => 0w789        | >=    => 0w67890 | ?>=   => 0w789
102        | !<    => 0w7890 | !?=   => 0w78901 | <>    => 0w890 | !=    => 0w8901        | <>    => 0w890
103        | !?    => 0w89012 | <=>   => 0w991 | ?<>   => 0w391        | <=>   => 0w991 | ?<>   => 0w391
104          | SETFCC => 0w94
105    fun fcondToString fcond =        | MISC_FCOND{hash, ...} => hash
       case fcond of  
         ?     => "?" | !<=>  => "!<=>" | ==    => "==" | ?=    => "?="  
       | !<>   => "!<>" | !?>=  => "!?>=" | <     => "<" | ?<    => "?<"  
       | !>=   => "!>=" | !?>   => "!?>" | <=    => "<=" | ?<=   => "?<="  
       | !>    => "!>" | !?<=  => "!?<=" | >     => ">" | ?>    => "?>"  
       | !<=   => "!<=" | !?<   => "!?<" | >=    => ">=" | ?>=   => "?>="  
       | !<    => "!<" | !?=   => "!?=" | <>    => "<>" | !=    => "!="  
       | !?    => "!?" | <=>   => "<=>" | ?<>   => "?<>"  
106    
107    fun hashRoundingMode m =    fun hashRoundingMode m =
108        case m of        case m of
# Line 70  Line 111 
111    
112    fun roundingModeToString m =    fun roundingModeToString m =
113        case m of        case m of
114          TO_NEAREST  => "to_nearest" | TO_NEGINF   => "to_neginf"          TO_NEAREST  => "TO_NEAREST" | TO_NEGINF   => "TO_NEGINF"
115        | TO_POSINF   => "to_posinf" | TO_ZERO     => "to_zero"        | TO_POSINF   => "TO_POSINF" | TO_ZERO     => "TO_ZERO"
116    
117  end (* MLTreeBasis *)  end (* MLTreeBasis *)

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

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