Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/ml-nlffi-lib/memory/memory-dummy.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-nlffi-lib/memory/memory-dummy.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 828 - (view) (download)

1 : blume 828 (*
2 :     * Primitives for "raw" memory access.
3 :     * Normally, this module would be machine-dependent.
4 :     * The code you are looking at is just a placeholder, a fake.
5 :     *
6 :     * (C) 2000, Lucent Technologies, Bell Laboratories
7 :     *
8 :     * author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
9 :     *)
10 :     structure CMemory : CMEMORY = struct
11 :     type addr = Word32.word
12 :     val null = 0w0 : addr
13 :     fun isNull a = a = null
14 :     infix ++ --
15 :     (* rely on 2's-complement for the following... *)
16 :     fun (a: addr) ++ i = a + Word32.fromInt i
17 :     fun compare (a1, a2) = Word32.compare (a1, a2)
18 :     fun a1 -- a2 = Word32.toIntX (a1 - a2)
19 :     fun bcopy { from: addr, to: addr, bytes: word } = ()
20 :     fun alloc (bytes: word) = NONE : addr option
21 :     fun free (a: addr) = ()
22 :    
23 :     (* most of these types are represented using a bigger size
24 :     * (for lack of the "right" size *)
25 :     type uchar = Word32.word
26 :     type schar = Int32.int
27 :     type ushort = Word32.word
28 :     type sshort = Int32.int
29 :     type uint = Word32.word
30 :     type sint = Int32.int
31 :     type ulong = Word32.word
32 :     type slong = Int32.int
33 :     type float = Real.real
34 :     type double = Real.real
35 :    
36 :     val addr_size = 0w4
37 :     val char_size = 0w1
38 :     val short_size = 0w2
39 :     val int_size = 0w4
40 :     val long_size = 0w4
41 :     val float_size = 0w4
42 :     val double_size = 0w8
43 :    
44 :     type 'a load_instr = addr -> 'a
45 :     type 'a store_instr = addr * 'a -> unit
46 :    
47 :     fun load_addr (a: addr) = 0w0 : addr
48 :     fun load_uchar (a: addr) = 0w0 : uchar
49 :     fun load_ushort (a: addr) = 0w0 : ushort
50 :     fun load_uint (a: addr) = 0w0 : uint
51 :     fun load_ulong (a: addr) = 0w0 : ulong
52 :     fun load_float (a: addr) = 0.0 : float
53 :     fun load_double (a: addr) = 0.0 : double
54 :    
55 :     fun store_addr (a: addr, x: addr) = ()
56 :     fun store_uchar (a: addr, c: uchar) = ()
57 :     fun store_ushort (a: addr, s: ushort) = ()
58 :     fun store_uint (a: addr, i: uint) = ()
59 :     fun store_ulong (a: addr, l: ulong) = ()
60 :     fun store_float (a: addr, f: float) = ()
61 :     fun store_double (a: addr, d: double) = ()
62 :    
63 :     local
64 :     fun u2s (mid, u) = let
65 :     val i = Word32.toLargeIntX u
66 :     in
67 :     if i >= mid then i - 2 * mid else i
68 :     end
69 :     in
70 :     fun char_u2s (c: uchar) = u2s (128, c)
71 :     fun short_u2s (s: ushort) = u2s (32768, s)
72 :     fun int_u2s (i: uint) = Word32.toLargeIntX i
73 :     fun long_u2s (l: ulong) = Word32.toLargeIntX l
74 :     end
75 :    
76 :     fun char_s2u (c: schar) = Word32.andb (Word32.fromLargeInt c, 0w255)
77 :     fun short_s2u (s: sshort) = Word32.andb (Word32.fromLargeInt s, 0w65535)
78 :     fun int_s2u (i: sint) = Word32.fromLargeInt i
79 :     fun long_s2u (l: slong) = Word32.fromLargeInt l
80 :    
81 :     val >> = Word32.>>
82 :     val << = Word32.<<
83 :     val andb = Word32.andb
84 :     val orb = Word32.orb
85 :     val notb = Word32.notb
86 :    
87 :     fun sext (value, mask) =
88 :     int_u2s (if andb (value, mask) = 0w0 then value else orb (value, mask))
89 :     end

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