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 731, Fri Nov 10 22:57:45 2000 UTC revision 1181, Wed Mar 27 21:27:27 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    datatype div_rounding_mode = DIV_TO_NEGINF | DIV_TO_ZERO
29    
30    type misc_op = {name:string,attribs:attribs,hash:word}    fun error(msg, oper) = MLRiscErrorMsg.error("MLTreeBasis",msg^": "^oper)
31    
32    nonfix <> < > >= <=    nonfix <> < > >= <=
33    
# Line 21  Line 35 
35    type ty = int    type ty = int
36    type fty = int    type fty = int
37    
38      fun condToString cond =
39          case cond of
40            LT  => "LT" | LTU => "LTU" | LE  => "LE" | LEU => "LEU"
41          | EQ  => "EQ" | NE  => "NE"  | GE  => "GE" | GEU => "GEU"
42          | GT  => "GT" | GTU => "GTU"
43          | SETCC => "SETCC"
44          | MISC_COND{name,...} => name
45    
46      fun fcondToString fcond = case fcond
47         of ==  => "==" | ?<> => "?<>"
48          | > => ">"    | >= => ">="   | <   => "<"  | <=  => "<="
49          | ? => "?"    | <>  => "<>"  | <=> => "<=>"
50          | ?> => "?<"  | ?>= => "?>=" | ?< => "?<"  | ?<= => "?<=" | ?= => "?="
51          | SETFCC => "SETFCC"
52          | MISC_FCOND{name, ...} => name
53    
54    fun swapCond cond =    fun swapCond cond =
55        case cond of        case cond of
56          LT  => GT | LTU => GTU | LE  => GE | LEU => GEU | EQ  => EQ          LT  => GT | LTU => GTU | LE  => GE | LEU => GEU | EQ  => EQ
57        | NE  => NE | GE  => LE | GEU => LEU | GT  => LT | GTU => LTU        | NE  => NE | GE  => LE | GEU => LEU | GT  => LT | GTU => LTU
58          | cond => error("swapCond",condToString cond)
59    
60    (* swap order of arguments *)
61    fun swapFcond fcond =    fun swapFcond fcond =
62        case fcond of        case fcond of
63          ?     => ?   | !<=>  => !<=> | ==    => ==          ?     => ?   | ==    => ==
64        | ?=    => ?=  | !<>   => !<>  | !?>=  => !?<=        | ?=    => ?=
65        | <     => >   | ?<    => ?>   | !>=   => !<=        | <     => >   | ?<    => ?>
66        | !?>   => !?< | <=    => >=   | ?<=   => ?>=        | <=    => >=  | ?<=   => ?>=
67        | !>    => !<  | !?<=  => !?>= | >     => <        | >     => <
68        | ?>    => ?<  | !<=   => !>=  | !?<   => !?>        | ?>    => ?<
69        | >=    => <=  | ?>=   => ?<=  | !<    => !>        | >=    => <=  | ?>=   => ?<=
70        | !?=   => !?= | <>    => <>   | !=    => !=        | <>    => <>
71        | !?    => !?  | <=>   => <=>  | ?<>   => ?<>        | <=>   => <=> | ?<>   => ?<>
72          | fcond => error("swapFcond",fcondToString fcond)
73    
74    fun negateCond cond =    fun negateCond cond =
75        case cond of        case cond of
76          LT  => GE | LTU => GEU | LE  => GT | LEU => GTU | EQ  => NE          LT  => GE | LTU => GEU | LE  => GT | LEU => GTU | EQ  => NE
77        | NE  => EQ | GE  => LT | GEU => LTU | GT  => LE | GTU => LEU        | NE  => EQ | GE  => LT | GEU => LTU | GT  => LE | GTU => LEU
78          | cond => error("negateCond",condToString cond)
79    
80      fun negateFcond fcond =
81          case fcond of
82            ==   => ?<> | ?<>  => ==   | ?    => <=>
83          | <=>  => ?  | >    => ?<=  | >=   => ?<
84          | ?>   => <= | ?>=  => <    | <    => ?>=
85          | <=   => ?> | ?<   => >=   | ?<=  => >
86          | <>   => ?= | ?=   => <>
87          | _    => error("negateFcond", fcondToString fcond)
88    
89    fun hashCond cond =    fun hashCond cond =
90        case cond of        case cond of
91          LT  => 0w123 | LTU => 0w758 | LE  => 0w81823 | LEU => 0w1231          LT  => 0w123 | LTU => 0w758 | LE  => 0w81823 | LEU => 0w1231
92        | EQ  => 0w987 | NE  => 0w8819 | GE  => 0w88123 | GEU => 0w975        | EQ  => 0w987 | NE  => 0w8819 | GE  => 0w88123 | GEU => 0w975
93        | GT  => 0w1287 | GTU => 0w2457        | GT  => 0w1287 | GTU => 0w2457
94          | SETCC => 0w23
95    fun condToString cond =        | MISC_COND{hash, ...} => hash
       case cond of  
         LT  => "<" | LTU => "<u" | LE  => "<=" | LEU => "<=u"  
       | EQ  => "=" | NE  => "<>" | GE  => ">=" | GEU => ">=u"  
       | GT  => ">" | GTU => ">u"  
96    
97    fun hashFcond fcond =    fun hashFcond fcond =
98        case fcond of        case fcond of
99          ?     => 0w123 | !<=>  => 0w1234 | ==    => 0w12345 | ?=    => 0w123456          ?     => 0w123 | ==    => 0w12345 | ?=    => 0w123456
100        | !<>   => 0w234 | !?>=  => 0w2345 | <   => 0w23456 | ?<    => 0w345        | <   => 0w23456 | ?<    => 0w345
101        | !>=   => 0w3456 | !?>   => 0w34567 | <=  => 0w456   | ?<=   => 0w4567        | <=  => 0w456   | ?<=   => 0w4567
102        | !>    => 0w45678 | !?<=  => 0w567 | >  => 0w5678  | ?>    => 0w56789        | >  => 0w5678  | ?>    => 0w56789
103        | !<=   => 0w678 | !?<   => 0w6789 | >=    => 0w67890 | ?>=   => 0w789        | >=    => 0w67890 | ?>=   => 0w789
104        | !<    => 0w7890 | !?=   => 0w78901 | <>    => 0w890 | !=    => 0w8901        | <>    => 0w890
105        | !?    => 0w89012 | <=>   => 0w991 | ?<>   => 0w391        | <=>   => 0w991 | ?<>   => 0w391
106          | SETFCC => 0w94
107    fun fcondToString fcond =        | MISC_FCOND{hash, ...} => hash
       case fcond of  
         ?     => "?" | !<=>  => "!<=>" | ==    => "==" | ?=    => "?="  
       | !<>   => "!<>" | !?>=  => "!?>=" | <     => "<" | ?<    => "?<"  
       | !>=   => "!>=" | !?>   => "!?>" | <=    => "<=" | ?<=   => "?<="  
       | !>    => "!>" | !?<=  => "!?<=" | >     => ">" | ?>    => "?>"  
       | !<=   => "!<=" | !?<   => "!?<" | >=    => ">=" | ?>=   => "?>="  
       | !<    => "!<" | !?=   => "!?=" | <>    => "<>" | !=    => "!="  
       | !?    => "!?" | <=>   => "<=>" | ?<>   => "?<>"  
108    
109    fun hashRoundingMode m =    fun hashRoundingMode m =
110        case m of        case m of
# Line 82  Line 113 
113    
114    fun roundingModeToString m =    fun roundingModeToString m =
115        case m of        case m of
116          TO_NEAREST  => "to_nearest" | TO_NEGINF   => "to_neginf"          TO_NEAREST  => "TO_NEAREST" | TO_NEGINF   => "TO_NEGINF"
117        | TO_POSINF   => "to_posinf" | TO_ZERO     => "to_zero"        | TO_POSINF   => "TO_POSINF" | TO_ZERO     => "TO_ZERO"
118    
119  end (* MLTreeBasis *)  end (* MLTreeBasis *)

Legend:
Removed from v.731  
changed lines
  Added in v.1181

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