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 1015 - (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 : blume 975 * author: Matthias Blume (blume@research.bell-labs.com)
9 : blume 828 *)
10 :     structure CMemory : CMEMORY = struct
11 : blume 1015 exception OutOfMemory
12 :    
13 : blume 828 type addr = Word32.word
14 :     val null = 0w0 : addr
15 :     fun isNull a = a = null
16 :     infix ++ --
17 :     (* rely on 2's-complement for the following... *)
18 :     fun (a: addr) ++ i = a + Word32.fromInt i
19 :     fun compare (a1, a2) = Word32.compare (a1, a2)
20 :     fun a1 -- a2 = Word32.toIntX (a1 - a2)
21 :     fun bcopy { from: addr, to: addr, bytes: word } = ()
22 : blume 1015 fun alloc (bytes: word) : addr = raise OutOfMemory
23 : blume 828 fun free (a: addr) = ()
24 :    
25 :     (* most of these types are represented using a bigger size
26 :     * (for lack of the "right" size *)
27 :     type uchar = Word32.word
28 :     type schar = Int32.int
29 :     type ushort = Word32.word
30 :     type sshort = Int32.int
31 :     type uint = Word32.word
32 :     type sint = Int32.int
33 :     type ulong = Word32.word
34 :     type slong = Int32.int
35 :     type float = Real.real
36 :     type double = Real.real
37 :    
38 :     val addr_size = 0w4
39 :     val char_size = 0w1
40 :     val short_size = 0w2
41 :     val int_size = 0w4
42 :     val long_size = 0w4
43 :     val float_size = 0w4
44 :     val double_size = 0w8
45 :    
46 :     type 'a load_instr = addr -> 'a
47 :     type 'a store_instr = addr * 'a -> unit
48 :    
49 :     fun load_addr (a: addr) = 0w0 : addr
50 :     fun load_uchar (a: addr) = 0w0 : uchar
51 :     fun load_ushort (a: addr) = 0w0 : ushort
52 :     fun load_uint (a: addr) = 0w0 : uint
53 :     fun load_ulong (a: addr) = 0w0 : ulong
54 :     fun load_float (a: addr) = 0.0 : float
55 :     fun load_double (a: addr) = 0.0 : double
56 :    
57 :     fun store_addr (a: addr, x: addr) = ()
58 :     fun store_uchar (a: addr, c: uchar) = ()
59 :     fun store_ushort (a: addr, s: ushort) = ()
60 :     fun store_uint (a: addr, i: uint) = ()
61 :     fun store_ulong (a: addr, l: ulong) = ()
62 :     fun store_float (a: addr, f: float) = ()
63 :     fun store_double (a: addr, d: double) = ()
64 :    
65 :     local
66 :     fun u2s (mid, u) = let
67 :     val i = Word32.toLargeIntX u
68 :     in
69 :     if i >= mid then i - 2 * mid else i
70 :     end
71 :     in
72 :     fun char_u2s (c: uchar) = u2s (128, c)
73 :     fun short_u2s (s: ushort) = u2s (32768, s)
74 :     fun int_u2s (i: uint) = Word32.toLargeIntX i
75 :     fun long_u2s (l: ulong) = Word32.toLargeIntX l
76 :     end
77 :    
78 :     fun char_s2u (c: schar) = Word32.andb (Word32.fromLargeInt c, 0w255)
79 :     fun short_s2u (s: sshort) = Word32.andb (Word32.fromLargeInt s, 0w65535)
80 :     fun int_s2u (i: sint) = Word32.fromLargeInt i
81 :     fun long_s2u (l: slong) = Word32.fromLargeInt l
82 :    
83 :     val >> = Word32.>>
84 :     val << = Word32.<<
85 :     val andb = Word32.andb
86 :     val orb = Word32.orb
87 :     val notb = Word32.notb
88 :    
89 :     fun sext (value, mask) =
90 :     int_u2s (if andb (value, mask) = 0w0 then value else orb (value, mask))
91 : blume 1015
92 :     fun p2i x = x
93 :     fun i2p x = x
94 : blume 828 end

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