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 4886, Wed Oct 10 16:54:46 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 (VOID) = "(void)"
41    
42  fun numkindName (P.INT bits) = "i" ^ Int.toString bits  fun numkindName (P.INT bits) = "i" ^ Int.toString bits
43    | numkindName (P.UINT bits) = "u" ^ Int.toString bits    | numkindName (P.UINT bits) = "u" ^ Int.toString bits
44    | numkindName (P.FLOAT bits) = "f" ^ Int.toString bits    | numkindName (P.FLOAT bits) = "f" ^ Int.toString bits
# Line 28  Line 47 
47    | lookerName P.gethdlr = "gethdlr"    | lookerName P.gethdlr = "gethdlr"
48    | lookerName P.subscript = "subscript"    | lookerName P.subscript = "subscript"
49    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)
   | lookerName P.getrunvec = "getrunvec"  
50    | lookerName P.getvar = "getvar"    | lookerName P.getvar = "getvar"
   | lookerName P.deflvar = "deflvar"  
51    | lookerName P.getspecial = "getspecial"    | lookerName P.getspecial = "getspecial"
52    | lookerName P.getpseudo = "getpseudo"    | lookerName (P.rawload {kind}) = ("rawload" ^ numkindName kind)
53    
54  fun branchName P.boxed = "boxed"  fun branchName P.boxed = "boxed"
55    | branchName P.unboxed = "unboxed"    | branchName P.unboxed = "unboxed"
# Line 63  Line 80 
80         | P.fULE  => "?<="         | P.fULE  => "?<="
81         | P.fUE   => "?="         | P.fUE   => "?="
82         | P.fUN   => "?"         | P.fUN   => "?"
83               | P.fsgn  => "sgn"
84       (*esac*)))       (*esac*)))
85    | branchName P.pneq = "pneq"    | branchName P.pneq = "pneq"
86    | branchName P.peql = "peql"    | branchName P.peql = "peql"
# Line 70  Line 88 
88    | branchName P.strneq = "strneq"    | branchName P.strneq = "strneq"
89    
90  fun setterName P.unboxedupdate = "unboxedupdate"  fun setterName P.unboxedupdate = "unboxedupdate"
   | setterName P.boxedupdate = "boxedupdate"  
91    | setterName P.update = "update"    | setterName P.update = "update"
92    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)
93    | setterName P.unboxedassign = "unboxedassign"    | setterName P.unboxedassign = "unboxedassign"
94    | setterName P.assign = "assign"    | setterName P.assign = "assign"
95    | setterName P.sethdlr = "sethdlr"    | setterName P.sethdlr = "sethdlr"
96    | setterName P.setvar = "setvar"    | setterName P.setvar = "setvar"
   | setterName P.uselvar = "uselvar"  
   | setterName P.free = "free"  
97    | setterName P.setspecial = "setspecial"    | setterName P.setspecial = "setspecial"
98    | setterName P.setpseudo = "setpseudo"    | setterName (P.rawstore {kind}) = ("rawstore" ^ numkindName kind)
99    | setterName P.setmark = "setmark"    | setterName (P.rawupdate cty) = ("rawupdate" ^ CPS.ctyToString cty)
   | setterName P.acclink = "acclink"  
100    
101  fun cvtParams(from, to) = Int.toString from ^ "_" ^ Int.toString to  val cvtParam = Int.toString
102    fun cvtParams(from, to) = concat [cvtParam from, "_", cvtParam to]
103    
104  fun arithName (P.arith{oper,kind}) =  fun arithName (P.arith{oper,kind}) =
105      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"
106                    | P./ => "/" |  P.~ => "~" | P.abs => "abs"                    | P./ => "/" |  P.~ => "~" | P.abs => "abs"
107                      | P.fsqrt => "fsqrt"
108                      | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"
109                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"
110                    | P.lshift => "lshift" | P.andb => "andb"                    | P.lshift => "lshift" | P.andb => "andb"
111                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb")                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb"
112                      | P.rem => "rem" | P.div => "div" | P.mod => "mod")
113       ^ numkindName kind)       ^ numkindName kind)
114    | arithName(P.test arg) = "test_" ^ cvtParams arg    | arithName(P.test arg) = "test_" ^ cvtParams arg
115    | arithName(P.testu arg) = "testu_" ^ cvtParams arg    | arithName(P.testu arg) = "testu_" ^ cvtParams arg
116      | arithName(P.test_inf i) = "test_inf_" ^ cvtParam i
117    | 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}) =
118        "floor"        "floor"
119    | 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 129 
129    | pureName (P.extend arg) = "extend_" ^ cvtParams arg    | pureName (P.extend arg) = "extend_" ^ cvtParams arg
130    | pureName (P.copy arg) = "copy_" ^ cvtParams arg    | pureName (P.copy arg) = "copy_" ^ cvtParams arg
131    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg
132      | pureName (P.trunc_inf i) = "trunc_inf_" ^ cvtParam i
133      | pureName (P.copy_inf i) = concat ["copy_", cvtParam i, "_inf"]
134      | pureName (P.extend_inf i) =  concat ["extend_", cvtParam i, "_inf"]
135    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"
136    | pureName (P.real{fromkind,tokind}) =    | pureName (P.real{fromkind,tokind}) =
137      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)        concat ["real", numkindName fromkind, "_", numkindName tokind]
138    | pureName P.subscriptv = "subscriptv"    | pureName P.subscriptv = "subscriptv"
139    | pureName (P.pure_numsubscript{kind}) = ("numsubscriptv" ^ numkindName kind)    | pureName (P.pure_numsubscript{kind}) = ("numsubscriptv" ^ numkindName kind)
140    | pureName P.gettag = "gettag"    | pureName P.gettag = "gettag"
141    | pureName P.mkspecial = "mkspecial"    | pureName P.mkspecial = "mkspecial"
   | pureName P.wrap = "wrap"  
   | pureName P.unwrap = "unwrap"  
142    | pureName P.cast = "cast"    | pureName P.cast = "cast"
143    | pureName P.getcon = "getcon"    | pureName P.getcon = "getcon"
144    | pureName P.getexn = "getexn"    | pureName P.getexn = "getexn"
145    | pureName P.fwrap = "fwrap"    | pureName P.box = "box"
146    | pureName P.funwrap = "funwrap"    | pureName P.unbox = "unbox"
147    | pureName P.iwrap = "iwrap"    | pureName (P.wrap kind) = "wrap_" ^ numkindName kind
148    | pureName P.iunwrap = "iunwrap"    | pureName (P.unwrap kind) = "unwrap_" ^ numkindName kind
   | pureName P.i32wrap = "i32wrap"  
   | pureName P.i32unwrap = "i32unwrap"  
149    | pureName P.getseqdata = "getseqdata"    | pureName P.getseqdata = "getseqdata"
150    | pureName P.recsubscript = "recsubscript"    | pureName P.recsubscript = "recsubscript"
151    | pureName P.raw64subscript = "raw64subscript"    | pureName P.raw64subscript = "raw64subscript"
152    | pureName P.newarray0 = "newarray0"    | pureName P.newarray0 = "newarray0"
153      | pureName (P.rawrecord rk) = "rawrecord_"^getOpt(Option.map rkstring rk, "notag")
154    
155  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  
156          of RK_VECTOR => "RK_VECTOR"          of RK_VECTOR => "RK_VECTOR"
157           | RK_RECORD => "RK_RECORD"           | RK_RECORD => "RK_RECORD"
158           | RK_SPILL => "RK_SPILL"           | RK_SPILL => "RK_SPILL"
# Line 162  Line 163 
163           | RK_KNOWN => "RK_KNOWN"           | RK_KNOWN => "RK_KNOWN"
164           | RK_BLOCK => "RK_BLOCK"           | RK_BLOCK => "RK_BLOCK"
165           | RK_FBLOCK => "RK_FBLOCK"           | RK_FBLOCK => "RK_FBLOCK"
166           | RK_I32BLOCK => "RK_I32BLOCK")          | RK_I32BLOCK => "RK_I32BLOCK"
167          (* end case *))
168    
169    fun show0 say =
170      let fun sayc (#"\n") = say "\\n"
171            | sayc c = say(String.str c)
172    
173          fun sayv v = say(value2str v)
174    
175          fun sayvlist [v] = sayv v
176            | sayvlist nil = ()
177            | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
178    
179        fun sayrk(RK_RECORD,n) = ()        fun sayrk(RK_RECORD,n) = ()
180          | sayrk(RK_VECTOR,n) = ()          | sayrk(RK_VECTOR,n) = ()
# Line 236  Line 248 
248                      indent (n+3) e1;                      indent (n+3) e1;
249                      space n; say "else\n";                      space n; say "else\n";
250                      indent (n+3) e2)                      indent (n+3) e2)
251                  | RCC(k,l,p,vl,wtl,e) =>
252                       (space n;
253                        if k = REENTRANT_RCC then say "reentrant " else ();
254                        if l = "" then () else (say l; say " ");
255                        say "rcc("; sayvlist vl; say ") -> ";
256                        app (fn (w, t) => (sayv (VAR w); sayt(t))) wtl;
257                        nl(); f e)
258           in f           in f
259          end          end
260   in  indent   in  indent
# Line 247  Line 266 
266    
267      val _ = if (!Control.CG.debugRep)      val _ = if (!Control.CG.debugRep)
268              then (say "************************************************\n";              then (say "************************************************\n";
269                    Intmap.app ptv m;                    IntHashTable.appi ptv m;
270                    say "************************************************\n")                    say "************************************************\n")
271              else ()              else ()
272    
# Line 263  Line 282 
282  end  end
283    
284  exception NULLTABLE  exception NULLTABLE
285  val nulltable : LtyDef.lty Intmap.intmap= Intmap.new(8,NULLTABLE)  val nulltable : LtyDef.lty IntHashTable.hash_table =
286        IntHashTable.mkTable(8,NULLTABLE)
287    
288  fun printcps0 f = printcps(f,nulltable)  fun printcps0 f = printcps(f,nulltable)
289    

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

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