1(* 2 Title: Standard Basis Library: IO Support functions 3 Copyright David C.J. Matthews 2000, 2015-16 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License version 2.1 as published by the Free Software Foundation. 8 9 This library is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17*) 18(* This function provides wrappers for the RTS file descriptors to construct 19 TextPrimIO and BinPrimIO readers and writers. It is used both from the 20 TextIO and BinIO structures and also from the Windows and Unix structures 21 to wrap up pipes. *) 22structure LibraryIOSupport:> 23sig 24 25 structure BinPrimIO: PRIM_IO 26 where type vector = Word8Vector.vector 27 where type elem = Word8.word 28 where type array = Word8Array.array 29 (* BinPrimIO.pos is defined to be Position.int. 30 Is it? Can't find that in G&R 2004. *) 31 where type pos = Position.int 32 where type vector_slice = Word8VectorSlice.slice 33 where type array_slice = Word8ArraySlice.slice 34 35 and TextPrimIO: 36 sig 37 include PRIM_IO 38 where type vector = CharVector.vector 39 where type elem = Char.char 40 where type array = CharArray.array 41 (* TextPrimIO.pos is abstract. In particular it could be a 42 problem in Windows with CRNL <-> NL conversion. *) 43 where type vector_slice = CharVectorSlice.slice 44 where type array_slice = CharArraySlice.slice 45 end 46 47 val wrapInFileDescr : 48 { fd : OS.IO.iodesc, name : string, initBlkMode : bool } -> TextPrimIO.reader 49 val wrapOutFileDescr : 50 { fd : OS.IO.iodesc, name : string, appendMode : bool, 51 initBlkMode : bool, chunkSize : int } -> TextPrimIO.writer 52 val wrapBinInFileDescr : 53 { fd : OS.IO.iodesc, name : string, initBlkMode : bool } -> BinPrimIO.reader 54 val wrapBinOutFileDescr : 55 { fd : OS.IO.iodesc, name : string, appendMode : bool, 56 initBlkMode : bool, chunkSize : int } -> BinPrimIO.writer 57 58 val readBinVector: OS.IO.iodesc * int -> Word8Vector.vector 59 val readBinArray: OS.IO.iodesc * Word8ArraySlice.slice -> int 60 val writeBinVec: OS.IO.iodesc * Word8VectorSlice.slice -> int 61 val writeBinArray: OS.IO.iodesc * Word8ArraySlice.slice -> int 62 val nonBlocking : ('a->'b) -> 'a ->'b option 63 val protect: Thread.Mutex.mutex -> ('a -> 'b) -> 'a -> 'b 64 65 datatype ('af,'sock_type) sock = SOCK of OS.IO.iodesc 66 (* Socket addresses are implemented as strings. *) 67 datatype 'af sock_addr = SOCKADDR of Word8Vector.vector 68end 69= 70struct 71 structure BinPrimIO = 72 PrimIO ( 73 structure Array : MONO_ARRAY = Word8Array 74 structure Vector : MONO_VECTOR = Word8Vector 75 structure VectorSlice = Word8VectorSlice 76 structure ArraySlice = Word8ArraySlice 77 val someElem : Vector.elem = 0wx00 (* Initialise to zero. *) 78 type pos = Position.int (* Position should always be LargeInt. *) 79 val compare = Position.compare 80 ) 81 82 structure TextPrimIO = 83 PrimIO ( 84 structure Array = CharArray 85 structure Vector = CharVector 86 structure ArraySlice = CharArraySlice 87 structure VectorSlice = CharVectorSlice 88 val someElem : Array.elem = #" " (* Initialise to spaces. *) 89 type pos = Position.int 90 val compare = Position.compare 91 ); 92 93 (* open IO *) 94 type address = LibrarySupport.address 95 type fileDescr = OS.IO.iodesc 96 (* Called after any exception in the lower level reader or 97 writer to map any exception other than Io into Io. *) 98 99 local 100 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 101 in 102 fun sys_close (strm: fileDescr): unit = doIo(7, strm, 0) 103 and sys_block_in(strm: fileDescr): unit = doIo(27, strm, 0) 104 and sys_block_out(strm: fileDescr): unit = doIo(29, strm, 0) 105 end 106 107 local 108 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 109 in 110 fun sys_read_text (strm: fileDescr, vil: address*word*word): int = 111 doIo(8, strm, vil) 112 113 fun sys_write_text (strm: fileDescr, vil: address*word*word): int = 114 doIo(11, strm, vil) 115 116 fun sys_read_bin (strm: fileDescr, vil: address*word*word): int = 117 doIo(9, strm, vil) 118 119 fun sys_write_bin (strm: fileDescr, vil: address*word*word): int = 120 doIo(12, strm, vil) 121 end 122 123 local 124 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 125 in 126 fun sys_read_string (strm: fileDescr, len: int): string = 127 doIo(10, strm, len) 128 end 129 130 local 131 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 132 in 133 fun readBinVector (strm: fileDescr, len: int): Word8Vector.vector = 134 doIo(26, strm, len) 135 end 136 137 138 local 139 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 140 in 141 fun sys_get_buffsize (strm: fileDescr): int = doIo(15, strm, 0) 142 and sys_can_input(strm: fileDescr): int = doIo(16, strm, 0) 143 and sys_can_output(strm: fileDescr): int = doIo(28, strm, 0) 144 and sys_avail(strm: fileDescr): int = doIo(17, strm, 0) 145 end 146 147 local 148 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 149 in 150 fun sys_get_pos(strm: fileDescr): Position.int = doIo(18, strm, 0) (* N.B. large int *) 151 end 152 153 local 154 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 155 in 156 fun sys_end_pos(strm: fileDescr): Position.int = doIo(20, strm, 0) (* N.B. large int *) 157 end 158 159 local 160 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 161 in 162 fun sys_set_pos(strm: fileDescr, p: Position.int): unit = 163 (doIo(19, strm, p); ()) (* N.B. large int *) 164 end 165 166 local 167 (* Find out the error which will be generated if a stream in 168 non-blocking mode would block. *) 169 val eAgain = OS.syserror "EAGAIN" and eWouldBlock = OS.syserror "EWOULDBLOCK" 170 and eInProgress = OS.syserror "EINPROGRESS" 171 and wsaWouldBlock = OS.syserror "WSAEWOULDBLOCK" and wsaInProgress = OS.syserror "WSAEINPROGRESS" 172 in 173 (* If evaluating the function raises EAGAIN or EWOULDBLOCK we return NONE 174 otherwise if it succeeds return SOME result. Pass other exceptions back 175 to the caller. *) 176 fun nonBlocking f arg = 177 SOME(f arg) handle exn as OS.SysErr(_, SOME e) => 178 if (case eAgain of SOME again => e = again | NONE => false) then NONE 179 else if (case eWouldBlock of SOME wouldBlock => e = wouldBlock | NONE => false) then NONE 180 else if (case eInProgress of SOME inProgress => e = inProgress | NONE => false) then NONE 181 else if (case wsaWouldBlock of SOME wouldBlock => e = wouldBlock | NONE => false) then NONE 182 else if (case wsaInProgress of SOME inProgress => e = inProgress | NONE => false) then NONE 183 else PolyML.Exception.reraise exn 184 end 185 186 val wordSize : word = LibrarySupport.wordSize; 187 188 (* Find out if random access is permitted and return the 189 appropriate values. *) 190 fun getRandAccessFns n = 191 let 192 val isRandomAccess = 193 ((sys_get_pos n; true) handle OS.SysErr _ => false) 194 val getPos = 195 if isRandomAccess 196 then SOME(fn () => sys_get_pos n) 197 else NONE 198 val setPos = 199 if isRandomAccess 200 then SOME(fn p => sys_set_pos(n, p)) 201 else NONE 202 val endPos = 203 if isRandomAccess 204 then SOME(fn () => sys_end_pos n) 205 else NONE 206 in 207 (getPos, setPos, endPos) 208 end 209 210 fun writeBinArray (n: fileDescr, slice: Word8ArraySlice.slice): int = 211 let 212 val (buf, i, len) = Word8ArraySlice.base slice 213 val LibrarySupport.Word8Array.Array(_, v) = buf 214 val iW = LibrarySupport.unsignedShortOrRaiseSubscript i 215 val lenW = LibrarySupport.unsignedShortOrRaiseSubscript len 216 in 217 sys_write_bin(n, (v, iW, lenW)) 218 end 219 220 fun readBinArray (n: fileDescr, slice: Word8ArraySlice.slice): int = 221 let 222 val (buf, i, len) = Word8ArraySlice.base slice 223 val LibrarySupport.Word8Array.Array(_, v) = buf 224 val lenW = LibrarySupport.unsignedShortOrRaiseSubscript len 225 val iW = LibrarySupport.unsignedShortOrRaiseSubscript i 226 in 227 sys_read_bin(n, (v, iW, lenW)) 228 end 229 230 (* Write out a string using the underlying call. Note 231 that we have to add the size of a word to the offsets 232 to skip the length word. The underlying call deals 233 with the special case of a single character string 234 where the "string" is actually the character itself. *) 235 fun writeBinVec (n: fileDescr, slice: Word8VectorSlice.slice): int = 236 let 237 val (buf, i, len) = Word8VectorSlice.base slice 238 val iW = LibrarySupport.unsignedShortOrRaiseSubscript i 239 val lenW = LibrarySupport.unsignedShortOrRaiseSubscript len 240 in 241 sys_write_bin(n, (LibrarySupport.w8vectorAsAddress buf, iW+wordSize, lenW)) 242 end 243 244 245 (* Create the primitive IO functions and add the higher layers. 246 For all file descriptors other than standard input we look 247 at the stream to see if we can do non-blocking input and/or 248 random access. Standard input, though is persistent and so 249 we have to take a more restrictive view. *) 250 fun wrapInFileDescr{ fd, name, initBlkMode } = 251 let 252 fun readArray (slice: CharArraySlice.slice): int = 253 let 254 val (buf, i, len) = CharArraySlice.base slice 255 val LibrarySupport.CharArray.Array(_, v) = buf 256 val iW = LibrarySupport.unsignedShortOrRaiseSubscript i 257 val lenW = LibrarySupport.unsignedShortOrRaiseSubscript len 258 in 259 sys_read_text(fd, (v, iW, lenW)) 260 end 261 262 fun readVector l = sys_read_string(fd, l) 263 264 (* If we have opened the stream in non-blocking mode readVec 265 and readArray will raise an exception if they would block. 266 We have to handle that. The blocking functions can be 267 constructed using block_in but that should be done by 268 augmentReader. *) 269 val (readVec, readArr, readVecNB, readArrNB) = 270 if initBlkMode 271 then (SOME readVector, SOME readArray, NONE, NONE) 272 else (NONE, NONE, SOME(nonBlocking readVector), 273 SOME(nonBlocking readArray)) 274 275 val (getPos, setPos, endPos) = getRandAccessFns fd 276 277 (* Unlike the other functions "avail" is a function returning 278 an option, not an optional function. *) 279 fun avail () = 280 let 281 (* If we get an exception or a negative number return NONE. *) 282 val v = sys_avail fd handle OS.SysErr _ => ~1 283 in 284 if v >= 0 then SOME v else NONE 285 end 286 287 val textPrimRd = 288 TextPrimIO.RD { 289 name = name, 290 chunkSize = sys_get_buffsize fd, 291 readVec = readVec, 292 readArr = readArr, 293 readVecNB = readVecNB, 294 readArrNB = readArrNB, 295 block = SOME(fn () => sys_block_in fd), 296 canInput = SOME (fn () => sys_can_input fd > 0), 297 avail = avail, 298 getPos = getPos, 299 setPos = setPos, 300 endPos = endPos, 301 verifyPos = getPos, 302 close = fn () => sys_close fd, 303 ioDesc = (SOME fd) : OS.IO.iodesc option 304 } 305 in 306 TextPrimIO.augmentReader textPrimRd 307 end 308 309 fun wrapOutFileDescr {fd, name, appendMode, initBlkMode, chunkSize} = 310 let 311 fun writeArray (slice: CharArraySlice.slice): int = 312 let 313 val (buf, i, len) = CharArraySlice.base slice 314 val LibrarySupport.CharArray.Array(_, v) = buf 315 val iW = LibrarySupport.unsignedShortOrRaiseSubscript i 316 val lenW = LibrarySupport.unsignedShortOrRaiseSubscript len 317 in 318 sys_write_text(fd, (v, iW, lenW)) 319 end 320 321 (* Write out a string using the underlying call. Note 322 that we have to add the size of a word to the offsets 323 to skip the length word. The underlying call deals 324 with the special case of a single character string 325 where the "string" is actually the character itself. *) 326 fun writeVector (slice: CharVectorSlice.slice): int = 327 let 328 val (buf, i, len) = CharVectorSlice.base slice 329 val v = LibrarySupport.stringAsAddress buf 330 val iW = LibrarySupport.unsignedShortOrRaiseSubscript i 331 val lenW = LibrarySupport.unsignedShortOrRaiseSubscript len 332 in 333 sys_write_text(fd, (v, iW+wordSize, lenW)) 334 end 335 336 (* Set up the writers depending on whether the stream is 337 in non-blocking mode or not. *) 338 val (writeVec, writeArr, writeVecNB, writeArrNB) = 339 if initBlkMode 340 then (SOME writeVector, SOME writeArray, NONE, NONE) 341 else (NONE, NONE, SOME(nonBlocking writeVector), 342 SOME(nonBlocking writeArray)) 343 344 (* Random access is provided if getPos works. *) 345 val (getPos, setPos, endPos) = getRandAccessFns fd 346 (* If we have opened the stream for append we will always 347 write to the end of the stream so setPos won't work. *) 348 val setPos = if appendMode then NONE else setPos 349 350 val textPrimWr = 351 TextPrimIO.WR { 352 name = name, 353 chunkSize = chunkSize, 354 writeVec = writeVec, 355 writeArr = writeArr, 356 writeVecNB = writeVecNB, 357 writeArrNB = writeArrNB, 358 block = SOME(fn () => sys_block_out fd), 359 canOutput = SOME(fn () => sys_can_output fd > 0), 360 getPos = getPos, 361 setPos = setPos, 362 endPos = endPos, 363 verifyPos = getPos, 364 close = fn () => sys_close fd, 365 ioDesc = (SOME fd) : OS.IO.iodesc option 366 } 367 in 368 TextPrimIO.augmentWriter textPrimWr 369 end 370 371 fun wrapBinInFileDescr{fd, name, initBlkMode} = 372 let 373 fun readVector l = readBinVector(fd, l) 374 and readArray b = readBinArray(fd, b) 375 (* If we have opened the stream in non-blocking mode readVec 376 and readArray will raise an exception if they would block. 377 We have to handle that. The blocking functions can be 378 constructed using block_in but that should be done by 379 augmentReader. *) 380 val (readVec, readArr, readVecNB, readArrNB) = 381 if initBlkMode 382 then (SOME readVector, SOME readArray, NONE, NONE) 383 else (NONE, NONE, SOME(nonBlocking readVector), 384 SOME(nonBlocking readArray)) 385 386 (* Random access is provided if getPos works. *) 387 val (getPos, setPos, endPos) = getRandAccessFns fd 388 389 (* Unlike the other functions "avail" is a function returning 390 an option, not an optional function. *) 391 fun avail () = 392 let 393 (* If we get an exception or a negative number return NONE. *) 394 val v = sys_avail fd handle OS.SysErr _ => ~1 395 in 396 if v >= 0 then SOME v else NONE 397 end 398 399 val binPrimRd = 400 BinPrimIO.RD { 401 name = name, 402 chunkSize = sys_get_buffsize fd, 403 readVec = readVec, 404 readArr = readArr, 405 readVecNB = readVecNB, 406 readArrNB = readArrNB, 407 block = SOME(fn () => sys_block_in fd), 408 canInput = SOME(fn() =>sys_can_input fd > 0), 409 avail = avail, 410 getPos = getPos, 411 setPos = setPos, 412 endPos = endPos, 413 verifyPos = getPos, 414 close = fn() => sys_close fd, 415 ioDesc = SOME fd 416 } 417 in 418 BinPrimIO.augmentReader binPrimRd 419 end 420 421 fun wrapBinOutFileDescr{fd, name, appendMode, initBlkMode, chunkSize} = 422 let 423 fun writeArray b = writeBinArray(fd, b) 424 and writeVector b = writeBinVec(fd, b) 425 426 (* Set up the writers depending on whether the stream is 427 in non-blocking mode or not. *) 428 val (writeVec, writeArr, writeVecNB, writeArrNB) = 429 if initBlkMode 430 then (SOME writeVector, SOME writeArray, NONE, NONE) 431 else (NONE, NONE, SOME(nonBlocking writeVector), 432 SOME(nonBlocking writeArray)) 433 434 (* Random access is provided if getPos works. *) 435 val (getPos, setPos, endPos) = getRandAccessFns fd 436 (* If we have opened the stream for append we will always 437 write to the end of the stream so setPos won't work. *) 438 val setPos = if appendMode then NONE else setPos 439 440 val binPrimWr = 441 BinPrimIO.WR { 442 name = name, 443 chunkSize = chunkSize, 444 writeVec = writeVec, 445 writeArr = writeArr, 446 writeVecNB = writeVecNB, 447 writeArrNB = writeArrNB, 448 block = SOME(fn () => sys_block_out fd), 449 canOutput = SOME(fn () => sys_can_output fd > 0), 450 getPos = getPos, 451 setPos = setPos, 452 endPos = endPos, 453 verifyPos = getPos, 454 close = fn () => sys_close fd, 455 ioDesc = SOME fd 456 } 457 in 458 BinPrimIO.augmentWriter binPrimWr 459 end 460 461 (* Many of the IO functions need a mutex so we include this here. 462 This applies a function while a mutex is being held. *) 463 val protect = ThreadLib.protect 464 465 (* These are abstract in Socket but it's convenient to be able to convert in 466 the other socket structures. *) 467 datatype ('af,'sock_type) sock = SOCK of OS.IO.iodesc 468 datatype 'af sock_addr = SOCKADDR of Word8Vector.vector 469end; 470 471structure BinPrimIO = LibraryIOSupport.BinPrimIO 472and TextPrimIO = LibraryIOSupport.TextPrimIO; 473