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/branches/primop-branch/src/system/Basis/Implementation/Posix/posix-io.sml
ViewVC logotype

Diff of /sml/branches/primop-branch/src/system/Basis/Implementation/Posix/posix-io.sml

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

revision 1470, Mon Mar 29 22:45:55 2004 UTC revision 1471, Mon Mar 29 22:45:55 2004 UTC
# Line 52  Line 52 
52    
53      val read' : int * int -> Word8Vector.vector = cfun "read"      val read' : int * int -> Word8Vector.vector = cfun "read"
54      val readbuf' : int * Word8Array.array * int * int -> int = cfun "readbuf"      val readbuf' : int * Word8Array.array * int * int -> int = cfun "readbuf"
55      fun readArr (fd, {buf, i, sz=NONE}) = let      fun readArr (fd, asl) = let
56            val alen = Word8Array.length buf          val (buf, i, len) = Word8ArraySlice.base asl
57            in            in
58              if 0 <= i andalso i <= alen          readbuf' (FS.intOf fd, buf, len, i)
               then readbuf'(FS.intOf fd, buf, alen - i, i)  
               else raise Subscript  
           end  
       | readArr (fd, {buf, i, sz=SOME sz}) = let  
           val alen = Word8Array.length buf  
           in  
             if 0 <= i andalso 0 <= sz andalso i + sz <= alen  
               then readbuf'(FS.intOf fd, buf, sz, i)  
               else raise Subscript  
59            end            end
60      fun readVec (fd,cnt) =      fun readVec (fd,cnt) =
61            if cnt < 0 then raise Subscript else read'(FS.intOf fd, cnt)            if cnt < 0 then raise Size else read'(FS.intOf fd, cnt)
62    
63      val writevec' : (int * Word8Vector.vector * int * int) -> int = cfun "writebuf"      val writevec' : (int * Word8Vector.vector * int * int) -> int = cfun "writebuf"
64      val writearr' : (int * Word8Array.array * int * int) -> int = cfun "writebuf"      val writearr' : (int * Word8Array.array * int * int) -> int = cfun "writebuf"
65      fun writeArr (fd,{buf, i, sz=NONE}) = let      fun writeArr (fd, asl) = let
66            val alen = Word8Array.length buf          val (buf, i, len) = Word8ArraySlice.base asl
67            in            in
68              if 0 <= i andalso i <= alen          writearr' (FS.intOf fd, buf, len, i)
               then writearr'(FS.intOf fd, buf, alen-i, i)  
               else raise Subscript  
           end  
       | writeArr (fd,{buf, i, sz=SOME sz}) = let  
           val alen = Word8Array.length buf  
           in  
             if 0 <= i andalso 0 <= sz andalso i + sz <= alen  
               then writearr'(FS.intOf fd, buf, sz, i)  
               else raise Subscript  
69            end            end
70    
71      fun writeVec (fd,{buf, i, sz=NONE}) = let      fun writeVec (fd, vsl) = let
72            val vlen = Word8Vector.length buf          val (buf, i, len) = Word8VectorSlice.base vsl
           in  
             if 0 <= i andalso i <= vlen  
               then writevec'(FS.intOf fd, buf, vlen-i, i)  
               else raise Subscript  
           end  
       | writeVec (fd,{buf, i, sz=SOME sz}) = let  
           val vlen = Word8Vector.length buf  
73            in            in
74              if 0 <= i andalso 0 <= sz andalso i + sz <= vlen          writevec' (FS.intOf fd, buf, len, i)
               then writevec'(FS.intOf fd, buf, sz, i)  
               else raise Subscript  
75            end            end
76    
77      datatype whence = SEEK_SET | SEEK_CUR | SEEK_END      datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
# Line 116  Line 89 
89    
90      structure FD =      structure FD =
91        struct        struct
92          datatype flags = FDF of word          local structure BF = BitFlagsFn ()
93            in
94          fun fromWord w = FDF w              open BF
95          fun toWord (FDF w) = w          end
   
         fun flags ms = FDF(List.foldl (fn (FDF m,acc) => m ++ acc) 0w0 ms)  
         fun anySet (FDF m, FDF m') = (m & m') <> 0w0  
         fun allSet (FDF m, FDF m') = (m & m') = m  
96    
97          val cloexec = FDF(w_osval "cloexec")          val cloexec = fromWord (w_osval "cloexec")
98        end        end
99    
100      structure O =      structure O =
101        struct        struct
102          datatype flags = FS of word          local structure BF = BitFlagsFn ()
103            in
104          fun fromWord w = FS w              open BF
105          fun toWord (FS w) = w          end
106    
107          fun flags ms = FS(List.foldl (fn (FS m,acc) => m ++ acc) 0w0 ms)          val append   = fromWord (w_osval "append")
108          fun anySet (FS m, FS m') = (m & m') <> 0w0          val dsync    = fromWord (w_osval "dsync")
109          fun allSet (FS m, FS m') = (m & m') = m          val nonblock = fromWord (w_osval "nonblock")
110            val rsync    = fromWord (w_osval "rsync")
111          val append   = FS(w_osval "append")          val sync     = fromWord (w_osval "sync")
         val dsync    = FS(w_osval "dsync")  
         val nonblock = FS(w_osval "nonblock")  
         val rsync    = FS(w_osval "rsync")  
         val sync     = FS(w_osval "sync")  
112        end        end
113    
114      val fcntl_d   : s_int * s_int -> s_int = cfun "fcntl_d"      val fcntl_d   : s_int * s_int -> s_int = cfun "fcntl_d"
# Line 152  Line 117 
117      val fcntl_gfl : s_int -> (word * word) = cfun "fcntl_gfl"      val fcntl_gfl : s_int -> (word * word) = cfun "fcntl_gfl"
118      val fcntl_sfl : (s_int * word) -> unit = cfun "fcntl_sfl"      val fcntl_sfl : (s_int * word) -> unit = cfun "fcntl_sfl"
119      fun dupfd {old, base} = FS.fd (fcntl_d (FS.intOf old, FS.intOf base))      fun dupfd {old, base} = FS.fd (fcntl_d (FS.intOf old, FS.intOf base))
120      fun getfd fd = FD.FDF (fcntl_gfd (FS.intOf fd))      fun getfd fd = FD.fromWord (fcntl_gfd (FS.intOf fd))
121      fun setfd (fd, FD.FDF fl) = fcntl_sfd(FS.intOf fd, fl)      fun setfd (fd, fl) = fcntl_sfd(FS.intOf fd, FD.toWord fl)
122      fun getfl fd = let      fun getfl fd = let
123            val (sts, omode) = fcntl_gfl (FS.intOf fd)            val (sts, omode) = fcntl_gfl (FS.intOf fd)
124            in            in
125              (O.FS sts, FS.omodeFromWord omode)              (O.fromWord sts, FS.omodeFromWord omode)
126            end            end
127      fun setfl (fd, O.FS sts) = fcntl_sfl (FS.intOf fd, sts)      fun setfl (fd, sts) = fcntl_sfl (FS.intOf fd, O.toWord sts)
128    
129      datatype lock_type = F_RDLCK | F_WRLCK | F_UNLCK      datatype lock_type = F_RDLCK | F_WRLCK | F_UNLCK
130    

Legend:
Removed from v.1470  
changed lines
  Added in v.1471

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