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 4419, Mon Sep 18 21:53:44 2017 UTC
# 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 70  Line 70 
70    | branchName P.strneq = "strneq"    | branchName P.strneq = "strneq"
71    
72  fun setterName P.unboxedupdate = "unboxedupdate"  fun setterName P.unboxedupdate = "unboxedupdate"
   | setterName P.boxedupdate = "boxedupdate"  
73    | setterName P.update = "update"    | setterName P.update = "update"
74    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)
75    | setterName P.unboxedassign = "unboxedassign"    | setterName P.unboxedassign = "unboxedassign"
76    | setterName P.assign = "assign"    | setterName P.assign = "assign"
77    | setterName P.sethdlr = "sethdlr"    | setterName P.sethdlr = "sethdlr"
78    | setterName P.setvar = "setvar"    | setterName P.setvar = "setvar"
   | setterName P.uselvar = "uselvar"  
79    | setterName P.free = "free"    | setterName P.free = "free"
80    | setterName P.setspecial = "setspecial"    | setterName P.setspecial = "setspecial"
81    | setterName P.setpseudo = "setpseudo"    | setterName P.setpseudo = "setpseudo"
82    | setterName P.setmark = "setmark"    | setterName P.setmark = "setmark"
83    | setterName P.acclink = "acclink"    | setterName P.acclink = "acclink"
84      | setterName (P.rawstore {kind}) = ("rawstore" ^ numkindName kind)
85      | setterName (P.rawupdate cty) = ("rawupdate" ^ CPS.ctyToString cty)
86    
87  fun cvtParams(from, to) = Int.toString from ^ "_" ^ Int.toString to  val cvtParam = Int.toString
88    fun cvtParams(from, to) = concat [cvtParam from, "_", cvtParam to]
89    
90  fun arithName (P.arith{oper,kind}) =  fun arithName (P.arith{oper,kind}) =
91      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"
# Line 93  Line 94 
94                    | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"                    | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"
95                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"
96                    | P.lshift => "lshift" | P.andb => "andb"                    | P.lshift => "lshift" | P.andb => "andb"
97                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb")                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb"
98                      | P.rem => "rem" | P.div => "div" | P.mod => "mod")
99       ^ numkindName kind)       ^ numkindName kind)
100    | arithName(P.test arg) = "test_" ^ cvtParams arg    | arithName(P.test arg) = "test_" ^ cvtParams arg
101    | arithName(P.testu arg) = "testu_" ^ cvtParams arg    | arithName(P.testu arg) = "testu_" ^ cvtParams arg
102      | arithName(P.test_inf i) = "test_inf_" ^ cvtParam i
103    | 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}) =
104        "floor"        "floor"
105    | 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 115 
115    | pureName (P.extend arg) = "extend_" ^ cvtParams arg    | pureName (P.extend arg) = "extend_" ^ cvtParams arg
116    | pureName (P.copy arg) = "copy_" ^ cvtParams arg    | pureName (P.copy arg) = "copy_" ^ cvtParams arg
117    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg
118      | pureName (P.trunc_inf i) = "trunc_inf_" ^ cvtParam i
119      | pureName (P.copy_inf i) = concat ["copy_", cvtParam i, "_inf"]
120      | pureName (P.extend_inf i) =  concat ["extend_", cvtParam i, "_inf"]
121    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"
122    | pureName (P.real{fromkind,tokind}) =    | pureName (P.real{fromkind,tokind}) =
123      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)
# Line 134  Line 140 
140    | pureName P.recsubscript = "recsubscript"    | pureName P.recsubscript = "recsubscript"
141    | pureName P.raw64subscript = "raw64subscript"    | pureName P.raw64subscript = "raw64subscript"
142    | pureName P.newarray0 = "newarray0"    | pureName P.newarray0 = "newarray0"
143      | pureName (P.rawrecord rk) =
144        "rawrecord_"^getOpt(Option.map rkstring rk, "notag")
145      | pureName (P.condmove b) = "condmove "^branchName b
146    
147    and rkstring rk = (case rk
148            of RK_VECTOR => "RK_VECTOR"
149             | RK_RECORD => "RK_RECORD"
150             | RK_SPILL => "RK_SPILL"
151             | RK_ESCAPE => "RK_ESCAPE"
152             | RK_EXN => "RK_EXN"
153             | RK_CONT => "RK_CONT"
154             | RK_FCONT => "RK_FCONT"
155             | RK_KNOWN => "RK_KNOWN"
156             | RK_BLOCK => "RK_BLOCK"
157             | RK_FBLOCK => "RK_FBLOCK"
158             | RK_I32BLOCK => "RK_I32BLOCK")
159    
160    
161  fun show0 say =  fun show0 say =
162    let fun sayc (#"\n") = say "\\n"    let fun sayc (#"\n") = say "\\n"
# Line 153  Line 176 
176          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
177    
178    
       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")  
   
179        fun sayrk(RK_RECORD,n) = ()        fun sayrk(RK_RECORD,n) = ()
180          | sayrk(RK_VECTOR,n) = ()          | sayrk(RK_VECTOR,n) = ()
181          | sayrk(k,n : int) = (say (rkstring k); say " ";          | sayrk(k,n : int) = (say (rkstring k); say " ";
# Line 238  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

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

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