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/branches/SMLNJ/src/compiler/PervEnv/Win32/win32-io.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/PervEnv/Win32/win32-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 249 - (view) (download)

1 : monnier 249 (* win32-io.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     * Hooks to Win32 IO system.
6 :     *
7 :     *)
8 :    
9 :     structure Win32_IO : WIN32_IO =
10 :     struct
11 :     structure W32G = Win32_General
12 :     type hndl = W32G.hndl
13 :    
14 :     type word = W32G.word
15 :    
16 :     type offset = Position.int
17 :    
18 :     fun cf name = W32G.cfun "WIN32-IO" name
19 :    
20 :     val setFilePointer' : (hndl * word * word) -> word =
21 :     cf "set_file_pointer"
22 :    
23 :     val cc = W32G.getConst "FILE"
24 :     val FILE_BEGIN : word = cc "BEGIN"
25 :     val FILE_CURRENT : word = cc "CURRENT"
26 :     val FILE_END : word = cc "END"
27 :    
28 :     val readVec' : hndl * int -> Word8Vector.vector = cf "read_vec"
29 :     val readArr' : (hndl * Word8Array.array * int * int)
30 :     -> int = cf "read_arr"
31 :    
32 :     val readVecTxt' : hndl * int -> CharVector.vector = cf "read_vec_txt"
33 :     val readArrTxt' : (hndl * CharArray.array * int * int)
34 :     -> int = cf "read_arr_txt"
35 :    
36 :     fun vecF f (h,i) =
37 :     if i <= 0 then raise Subscript else f(h,i)
38 :    
39 :     fun bufF (f,lenF) (h,{buf,i,sz=NONE}) =
40 :     let val alen = lenF buf
41 :     in if 0 <= i andalso i <= alen then
42 :     f(h,buf,alen-i,i)
43 :     else raise Subscript
44 :     end
45 :     | bufF (f,lenF) (h,{buf,i,sz=SOME sz}) =
46 :     let val alen = lenF buf
47 :     in if 0 <= i andalso 0 <= sz andalso i + sz <= alen then
48 :     f(h,buf,sz,i)
49 :     else raise Subscript
50 :     end
51 :    
52 :     val readVec = vecF readVec'
53 :     val readArr = bufF (readArr',Word8Array.length)
54 :     val readVecTxt = vecF readVecTxt'
55 :     val readArrTxt = bufF (readArrTxt',CharArray.length)
56 :    
57 :     val close : hndl -> unit = cf "close"
58 :    
59 :     val cc = W32G.getConst "GENERIC"
60 :     val GENERIC_READ : word = cc "READ"
61 :     val GENERIC_WRITE : word = cc "WRITE"
62 :    
63 :     val cc = W32G.getConst "FILE_SHARE"
64 :     val FILE_SHARE_READ : word = cc "READ"
65 :     val FILE_SHARE_WRITE : word = cc "WRITE"
66 :    
67 :     val cc = W32G.getConst "FILE_FLAG"
68 :     val FILE_FLAG_WRITE_THROUGH : word = cc "WRITE_THROUGH"
69 :     val FILE_FLAG_OVERLAPPED : word = cc "OVERLAPPED"
70 :     val FILE_FLAG_NO_BUFFERING : word = cc "NO_BUFFERING"
71 :     val FILE_FLAG_RANDOM_ACCESS : word = cc "RANDOM_ACCESS"
72 :     val FILE_FLAG_SEQUENTIAL_SCAN : word = cc "SEQUENTIAL_SCAN"
73 :     val FILE_FLAG_DELETE_ON_CLOSE : word = cc "DELETE_ON_CLOSE"
74 :     val FILE_FLAG_BACKUP_SEMANTICS : word = cc "BACKUP_SEMANTICS"
75 :     val FILE_FLAG_POSIX_SEMANTICS : word = cc "POSIX_SEMANTICS"
76 :    
77 :     val cc = W32G.getConst "FILE_MODE"
78 :     val CREATE_NEW : word = cc "CREATE_NEW"
79 :     val CREATE_ALWAYS : word = cc "CREATE_ALWAYS"
80 :     val OPEN_EXISTING : word = cc "OPEN_EXISTING"
81 :     val OPEN_ALWAYS : word = cc "OPEN_ALWAYS"
82 :     val TRUNCATE_EXISTING : word = cc "TRUNCATE_EXISTING"
83 :    
84 :     (* name, access, share, mode, attrs *)
85 :     val createFile' : (string * word * word * word * word) -> hndl =
86 :     cf "create_file"
87 :    
88 :     fun createFile {name:string,
89 :     access:word,share:word,mode:word,attrs:word} =
90 :     createFile'(name,access,share,mode,attrs)
91 :    
92 :     val writeVec' : (hndl * Word8Vector.vector * int * int) -> int =
93 :     cf "write_vec"
94 :     val writeArr' : (hndl * Word8Array.array * int * int) -> int =
95 :     cf "write_arr"
96 :    
97 :     val writeVecTxt' : (hndl * CharVector.vector * int * int) -> int =
98 :     cf "write_vec_txt"
99 :     val writeArrTxt' : (hndl * CharArray.array * int * int) -> int =
100 :     cf "write_arr_txt"
101 :    
102 :     val writeVec = bufF (writeVec',Word8Vector.length)
103 :     val writeArr = bufF (writeArr',Word8Array.length)
104 :     val writeVecTxt = bufF (writeVecTxt',CharVector.length)
105 :     val writeArrTxt = bufF (writeArrTxt',CharArray.length)
106 :    
107 :     val cc = W32G.getConst "STD_HANDLE"
108 :     val STD_INPUT_HANDLE : word = cc "INPUT"
109 :     val STD_OUTPUT_HANDLE : word = cc "OUTPUT"
110 :     val STD_ERROR_HANDLE : word = cc "ERROR"
111 :    
112 :     val getStdHandle : Win32_General.word -> hndl = cf "get_std_handle"
113 :     end
114 :    
115 :     (*
116 :     * $Log$
117 :     *)

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