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/src/compiler/Semant/types/cproto.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Semant/types/cproto.sml

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

revision 1547, Wed Jul 14 19:40:35 2004 UTC revision 1548, Wed Jul 14 21:25:43 2004 UTC
# Line 30  Line 30 
30   * [T*]                 = string   * [T*]                 = string
31   * ml object            = bool   * ml object            = bool
32   * [struct {}]          = exn   * [struct {}]          = exn
33   * [struct{t1,...tn}]   = unit * [t1] * ... * [tn]   * [struct{t1,...,tn}]  = unit * [t1] * ... * [tn]
34     * [union{t1,...,tn}]   = int * [t1] * ... * [tn]
35   * [void]               = unit   * [void]               = unit
36   *   *
37   * Currently we don't encode arrays.  (C arrays are mostly like pointers   * Currently we don't encode arrays.  (C arrays are mostly like pointers
# Line 42  Line 43 
43   *       (unit * [a1] * ... * [an] -> [r]) list   *       (unit * [a1] * ... * [an] -> [r]) list
44   * We use   * We use
45   *       (unit * [a1] * ... * [an] -> [r]) list list   *       (unit * [a1] * ... * [an] -> [r]) list list
46   * to specify a "stdcall" calling convention used by, e.g., Win32.   * to specify a reentrant call.
47   *   *
48   * For n = 0 (C argument list is "(void)"), we use:   * For n = 0 (C argument list is "(void)"), we use:
49   *       (unit -> [r]) list     or      (unit -> [r]) list list   *       (unit -> [r]) list     or      (unit -> [r]) list list
# Line 129  Line 130 
130                      SOME tt => tt                      SOME tt => tt
131                    | NONE =>                    | NONE =>
132                      (case BT.getFields t of                      (case BT.getFields t of
133                           SOME (_ :: fl) =>                           SOME (f1 :: fl) =>
134                               if TU.equalType (f1, BT.unitTy) then
135                           (CT.C_STRUCT (map (#1 o dt) fl), P.CCI32)                           (CT.C_STRUCT (map (#1 o dt) fl), P.CCI32)
136                               else
137                                   (CT.C_UNION (map (#1 o dt) fl), P.CCI32)
138                         | _ => bad ())                         | _ => bad ())
139    
140              fun rdt (t, ml_args) =              fun rdt (t, ml_args) =
# Line 139  Line 143 
143                  else let val (ct, mt) = dt t                  else let val (ct, mt) = dt t
144                       in                       in
145                           case ct of                           case ct of
146                               (CT.C_STRUCT _) => (ct, SOME mt, mt :: ml_args)                               (CT.C_STRUCT _ | CT.C_UNION _) =>
147                                   (ct, SOME mt, mt :: ml_args)
148                             | _ => (ct, SOME mt, ml_args)                             | _ => (ct, SOME mt, ml_args)
149                       end                       end
150    
# Line 184  Line 189 
189                | ct C_PTR = "T*"                | ct C_PTR = "T*"
190                | ct (C_ARRAY(t,i)) = concat [ct t, "[", Int.toString i, "]"]                | ct (C_ARRAY(t,i)) = concat [ct t, "[", Int.toString i, "]"]
191                | ct (C_STRUCT fl) =                | ct (C_STRUCT fl) =
192                  concat ("{" :: foldr (fn (f, l) => ct f :: ";" :: l) ["}"] fl)                  concat ("s{" :: foldr (fn (f, l) => ct f :: ";" :: l) ["}"] fl)
193                  | ct (C_UNION fl) =
194                    concat ("u{" :: foldr (fn (f, l) => ct f :: ";" :: l) ["}"] fl)
195              fun cp { conv, retTy, paramTys = a1 :: an } =              fun cp { conv, retTy, paramTys = a1 :: an } =
196                  concat (ct retTy :: "(*)(" :: ct a1 ::                  concat (ct retTy :: "(*)(" :: ct a1 ::
197                          foldr (fn (a, l) => "," :: ct a :: l) [")"] an)                          foldr (fn (a, l) => "," :: ct a :: l) [")"] an)

Legend:
Removed from v.1547  
changed lines
  Added in v.1548

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