## os-io.pkg
## COPYRIGHT (c) 1996 Bell Laboratories.
# Replacement winix::IO package for Win32.
# It implements a simple type of polling for file chunks.
# This file requires a runtime system supporting polling in Win32-io.
local
package unt = unt_guts
package int = int_guts
package one_word_int = one_word_int_guts
package time = TimeImp
package ci = mythryl_callable_c_library_interface; # mythryl_callable_c_library_interface is from src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkgin
package winix_io
: Winix_Io
{
package W32G = win32_general
package W32FS = Win32_FileSys
type one_word_unt = one_word_unt::word
exception RUNTIME_EXCEPTION = assembly::RUNTIME_EXCEPTION
type Io_Descriptor = winix::io::Io_Descriptor /* IODESC of W32G::hndl REF */
# hash: can't assume 32 bits
fun hash (winix::io::IODESC (REF (0wxffffffff: W32G::hndl)))
=
0wx7fffffff: word
| hash (winix::io::IODESC (REF h))
=
(unt::from_int o W32G::unt::toInt) h
fun compare (winix::io::IODESC (REF wa), winix::io::IODESC (REF wb))
=
W32G::unt::compare (wa, wb)
enum Io_Descriptor_Kind = K of String
package Kind {
file = K "FILE"
dir = K "DIR"
symlink = K "LINK"
tty = K "TTY"
pipe = K "PIPE"
socket = K "SOCKET"
device = K "DEV"
};
fun kind (winix::io::IODESC (REF h)) =
case W32FS::getFileAttributes' h of
NULL =>
K "UNKNOWN"
| THE w =>
if W32FS::isRegularFile h then Kind::file
else Kind::dir
# no win32 polling devices for now
noPolling = "polling not implemented for win32 for this device/type"
type poll_flags = { rd: Bool, wr: Bool, pri: Bool }
enum Wait_Request = POLL_DESC of (Io_Descriptor * poll_flags)
enum Wait_Result = POLL_RESULT of Wait_Request
fun pollDesc id = THE (POLL_DESC (id,{ rd=FALSE, wr=FALSE, pri=FALSE } ))
fun pollToIODesc (POLL_DESC (pd, _)) = pd
exception BAD_WAIT_REQUEST
fun pollIn (POLL_DESC (iod,{ rd, wr, pri } )) = POLL_DESC (iod,{ rd=TRUE, wr=wr, pri=pri } )
fun pollOut (POLL_DESC (iod,{ rd, wr, pri } )) = POLL_DESC (iod,{ rd=rd, wr=TRUE, pri=pri } )
fun pollPri (POLL_DESC (iod,{ rd, wr, pri } )) = POLL_DESC (iod,{ rd=rd, wr=wr, pri=TRUE } )
local
my poll' : (List( one_word_unt ) * List( Int * word ) * Null_Or( Int1::Int * Int ) -> (List( one_word_unt ) * List( Int * word )))
=
ci::find_c_function { lib_name => "win32_io", fun_name => "poll" };
fun join (FALSE, _, w) = w
| join (TRUE, b, w) = unt::bitwise_or (w, b)
fun test (w, b) = (unt::bitwise_and (w, b) != 0w0)
rdBit = 0w1 and wrBit = 0w2 and priBit = 0w4
fun toPollInfoIO (fd) = POLL_RESULT (POLL_DESC (winix::io::IODESC (REF fd),{ rd=FALSE, wr=FALSE, pri=FALSE } ))
fun toPollInfoSock (i, w) = POLL_RESULT (POLL_DESC (winix::io::SockDesc (i),{ rd = test (w, rdBit),
wr = test (w, wrBit),
pri = test (w, priBit) } ))
fun fromPollDescIO (POLL_DESC (winix::io::IODESC (REF w), _)) =THE (w)
| fromPollDescIO _ = NULL
fun fromPollDescSock (POLL_DESC (winix::io::SockDesc (i),{ rd, wr, pri } )) = THE (i, join (rd, rdBit, join (wr, wrBit, join (pri, priBit, 0w0))))
| fromPollDescSock _ = NULL
in
fun poll (pdl, t) =
let timeout =
case t of
THE (t) =>
THE (Int1::fromLarge (time::to_seconds (t)),
int::fromLarge (time::to_microseconds t))
| NULL => NULL
my (infoIO, infoSock) =
poll' (list::map_partial_fn fromPollDescIO pdl,
list::map_partial_fn fromPollDescSock pdl,
timeout)
in
list.@ (list::map toPollInfoIO infoIO,
list::map toPollInfoSock infoSock)
end
end
fun isIn pd = raise exception FAIL("isIn: "$noPolling)
fun isOut pd = raise exception FAIL("isOut: "$noPolling)
fun isPri pd = raise exception FAIL("isPri: "$noPolling)
fun infoToPollDesc (POLL_RESULT pd) = pd # raise exception FAIL("infoToPollDesc: "$noPolling)
};
end
## COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.