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/FLINT/cps/convert.sml
ViewVC logotype

Diff of /sml/trunk/compiler/FLINT/cps/convert.sml

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

revision 4419, Mon Sep 18 21:53:44 2017 UTC revision 4432, Tue Sep 19 21:40:38 2017 UTC
# Line 1  Line 1 
1  (* COPYRIGHT 1998 BY YALE FLINT PROJECT *)  (* convert.sml
2  (* convert.sml *)   *
3     * COPYRIGHT (c) 2017 The Fellowship of SML/NJ (http://www.smlnj.org)
4     * All rights reserved.
5     *)
6    
7  (***************************************************************************  (***************************************************************************
8   *                         IMPORTANT NOTES                                 *   *                         IMPORTANT NOTES                                 *
# Line 17  Line 20 
20  local structure DA = Access  local structure DA = Access
21        structure LT = LtyExtern        structure LT = LtyExtern
22        structure LV = LambdaVar        structure LV = LambdaVar
23        structure AP = PrimOp        structure AP = Primop
24        structure DI = DebIndex        structure DI = DebIndex
25        structure F  = FLINT        structure F  = FLINT
26        structure FU = FlintUtil        structure FU = FlintUtil
# Line 38  Line 41 
41  fun veq (VAR x, VAR y) = (x = y)  fun veq (VAR x, VAR y) = (x = y)
42    | veq _ = false    | veq _ = false
43    
44    local
45      structure PCT = PrimCTypes
46      structure CT = CTypes
47    in
48    (* convert PrimCTypes.c_proto to MLRISC's CTypes.c_proto *)
49    fun cvtCProto {conv, retTy, paramTys} : CTypes.c_proto = let
50          fun cvtIntTy PCT.I_char = CT.I_char
51            | cvtIntTy PCT.I_short = CT.I_short
52            | cvtIntTy PCT.I_int = CT.I_int
53            | cvtIntTy PCT.I_long = CT.I_long
54            | cvtIntTy PCT.I_long_long = CT.I_long_long
55          fun cvtTy PCT.C_void = CT.C_void
56            | cvtTy PCT.C_float = CT.C_float
57            | cvtTy PCT.C_double = CT.C_double
58            | cvtTy PCT.C_long_double = CT.C_long_double
59            | cvtTy (PCT.C_unsigned ity) = CT.C_unsigned(cvtIntTy ity)
60            | cvtTy (PCT.C_signed ity) = CT.C_signed(cvtIntTy ity)
61            | cvtTy PCT.C_PTR = CT.C_PTR
62            | cvtTy (PCT.C_ARRAY(ty, n)) = CT.C_ARRAY(cvtTy ty, n)
63            | cvtTy (PCT.C_STRUCT tys) = CT.C_STRUCT(List.map cvtTy tys)
64            | cvtTy (PCT.C_UNION tys) = CT.C_UNION(List.map cvtTy tys)
65          in
66            {conv = conv, retTy = cvtTy retTy, paramTys = List.map cvtTy paramTys}
67          end
68    end (* local *)
69    
70  (***************************************************************************  (***************************************************************************
71   *              CONSTANTS AND UTILITY FUNCTIONS                            *   *              CONSTANTS AND UTILITY FUNCTIONS                            *
72   ***************************************************************************)   ***************************************************************************)
# Line 92  Line 121 
121      of {oper=AP.EQL,kind=AP.INT 31} => P.ieql      of {oper=AP.EQL,kind=AP.INT 31} => P.ieql
122       | {oper=AP.NEQ,kind=AP.INT 31} => P.ineq       | {oper=AP.NEQ,kind=AP.INT 31} => P.ineq
123       | {oper,kind=AP.FLOAT size} =>       | {oper,kind=AP.FLOAT size} =>
124           let fun c AP.>    = P.fGT           let fun c AP.GT   = P.fGT
125                 | c AP.>=   = P.fGE                 | c AP.GTE  = P.fGE
126                 | c AP.<    = P.fLT                 | c AP.LT   = P.fLT
127                 | c AP.<=   = P.fLE                 | c AP.LTE  = P.fLE
128                 | c AP.EQL  = P.fEQ                 | c AP.EQL  = P.fEQ
129                 | c AP.NEQ  = P.fULG                 | c AP.NEQ  = P.fULG
130                     | c AP.FSGN = P.fsgn                     | c AP.FSGN = P.fsgn
# Line 105  Line 134 
134       | {oper, kind} =>       | {oper, kind} =>
135           let fun check (_, AP.UINT _) = ()           let fun check (_, AP.UINT _) = ()
136                 | check (oper, _) = bug ("check" ^ oper)                 | check (oper, _) = bug ("check" ^ oper)
137               fun c AP.>   = P.>               fun c AP.GT  = P.>
138                 | c AP.>=  = P.>=                 | c AP.GTE = P.>=
139                 | c AP.<   = P.<                 | c AP.LT  = P.<
140                 | c AP.<=  = P.<=                 | c AP.LTE = P.<=
141                 | c AP.LEU = (check ("leu", kind); P.<= )                 | c AP.LEU = (check ("leu", kind); P.<= )
142                 | c AP.LTU = (check ("ltu", kind); P.< )                 | c AP.LTU = (check ("ltu", kind); P.< )
143                 | c AP.GEU = (check ("geu", kind); P.>= )                 | c AP.GEU = (check ("geu", kind); P.>= )
# Line 142  Line 171 
171    | primunwrap _ = P.unwrap    | primunwrap _ = P.unwrap
172    
173  (* arithop: AP.arithop -> P.arithop *)  (* arithop: AP.arithop -> P.arithop *)
174  fun arithop AP.~ = P.~  fun arithop AP.NEG = P.~
175    | arithop AP.ABS = P.abs    | arithop AP.ABS = P.abs
176    | arithop AP.FSQRT = P.fsqrt    | arithop AP.FSQRT = P.fsqrt
177    | arithop AP.FSIN = P.fsin    | arithop AP.FSIN = P.fsin
# Line 152  Line 181 
181    | arithop AP.REM = P.rem    | arithop AP.REM = P.rem
182    | arithop AP.DIV = P.div    | arithop AP.DIV = P.div
183    | arithop AP.MOD = P.mod    | arithop AP.MOD = P.mod
184    | arithop AP.+ = P.+    | arithop AP.ADD = P.+
185    | arithop AP.- = P.-    | arithop AP.SUB = P.-
186    | arithop AP.* = P.*    | arithop AP.MUL = P.*
187    | arithop AP./ = P./    | arithop AP.QUOT = P./
188      | arithop AP.FDIV = P./
189    | arithop AP.LSHIFT = P.lshift    | arithop AP.LSHIFT = P.lshift
190    | arithop AP.RSHIFT = P.rshift    | arithop AP.RSHIFT = P.rshift
191    | arithop AP.RSHIFTL = P.rshiftl    | arithop AP.RSHIFTL = P.rshiftl
# Line 614  Line 644 
644               newname (v, lpvar a); loop(e,c))               newname (v, lpvar a); loop(e,c))
645    
646            | F.PRIMOP ((_,AP.RAW_CCALL (SOME i),lt,ts),f::a::_::_,v,e) => let            | F.PRIMOP ((_,AP.RAW_CCALL (SOME i),lt,ts),f::a::_::_,v,e) => let
647                  val { c_proto = p, ml_args, ml_res_opt, reentrant } = i                  val { c_proto, ml_args, ml_res_opt, reentrant } = i
648                    val c_proto = cvtCProto c_proto
649                  fun cty AP.CCR64 = FLTt                  fun cty AP.CCR64 = FLTt
650                    | cty AP.CCI32 = INT32t                    | cty AP.CCI32 = INT32t
651                    | cty AP.CCML = BOGt                    | cty AP.CCML = BOGt
# Line 628  Line 659 
659                            F.STRING linkage => (al, linkage)                            F.STRING linkage => (al, linkage)
660                          | _  => (lpvar f :: al, "")                          | _  => (lpvar f :: al, "")
661                  in  case ml_res_opt of                  in  case ml_res_opt of
662                          NONE => RCC (rcckind, linkage,                          NONE => RCC (rcckind, linkage, c_proto, al, [(v, INTt)], loop (e, c))
                                      p, al, [(v, INTt)], loop (e, c))  
663                        | SOME AP.CCI64 =>                        | SOME AP.CCI64 =>
664                          let val (v1, v2) = (mkv (), mkv ())                          let val (v1, v2) = (mkv (), mkv ())
665                          in                          in
666                              RCC (rcckind, linkage, p, al,                              RCC (rcckind, linkage, c_proto, al,
667                                   [(v1, INT32t), (v2, INT32t)],                                   [(v1, INT32t), (v2, INT32t)],
668                                   recordNM([VAR v1, VAR v2],[INT32t,INT32t],                                   recordNM([VAR v1, VAR v2],[INT32t,INT32t],
669                                            v, loop (e, c)))                                            v, loop (e, c)))
# Line 642  Line 672 
672                              val v' = mkv ()                              val v' = mkv ()
673                              val res_cty = cty rt                              val res_cty = cty rt
674                          in                          in
675                              RCC (rcckind, linkage, p, al, [(v', res_cty)],                              RCC (rcckind, linkage, c_proto, al, [(v', res_cty)],
676                                   PURE(primwrap res_cty, [VAR v'], v, BOGt,                                   PURE(primwrap res_cty, [VAR v'], v, BOGt,
677                                        loop (e, c)))                                        loop (e, c)))
678                          end                          end

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

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