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 4667, Tue Jun 12 18:46:48 2018 UTC
# Line 1  Line 1 
1  (* Copyright 1996 by Bell Laboratories *)  (* ppcps.sml
2  (* ppcps.sml *)   *
3     * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
4     * All rights reserved.
5     *)
6    
7  signature PPCPS =  signature PPCPS =
8  sig  sig
9    val printcps : (CPS.function * LtyDef.lty Intmap.intmap) -> unit  
10        val value2str : CPS.value -> string
11    
12        val printcps : (CPS.function * LtyDef.lty IntHashTable.hash_table) -> unit
13    val printcps0: CPS.function -> unit    val printcps0: CPS.function -> unit
14    val prcps : CPS.cexp -> unit    val prcps : CPS.cexp -> unit
15    
# Line 20  Line 26 
26    
27  val sayt = say o CPS.ctyToString  val sayt = say o CPS.ctyToString
28    
29    fun value2str (VAR v) = LV.lvarName v
30      | value2str (LABEL v) = "(L)" ^ LV.lvarName v
31      | value2str (NUM{ival, ty={sz=0, ...}}) = "(II)" ^ IntInf.toString ival
32      | value2str (NUM{ival, ty={tag=true, ...}}) = "(I)" ^ IntInf.toString ival
33      | value2str (NUM{ival, ty={sz, ...}}) = concat[
34            "(I", Int.toString sz, ")", IntInf.toString ival
35          ]
36      | value2str (REAL{rval, ty}) = concat[
37            "(R", Int.toString ty, ")", RealLit.toString rval
38          ]
39      | value2str (STRING s) = concat["\"", String.toString s, "\""]
40      | value2str (OBJECT _) = "(object)"
41      | value2str (VOID) = "(void)"
42    
43  fun numkindName (P.INT bits) = "i" ^ Int.toString bits  fun numkindName (P.INT bits) = "i" ^ Int.toString bits
44    | numkindName (P.UINT bits) = "u" ^ Int.toString bits    | numkindName (P.UINT bits) = "u" ^ Int.toString bits
45    | numkindName (P.FLOAT bits) = "f" ^ Int.toString bits    | numkindName (P.FLOAT bits) = "f" ^ Int.toString bits
# Line 28  Line 48 
48    | lookerName P.gethdlr = "gethdlr"    | lookerName P.gethdlr = "gethdlr"
49    | lookerName P.subscript = "subscript"    | lookerName P.subscript = "subscript"
50    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)
   | lookerName P.getrunvec = "getrunvec"  
51    | lookerName P.getvar = "getvar"    | lookerName P.getvar = "getvar"
   | lookerName P.deflvar = "deflvar"  
52    | lookerName P.getspecial = "getspecial"    | lookerName P.getspecial = "getspecial"
53    | lookerName P.getpseudo = "getpseudo"    | lookerName P.getpseudo = "getpseudo"
54      | lookerName (P.rawload {kind}) = ("rawload" ^ numkindName kind)
55    
56  fun branchName P.boxed = "boxed"  fun branchName P.boxed = "boxed"
57    | branchName P.unboxed = "unboxed"    | branchName P.unboxed = "unboxed"
# Line 63  Line 82 
82         | P.fULE  => "?<="         | P.fULE  => "?<="
83         | P.fUE   => "?="         | P.fUE   => "?="
84         | P.fUN   => "?"         | P.fUN   => "?"
85               | P.fsgn  => "sgn"
86       (*esac*)))       (*esac*)))
87    | branchName P.pneq = "pneq"    | branchName P.pneq = "pneq"
88    | branchName P.peql = "peql"    | branchName P.peql = "peql"
# Line 70  Line 90 
90    | branchName P.strneq = "strneq"    | branchName P.strneq = "strneq"
91    
92  fun setterName P.unboxedupdate = "unboxedupdate"  fun setterName P.unboxedupdate = "unboxedupdate"
   | setterName P.boxedupdate = "boxedupdate"  
93    | setterName P.update = "update"    | setterName P.update = "update"
94    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)
95    | setterName P.unboxedassign = "unboxedassign"    | setterName P.unboxedassign = "unboxedassign"
96    | setterName P.assign = "assign"    | setterName P.assign = "assign"
97    | setterName P.sethdlr = "sethdlr"    | setterName P.sethdlr = "sethdlr"
98    | setterName P.setvar = "setvar"    | setterName P.setvar = "setvar"
   | setterName P.uselvar = "uselvar"  
99    | setterName P.free = "free"    | setterName P.free = "free"
100    | setterName P.setspecial = "setspecial"    | setterName P.setspecial = "setspecial"
101    | setterName P.setpseudo = "setpseudo"    | setterName P.setpseudo = "setpseudo"
102    | setterName P.setmark = "setmark"    | setterName P.setmark = "setmark"
103    | setterName P.acclink = "acclink"    | setterName P.acclink = "acclink"
104      | setterName (P.rawstore {kind}) = ("rawstore" ^ numkindName kind)
105      | setterName (P.rawupdate cty) = ("rawupdate" ^ CPS.ctyToString cty)
106    
107  fun cvtParams(from, to) = Int.toString from ^ "_" ^ Int.toString to  val cvtParam = Int.toString
108    fun cvtParams(from, to) = concat [cvtParam from, "_", cvtParam to]
109    
110  fun arithName (P.arith{oper,kind}) =  fun arithName (P.arith{oper,kind}) =
111      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"
112                    | P./ => "/" |  P.~ => "~" | P.abs => "abs"                    | P./ => "/" |  P.~ => "~" | P.abs => "abs"
113                      | P.fsqrt => "fsqrt"
114                      | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"
115                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"
116                    | P.lshift => "lshift" | P.andb => "andb"                    | P.lshift => "lshift" | P.andb => "andb"
117                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb")                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb"
118                      | P.rem => "rem" | P.div => "div" | P.mod => "mod")
119       ^ numkindName kind)       ^ numkindName kind)
120    | arithName(P.test arg) = "test_" ^ cvtParams arg    | arithName(P.test arg) = "test_" ^ cvtParams arg
121    | arithName(P.testu arg) = "testu_" ^ cvtParams arg    | arithName(P.testu arg) = "testu_" ^ cvtParams arg
122      | arithName(P.test_inf i) = "test_inf_" ^ cvtParam i
123    | 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}) =
124        "floor"        "floor"
125    | 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 135 
135    | pureName (P.extend arg) = "extend_" ^ cvtParams arg    | pureName (P.extend arg) = "extend_" ^ cvtParams arg
136    | pureName (P.copy arg) = "copy_" ^ cvtParams arg    | pureName (P.copy arg) = "copy_" ^ cvtParams arg
137    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg
138      | pureName (P.trunc_inf i) = "trunc_inf_" ^ cvtParam i
139      | pureName (P.copy_inf i) = concat ["copy_", cvtParam i, "_inf"]
140      | pureName (P.extend_inf i) =  concat ["extend_", cvtParam i, "_inf"]
141    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"
142    | pureName (P.real{fromkind,tokind}) =    | pureName (P.real{fromkind,tokind}) =
143      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)
# Line 132  Line 160 
160    | pureName P.recsubscript = "recsubscript"    | pureName P.recsubscript = "recsubscript"
161    | pureName P.raw64subscript = "raw64subscript"    | pureName P.raw64subscript = "raw64subscript"
162    | pureName P.newarray0 = "newarray0"    | pureName P.newarray0 = "newarray0"
163      | pureName (P.rawrecord rk) =
164        "rawrecord_"^getOpt(Option.map rkstring rk, "notag")
165    
166  fun show0 say =  and rkstring rk = (case rk
   let fun sayc (#"\n") = say "\\n"  
         | sayc c = say(String.str c)  
   
       fun sayv(VAR v) = say(LV.lvarName v)  
         | sayv(LABEL v) = say("(L)" ^ LV.lvarName v)  
         | sayv(INT i) = say("(I)" ^ Int.toString i)  
         | sayv(INT32 i) = say("(I32)" ^ Word32.toString i)  
         | sayv(REAL r) = say r  
         | sayv(STRING s) = (say "\""; app sayc (explode s); say "\"")  
         | sayv(OBJECT _) = say("(object)")  
         | sayv(VOID) = say("(void)")  
   
       fun sayvlist [v] = sayv v  
         | sayvlist nil = ()  
         | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)  
   
   
       fun rkstring rk = (case rk  
167          of RK_VECTOR => "RK_VECTOR"          of RK_VECTOR => "RK_VECTOR"
168           | RK_RECORD => "RK_RECORD"           | RK_RECORD => "RK_RECORD"
169           | RK_SPILL => "RK_SPILL"           | RK_SPILL => "RK_SPILL"
# Line 164  Line 176 
176           | RK_FBLOCK => "RK_FBLOCK"           | RK_FBLOCK => "RK_FBLOCK"
177           | RK_I32BLOCK => "RK_I32BLOCK")           | RK_I32BLOCK => "RK_I32BLOCK")
178    
179    fun show0 say =
180      let fun sayc (#"\n") = say "\\n"
181            | sayc c = say(String.str c)
182    
183          fun sayv v = say(value2str v)
184    
185          fun sayvlist [v] = sayv v
186            | sayvlist nil = ()
187            | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
188    
189        fun sayrk(RK_RECORD,n) = ()        fun sayrk(RK_RECORD,n) = ()
190          | sayrk(RK_VECTOR,n) = ()          | sayrk(RK_VECTOR,n) = ()
191          | sayrk(k,n : int) = (say (rkstring k); say " ";          | sayrk(k,n : int) = (say (rkstring k); say " ";
# Line 236  Line 258 
258                      indent (n+3) e1;                      indent (n+3) e1;
259                      space n; say "else\n";                      space n; say "else\n";
260                      indent (n+3) e2)                      indent (n+3) e2)
261                  | RCC(k,l,p,vl,wtl,e) =>
262                       (space n;
263                        if k = REENTRANT_RCC then say "reentrant " else ();
264                        if l = "" then () else (say l; say " ");
265                        say "rcc("; sayvlist vl; say ") -> ";
266                        app (fn (w, t) => (sayv (VAR w); sayt(t))) wtl;
267                        nl(); f e)
268           in f           in f
269          end          end
270   in  indent   in  indent
# Line 247  Line 276 
276    
277      val _ = if (!Control.CG.debugRep)      val _ = if (!Control.CG.debugRep)
278              then (say "************************************************\n";              then (say "************************************************\n";
279                    Intmap.app ptv m;                    IntHashTable.appi ptv m;
280                    say "************************************************\n")                    say "************************************************\n")
281              else ()              else ()
282    
# Line 263  Line 292 
292  end  end
293    
294  exception NULLTABLE  exception NULLTABLE
295  val nulltable : LtyDef.lty Intmap.intmap= Intmap.new(8,NULLTABLE)  val nulltable : LtyDef.lty IntHashTable.hash_table =
296        IntHashTable.mkTable(8,NULLTABLE)
297    
298  fun printcps0 f = printcps(f,nulltable)  fun printcps0 f = printcps(f,nulltable)
299    

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

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