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/compiler/CPS/cps/ppcps.sml
ViewVC logotype

Diff of /sml/trunk/compiler/CPS/cps/ppcps.sml

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

sml/trunk/src/compiler/FLINT/cps/ppcps.sml revision 651, Thu Jun 1 18:34:03 2000 UTC sml/trunk/compiler/FLINT/cps/ppcps.sml revision 4418, Mon Sep 18 21:35:55 2017 UTC
# Line 3  Line 3 
3    
4  signature PPCPS =  signature PPCPS =
5  sig  sig
6    val printcps : (CPS.function * LtyDef.lty Intmap.intmap) -> unit    val printcps : (CPS.function * LtyDef.lty IntHashTable.hash_table) -> unit
7    val printcps0: CPS.function -> unit    val printcps0: CPS.function -> unit
8    val prcps : CPS.cexp -> unit    val prcps : CPS.cexp -> unit
9    
# Line 28  Line 28 
28    | lookerName P.gethdlr = "gethdlr"    | lookerName P.gethdlr = "gethdlr"
29    | lookerName P.subscript = "subscript"    | lookerName P.subscript = "subscript"
30    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)
   | lookerName P.getrunvec = "getrunvec"  
31    | lookerName P.getvar = "getvar"    | lookerName P.getvar = "getvar"
   | lookerName P.deflvar = "deflvar"  
32    | lookerName P.getspecial = "getspecial"    | lookerName P.getspecial = "getspecial"
33    | lookerName P.getpseudo = "getpseudo"    | lookerName P.getpseudo = "getpseudo"
34      | lookerName (P.rawload {kind}) = ("rawload" ^ numkindName kind)
35    
36  fun branchName P.boxed = "boxed"  fun branchName P.boxed = "boxed"
37    | branchName P.unboxed = "unboxed"    | branchName P.unboxed = "unboxed"
# Line 63  Line 62 
62         | P.fULE  => "?<="         | P.fULE  => "?<="
63         | P.fUE   => "?="         | P.fUE   => "?="
64         | P.fUN   => "?"         | P.fUN   => "?"
65               | P.fsgn  => "sgn"
66       (*esac*)))       (*esac*)))
67    | branchName P.pneq = "pneq"    | branchName P.pneq = "pneq"
68    | branchName P.peql = "peql"    | branchName P.peql = "peql"
# Line 77  Line 77 
77    | setterName P.assign = "assign"    | setterName P.assign = "assign"
78    | setterName P.sethdlr = "sethdlr"    | setterName P.sethdlr = "sethdlr"
79    | setterName P.setvar = "setvar"    | setterName P.setvar = "setvar"
   | setterName P.uselvar = "uselvar"  
80    | setterName P.free = "free"    | setterName P.free = "free"
81    | setterName P.setspecial = "setspecial"    | setterName P.setspecial = "setspecial"
82    | setterName P.setpseudo = "setpseudo"    | setterName P.setpseudo = "setpseudo"
83    | setterName P.setmark = "setmark"    | setterName P.setmark = "setmark"
84    | setterName P.acclink = "acclink"    | setterName P.acclink = "acclink"
85      | setterName (P.rawstore {kind}) = ("rawstore" ^ numkindName kind)
86      | setterName (P.rawupdate cty) = ("rawupdate" ^ CPS.ctyToString cty)
87    
88  fun cvtParams(from, to) = Int.toString from ^ "_" ^ Int.toString to  val cvtParam = Int.toString
89    fun cvtParams(from, to) = concat [cvtParam from, "_", cvtParam to]
90    
91  fun arithName (P.arith{oper,kind}) =  fun arithName (P.arith{oper,kind}) =
92      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"
93                    | P./ => "/" |  P.~ => "~" | P.abs => "abs"                    | P./ => "/" |  P.~ => "~" | P.abs => "abs"
94                      | P.fsqrt => "fsqrt"
95                      | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"
96                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"
97                    | P.lshift => "lshift" | P.andb => "andb"                    | P.lshift => "lshift" | P.andb => "andb"
98                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb")                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb"
99                      | P.rem => "rem" | P.div => "div" | P.mod => "mod")
100       ^ numkindName kind)       ^ numkindName kind)
101    | arithName(P.test arg) = "test_" ^ cvtParams arg    | arithName(P.test arg) = "test_" ^ cvtParams arg
102    | arithName(P.testu arg) = "testu_" ^ cvtParams arg    | arithName(P.testu arg) = "testu_" ^ cvtParams arg
103      | arithName(P.test_inf i) = "test_inf_" ^ cvtParam i
104    | arithName (P.round{floor=true,fromkind=P.FLOAT 64,tokind=P.INT 31}) =    | arithName (P.round{floor=true,fromkind=P.FLOAT 64,tokind=P.INT 31}) =
105        "floor"        "floor"
106    | arithName (P.round{floor=false,fromkind=P.FLOAT 64,tokind=P.INT 31}) =    | arithName (P.round{floor=false,fromkind=P.FLOAT 64,tokind=P.INT 31}) =
# Line 110  Line 116 
116    | pureName (P.extend arg) = "extend_" ^ cvtParams arg    | pureName (P.extend arg) = "extend_" ^ cvtParams arg
117    | pureName (P.copy arg) = "copy_" ^ cvtParams arg    | pureName (P.copy arg) = "copy_" ^ cvtParams arg
118    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg
119      | pureName (P.trunc_inf i) = "trunc_inf_" ^ cvtParam i
120      | pureName (P.copy_inf i) = concat ["copy_", cvtParam i, "_inf"]
121      | pureName (P.extend_inf i) =  concat ["extend_", cvtParam i, "_inf"]
122    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"
123    | pureName (P.real{fromkind,tokind}) =    | pureName (P.real{fromkind,tokind}) =
124      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)
# Line 132  Line 141 
141    | pureName P.recsubscript = "recsubscript"    | pureName P.recsubscript = "recsubscript"
142    | pureName P.raw64subscript = "raw64subscript"    | pureName P.raw64subscript = "raw64subscript"
143    | pureName P.newarray0 = "newarray0"    | pureName P.newarray0 = "newarray0"
144      | pureName (P.rawrecord rk) =
145        "rawrecord_"^getOpt(Option.map rkstring rk, "notag")
146      | pureName (P.condmove b) = "condmove "^branchName b
147    
148    and rkstring rk = (case rk
149            of RK_VECTOR => "RK_VECTOR"
150             | RK_RECORD => "RK_RECORD"
151             | RK_SPILL => "RK_SPILL"
152             | RK_ESCAPE => "RK_ESCAPE"
153             | RK_EXN => "RK_EXN"
154             | RK_CONT => "RK_CONT"
155             | RK_FCONT => "RK_FCONT"
156             | RK_KNOWN => "RK_KNOWN"
157             | RK_BLOCK => "RK_BLOCK"
158             | RK_FBLOCK => "RK_FBLOCK"
159             | RK_I32BLOCK => "RK_I32BLOCK")
160    
161    
162  fun show0 say =  fun show0 say =
163    let fun sayc (#"\n") = say "\\n"    let fun sayc (#"\n") = say "\\n"
# Line 151  Line 177 
177          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
178    
179    
       fun rkstring rk = (case rk  
         of RK_VECTOR => "RK_VECTOR"  
          | RK_RECORD => "RK_RECORD"  
          | RK_SPILL => "RK_SPILL"  
          | RK_ESCAPE => "RK_ESCAPE"  
          | RK_EXN => "RK_EXN"  
          | RK_CONT => "RK_CONT"  
          | RK_FCONT => "RK_FCONT"  
          | RK_KNOWN => "RK_KNOWN"  
          | RK_BLOCK => "RK_BLOCK"  
          | RK_FBLOCK => "RK_FBLOCK"  
          | RK_I32BLOCK => "RK_I32BLOCK")  
   
180        fun sayrk(RK_RECORD,n) = ()        fun sayrk(RK_RECORD,n) = ()
181          | sayrk(RK_VECTOR,n) = ()          | sayrk(RK_VECTOR,n) = ()
182          | sayrk(k,n : int) = (say (rkstring k); say " ";          | sayrk(k,n : int) = (say (rkstring k); say " ";
# Line 236  Line 249 
249                      indent (n+3) e1;                      indent (n+3) e1;
250                      space n; say "else\n";                      space n; say "else\n";
251                      indent (n+3) e2)                      indent (n+3) e2)
252                  | RCC(k,l,p,vl,wtl,e) =>
253                       (space n;
254                        if k = REENTRANT_RCC then say "reentrant " else ();
255                        if l = "" then () else (say l; say " ");
256                        say "rcc("; sayvlist vl; say ") -> ";
257                        app (fn (w, t) => (sayv (VAR w); sayt(t))) wtl;
258                        nl(); f e)
259           in f           in f
260          end          end
261   in  indent   in  indent
# Line 247  Line 267 
267    
268      val _ = if (!Control.CG.debugRep)      val _ = if (!Control.CG.debugRep)
269              then (say "************************************************\n";              then (say "************************************************\n";
270                    Intmap.app ptv m;                    IntHashTable.appi ptv m;
271                    say "************************************************\n")                    say "************************************************\n")
272              else ()              else ()
273    
# Line 263  Line 283 
283  end  end
284    
285  exception NULLTABLE  exception NULLTABLE
286  val nulltable : LtyDef.lty Intmap.intmap= Intmap.new(8,NULLTABLE)  val nulltable : LtyDef.lty IntHashTable.hash_table =
287        IntHashTable.mkTable(8,NULLTABLE)
288    
289  fun printcps0 f = printcps(f,nulltable)  fun printcps0 f = printcps(f,nulltable)
290    

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

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