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 733, Fri Nov 17 05:13:45 2000 UTC sml/trunk/compiler/FLINT/cps/ppcps.sml revision 4446, Wed Sep 20 23:40:53 2017 UTC
# Line 1  Line 1 
1  (* Copyright 1996 by Bell Laboratories *)  (* ppcps.sml
2  (* ppcps.sml *)   *
3     * COPYRIGHT (c) 2017 The Fellowship of SML/NJ (http://www.smlnj.org)
4     * All rights reserved.
5     *)
6    
7  signature PPCPS =  signature PPCPS =
8  sig  sig
# Line 28  Line 31 
31    | lookerName P.gethdlr = "gethdlr"    | lookerName P.gethdlr = "gethdlr"
32    | lookerName P.subscript = "subscript"    | lookerName P.subscript = "subscript"
33    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)
   | lookerName P.getrunvec = "getrunvec"  
34    | lookerName P.getvar = "getvar"    | lookerName P.getvar = "getvar"
   | lookerName P.deflvar = "deflvar"  
35    | lookerName P.getspecial = "getspecial"    | lookerName P.getspecial = "getspecial"
36    | lookerName P.getpseudo = "getpseudo"    | lookerName P.getpseudo = "getpseudo"
37      | lookerName (P.rawload {kind}) = ("rawload" ^ numkindName kind)
38    
39  fun branchName P.boxed = "boxed"  fun branchName P.boxed = "boxed"
40    | branchName P.unboxed = "unboxed"    | branchName P.unboxed = "unboxed"
# Line 63  Line 65 
65         | P.fULE  => "?<="         | P.fULE  => "?<="
66         | P.fUE   => "?="         | P.fUE   => "?="
67         | P.fUN   => "?"         | P.fUN   => "?"
68               | P.fsgn  => "sgn"
69       (*esac*)))       (*esac*)))
70    | branchName P.pneq = "pneq"    | branchName P.pneq = "pneq"
71    | branchName P.peql = "peql"    | branchName P.peql = "peql"
# Line 70  Line 73 
73    | branchName P.strneq = "strneq"    | branchName P.strneq = "strneq"
74    
75  fun setterName P.unboxedupdate = "unboxedupdate"  fun setterName P.unboxedupdate = "unboxedupdate"
   | setterName P.boxedupdate = "boxedupdate"  
76    | setterName P.update = "update"    | setterName P.update = "update"
77    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)
78    | setterName P.unboxedassign = "unboxedassign"    | setterName P.unboxedassign = "unboxedassign"
79    | setterName P.assign = "assign"    | setterName P.assign = "assign"
80    | setterName P.sethdlr = "sethdlr"    | setterName P.sethdlr = "sethdlr"
81    | setterName P.setvar = "setvar"    | setterName P.setvar = "setvar"
   | setterName P.uselvar = "uselvar"  
82    | setterName P.free = "free"    | setterName P.free = "free"
83    | setterName P.setspecial = "setspecial"    | setterName P.setspecial = "setspecial"
84    | setterName P.setpseudo = "setpseudo"    | setterName P.setpseudo = "setpseudo"
85    | setterName P.setmark = "setmark"    | setterName P.setmark = "setmark"
86    | setterName P.acclink = "acclink"    | setterName P.acclink = "acclink"
87      | setterName (P.rawstore {kind}) = ("rawstore" ^ numkindName kind)
88      | setterName (P.rawupdate cty) = ("rawupdate" ^ CPS.ctyToString cty)
89    
90  fun cvtParams(from, to) = Int.toString from ^ "_" ^ Int.toString to  val cvtParam = Int.toString
91    fun cvtParams(from, to) = concat [cvtParam from, "_", cvtParam to]
92    
93  fun arithName (P.arith{oper,kind}) =  fun arithName (P.arith{oper,kind}) =
94      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"
# Line 93  Line 97 
97                    | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"                    | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"
98                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"
99                    | P.lshift => "lshift" | P.andb => "andb"                    | P.lshift => "lshift" | P.andb => "andb"
100                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb")                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb"
101                      | P.rem => "rem" | P.div => "div" | P.mod => "mod")
102       ^ numkindName kind)       ^ numkindName kind)
103    | arithName(P.test arg) = "test_" ^ cvtParams arg    | arithName(P.test arg) = "test_" ^ cvtParams arg
104    | arithName(P.testu arg) = "testu_" ^ cvtParams arg    | arithName(P.testu arg) = "testu_" ^ cvtParams arg
105      | arithName(P.test_inf i) = "test_inf_" ^ cvtParam i
106    | 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}) =
107        "floor"        "floor"
108    | 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 112  Line 118 
118    | pureName (P.extend arg) = "extend_" ^ cvtParams arg    | pureName (P.extend arg) = "extend_" ^ cvtParams arg
119    | pureName (P.copy arg) = "copy_" ^ cvtParams arg    | pureName (P.copy arg) = "copy_" ^ cvtParams arg
120    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg
121      | pureName (P.trunc_inf i) = "trunc_inf_" ^ cvtParam i
122      | pureName (P.copy_inf i) = concat ["copy_", cvtParam i, "_inf"]
123      | pureName (P.extend_inf i) =  concat ["extend_", cvtParam i, "_inf"]
124    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"
125    | pureName (P.real{fromkind,tokind}) =    | pureName (P.real{fromkind,tokind}) =
126      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)
# Line 134  Line 143 
143    | pureName P.recsubscript = "recsubscript"    | pureName P.recsubscript = "recsubscript"
144    | pureName P.raw64subscript = "raw64subscript"    | pureName P.raw64subscript = "raw64subscript"
145    | pureName P.newarray0 = "newarray0"    | pureName P.newarray0 = "newarray0"
146      | pureName (P.rawrecord rk) =
147        "rawrecord_"^getOpt(Option.map rkstring rk, "notag")
148      | pureName (P.condmove b) = "condmove "^branchName b
149    
150    and rkstring rk = (case rk
151            of RK_VECTOR => "RK_VECTOR"
152             | RK_RECORD => "RK_RECORD"
153             | RK_SPILL => "RK_SPILL"
154             | RK_ESCAPE => "RK_ESCAPE"
155             | RK_EXN => "RK_EXN"
156             | RK_CONT => "RK_CONT"
157             | RK_FCONT => "RK_FCONT"
158             | RK_KNOWN => "RK_KNOWN"
159             | RK_BLOCK => "RK_BLOCK"
160             | RK_FBLOCK => "RK_FBLOCK"
161             | RK_I32BLOCK => "RK_I32BLOCK")
162    
163    
164  fun show0 say =  fun show0 say =
165    let fun sayc (#"\n") = say "\\n"    let fun sayc (#"\n") = say "\\n"
# Line 153  Line 179 
179          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
180    
181    
       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")  
   
182        fun sayrk(RK_RECORD,n) = ()        fun sayrk(RK_RECORD,n) = ()
183          | sayrk(RK_VECTOR,n) = ()          | sayrk(RK_VECTOR,n) = ()
184          | sayrk(k,n : int) = (say (rkstring k); say " ";          | sayrk(k,n : int) = (say (rkstring k); say " ";
# Line 238  Line 251 
251                      indent (n+3) e1;                      indent (n+3) e1;
252                      space n; say "else\n";                      space n; say "else\n";
253                      indent (n+3) e2)                      indent (n+3) e2)
254                  | RCC(k,l,p,vl,wtl,e) =>
255                       (space n;
256                        if k = REENTRANT_RCC then say "reentrant " else ();
257                        if l = "" then () else (say l; say " ");
258                        say "rcc("; sayvlist vl; say ") -> ";
259                        app (fn (w, t) => (sayv (VAR w); sayt(t))) wtl;
260                        nl(); f e)
261           in f           in f
262          end          end
263   in  indent   in  indent

Legend:
Removed from v.733  
changed lines
  Added in v.4446

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