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/ml-nlffi-lib/internals/c-int.sml
ViewVC logotype

Diff of /sml/trunk/src/ml-nlffi-lib/internals/c-int.sml

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

revision 1095, Tue Feb 26 13:20:40 2002 UTC revision 1096, Tue Feb 26 16:59:02 2002 UTC
# Line 22  Line 22 
22              BASE of word              BASE of word
23            | PTR of objt            | PTR of objt
24            | FPTR of Unsafe.Object.object (* == addr -> 'f *)            | FPTR of Unsafe.Object.object (* == addr -> 'f *)
25            | ARR of { typ: objt, n: word, esz: int, asz: word }            | ARR of { typ: objt, n: word, esz: word, asz: word }
26    
27          (* Bitfield: b bits wide, l bits from left corner, r bits from right.          (* Bitfield: b bits wide, l bits from left corner, r bits from right.
28           * The word itself is CMemory.int_bits wide and located at address a.           * The word itself is CMemory.int_bits wide and located at address a.
# Line 79  Line 79 
79    
80      type 'tag su = unit      type 'tag su = unit
81    
82        type 'tag enum = MLRep.Signed.int
83    
84      type schar = MLRep.Signed.int      type schar = MLRep.Signed.int
85      type uchar = MLRep.Unsigned.word      type uchar = MLRep.Unsigned.word
86      type sint = MLRep.Signed.int      type sint = MLRep.Signed.int
# Line 101  Line 103 
103      type 'c float_obj = (float, 'c) obj      type 'c float_obj = (float, 'c) obj
104      type 'c double_obj = (double, 'c) obj      type 'c double_obj = (double, 'c) obj
105      type 'c voidptr_obj = (voidptr, 'c) obj      type 'c voidptr_obj = (voidptr, 'c) obj
106        type ('e, 'c) enum_obj = ('e enum, 'c) obj
107      type ('f, 'c) fptr_obj = ('f fptr, 'c) obj      type ('f, 'c) fptr_obj = ('f fptr, 'c) obj
108      type ('s, 'c) su_obj = ('s su, 'c) obj      type ('s, 'c) su_obj = ('s su, 'c) obj
109    
# Line 115  Line 118 
118      type 'c float_obj' = (float, 'c) obj'      type 'c float_obj' = (float, 'c) obj'
119      type 'c double_obj' = (double, 'c) obj'      type 'c double_obj' = (double, 'c) obj'
120      type 'c voidptr_obj' = (voidptr, 'c) obj'      type 'c voidptr_obj' = (voidptr, 'c) obj'
121        type ('e, 'c) enum_obj' = ('e enum, 'c) obj'
122      type ('f, 'c) fptr_obj' = ('f fptr, 'c) obj'      type ('f, 'c) fptr_obj' = ('f fptr, 'c) obj'
123      type ('s, 'c) su_obj' = ('s su, 'c) obj'      type ('s, 'c) su_obj' = ('s su, 'c) obj'
124    
# Line 192  Line 196 
196          val voidptr = CMemory.addr_size          val voidptr = CMemory.addr_size
197          val ptr = CMemory.addr_size          val ptr = CMemory.addr_size
198          val fptr = CMemory.addr_size          val fptr = CMemory.addr_size
199            val enum = CMemory.int_size
200      end      end
201    
202      structure T = struct      structure T = struct
# Line 216  Line 221 
221              val n = Word.fromInt (Dim.toInt d)              val n = Word.fromInt (Dim.toInt d)
222              val s = sizeof t              val s = sizeof t
223          in          in
224              ARR { typ = t, n = n, esz = Word.toInt s, asz = n * s }              ARR { typ = t, n = n, esz = s, asz = n * s }
225          end          end
226          fun elem (ARR a) = #typ a          fun elem (ARR a) = #typ a
227            | elem _ = bug "T.elem (non-array type)"            | elem _ = bug "T.elem (non-array type)"
# Line 234  Line 239 
239          val double = BASE S.double          val double = BASE S.double
240    
241          val voidptr = BASE S.voidptr          val voidptr = BASE S.voidptr
242    
243            val enum = BASE S.sint
244      end      end
245    
246      structure Light = struct      structure Light = struct
# Line 264  Line 271 
271          fun c_ulong (l: ulong) = l          fun c_ulong (l: ulong) = l
272          fun c_float (f: float) = f          fun c_float (f: float) = f
273          fun c_double (d: double) = d          fun c_double (d: double) = d
274            fun i2c_enum (e: 'e enum) = e
275    
276          val ml_schar = c_schar          val ml_schar = c_schar
277          val ml_uchar = c_uchar          val ml_uchar = c_uchar
# Line 275  Line 283 
283          val ml_ulong = c_ulong          val ml_ulong = c_ulong
284          val ml_float = c_float          val ml_float = c_float
285          val ml_double = c_double          val ml_double = c_double
286            val c2i_enum = i2c_enum
287      end      end
288    
289      structure Get = struct      structure Get = struct
# Line 288  Line 297 
297          val slong' = CMemory.load_slong          val slong' = CMemory.load_slong
298          val float' = CMemory.load_float          val float' = CMemory.load_float
299          val double' = CMemory.load_double          val double' = CMemory.load_double
300            val enum' = CMemory.load_sint
301    
302          val ptr' = CMemory.load_addr          val ptr' = CMemory.load_addr
303          val fptr' = CMemory.load_addr          val fptr' = CMemory.load_addr
# Line 304  Line 314 
314          val float = float' o strip_type          val float = float' o strip_type
315          val double = double' o strip_type          val double = double' o strip_type
316          val voidptr = voidptr' o strip_type          val voidptr = voidptr' o strip_type
317            val enum = enum' o strip_type
318    
319          fun ptr (a, PTR t) = (CMemory.load_addr a, t)          fun ptr (a, PTR t) = (CMemory.load_addr a, t)
320            | ptr _ = bug "Get.ptr (non-pointer)"            | ptr _ = bug "Get.ptr (non-pointer)"
# Line 332  Line 343 
343          val slong' = CMemory.store_slong          val slong' = CMemory.store_slong
344          val float' = CMemory.store_float          val float' = CMemory.store_float
345          val double' = CMemory.store_double          val double' = CMemory.store_double
346            val enum' = CMemory.store_sint
347    
348          val ptr' = CMemory.store_addr          val ptr' = CMemory.store_addr
349          val fptr' = CMemory.store_addr          val fptr' = CMemory.store_addr
# Line 353  Line 365 
365              val float = float' $ strip_type              val float = float' $ strip_type
366              val double = double' $ strip_type              val double = double' $ strip_type
367              val voidptr = voidptr' $ strip_type              val voidptr = voidptr' $ strip_type
368                val enum = enum' $ strip_type
369    
370              fun ptr_voidptr (x, p) = ptr_voidptr' (p_strip_type x, p)              fun ptr_voidptr (x, p) = ptr_voidptr' (p_strip_type x, p)
371    
# Line 394  Line 407 
407          val compare' = CMemory.compare          val compare' = CMemory.compare
408    
409          val inject' = addr_id          val inject' = addr_id
410          fun cast' (_ : objt) = addr_id          val cast' = addr_id
411    
412          val inject = p_strip_type          val inject = p_strip_type
413          fun cast (PTR t) (p : voidptr) = (p, t)          fun cast (PTR t) (p : voidptr) = (p, t)
# Line 433  Line 446 
446    
447      structure Arr = struct      structure Arr = struct
448          local          local
449              fun asub (a, i, ARR { typ, n, esz, ... }) =              fun asub (a, i, n, esz) =
450                  (* take advantage of wrap-around to avoid the >= 0 test... *)                  (* take advantage of wrap-around to avoid the >= 0 test... *)
451                  if Word.fromInt i < n then (a ++ (esz * i), typ)                  if Word.fromInt i < n then a ++ (Word.toIntX esz * i)
452                  else raise General.Subscript                  else raise General.Subscript
               | asub _ = bug "Arr.sub(') (non-array)"  
453          in          in
454              fun sub ((a, t), i) = asub (a, i, t)              fun sub ((a, ARR { typ, n, esz, ... }), i) = (asub (a, i, n, esz), typ)
455              fun sub' t (a, i) = #1 (asub (a, i, t))                | sub _ = bug "Arr.sub (non-array)"
456                fun sub' (s, d) (a, i) = asub (a, i, Word.fromInt (Dim.toInt d), s)
457          end          end
458    
459          fun decay (a, ARR { typ, ... }) = (a, typ)          fun decay (a, ARR { typ, ... }) = (a, typ)
# Line 480  Line 493 
493    
494      (* ------------- internal stuff ------------- *)      (* ------------- internal stuff ------------- *)
495    
496      fun mk_obj (t: objt, a: addr) = (a, t)      fun mk_obj' (a : addr) = a
497      fun mk_voidptr (a : addr) = a      fun mk_voidptr (a : addr) = a
498      fun mk_fptr (mkf, a) = (a, mkf a)      fun mk_fptr (mkf, a) = (a, mkf a)
499    

Legend:
Removed from v.1095  
changed lines
  Added in v.1096

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