## winix-data-file-io-driver-for-win32.pkg
# This may be redundant with
# src/lib/std/src/posix/winix-data-file-io-driver-for-posix.pkg# This implements the Win32 version of the OS specific binary primitive
# IO package. The Text IO version is implemented by a trivial translation
# of these operations (see nt-text-base-io.sml).
# See also:
#
# src/lib/std/src/win32/winix-data-file-io-driver-for-win32--premicrothread.pkgpackage winix_data_file_io_driver_for_win32: Winix_Base_File_Io_Driver_For_Os__Premicrothread {
#
package md = maildrop
package drv = winix_base_data_file_io_driver_for_posix
package W32FS = Win32::file_system
package W32IO = Win32::IO
package W32G = Win32::general
package v = vector_of_one_byte_unts
type File_Descriptor = W32G::hndl
pfi = file_position::from_int
pti = file_position::toInt
pfw = file_position::from_int o W32G::unt::toInt
ptw = W32G::unt::from_int o file_position::toInt
say = W32G::logMsg
bufferSzB = 4096
seek = pfw o W32IO::setFilePointer'
fun posFns iod =
if (winix__premicrothread::io::kind iod == winix__premicrothread::io::Kind::file)
then let
my pos: Ref( file_position::Int ) = REF (pfi 0)
fun getPos () : file_position::Int = *pos
fun setPos p =
pos := seek (W32FS::IODToHndl iod, ptw p, W32IO::FILE_BEGIN)
fun endPos () : file_position::Int = (
case W32FS::getLowFileSize (W32FS::IODToHndl iod)
of THE w => pfw w
| _ => raise exception winix__premicrothread::RUNTIME_EXCEPTION("endPos: no file size", NULL)
) # end case
fun verifyPos () = (
pos := seek (W32FS::IODToHndl iod, 0wx0, W32IO::FILE_CURRENT);
*pos)
in
ignore (verifyPos());
{ pos=pos,
getPos=THE getPos,
setPos=THE setPos,
endPos=THE endPos,
verifyPos=THE verifyPos
}
end
else {
pos=REF (pfi 0),
getPos=NULL, setPos=NULL, endPos=NULL, verifyPos=NULL
}
fun addCheck f (THE g) = THE (f g)
| addCheck _ NULL = NULL
fun mkReader { fd, name } = let
iod = W32FS::hndlToIOD fd
lockMV = md::mVarInit()
fun withLock f x = (
md::mTake lockMV;
(Syscall::doSyscall f x) then md::mPut (lockMV, ()))
except ex => (md::mPut (lockMV, ()); raise exception ex)
fun withLock' NULL = NULL
| withLock' (THE f) = THE (withLock f)
closed = REF FALSE
my { pos, getPos, setPos, endPos, verifyPos } = posFns iod
fun incPos k = pos := position.+(*pos, pfi k)
fun blockWrap f x = (
if *closed then raise exception io::CLOSED_IO_STREAM
f x)
readEvt =
IOManager::ioEvt (winix__premicrothread::io::pollIn (null_or::the (winix__premicrothread::io::pollDesc iod)))
fun eventWrap f x = threadkit::withNack (\\ nack => (
if *closed then raise exception io::CLOSED_IO_STREAM
case (md::mTakePoll lockMV)
of NULL => let
replV = md::iVariable()
in
threadkit::make_thread "winix_base_data_file_io_driver_for_posix__premicrothread" (\\ () => threadkit::do_one_mailop [
threadkit::wrap (readEvt, \\ _ => md::iPut (replV, ())),
nack
]);
threadkit::wrap (md::iGetEvt replV, \\ _ => f x)
end
| (THE _) => threadkit::wrap (readEvt,
\\ _ => (md::mPut (lockMV, ()); f x))
/* end case */))
fun readVec n = let
threadkit::sync readEvt
v = W32IO::readVec (W32FS::IODToHndl iod, n)
in
incPos (v::length v); v
end
fun readArr arg = let
threadkit::sync readEvt
k = W32IO::readArr (W32FS::IODToHndl iod, arg)
in
incPos k; k
end
fun close () = if *closed
then ()
else (closed:=TRUE; W32IO::close (W32FS::IODToHndl iod))
fun avail () = if *closed
then THE 0
else (case W32FS::getLowFileSize (W32FS::IODToHndl iod)
of THE w => THE (position.-(pfw w,*pos))
| NULL => NULL
) # end case
in
winix_base_data_file_io_driver_for_posix::FILEREADER {
name = name,
chunkSize = bufferSzB,
readVec = withLock (blockWrap readVec),
readArr = withLock (blockWrap readArr),
readVecEvt = eventWrap readVec,
readArrEvt = eventWrap readArr,
avail = withLock avail,
getPos = withLock' getPos,
setPos = withLock' setPos,
endPos = withLock' endPos,
verifyPos = withLock' verifyPos,
close = withLock close,
ioDesc = THE iod
}
end
shareAll = W32G::unt::bitwise_or (W32IO::FILE_SHARE_READ, W32IO::FILE_SHARE_WRITE)
fun checkHndl name h = if W32G::isValidHandle h
then h
else raise exception winix__premicrothread::RUNTIME_EXCEPTION("win32-binary-base-io: checkHndl: "$name$": failed", NULL)
fun openRd name = mkReader {
fd = checkHndl "openRd" (W32IO::createFile {
name=name,
access=W32IO::GENERIC_READ,
share=shareAll,
mode=W32IO::OPEN_EXISTING,
attributes=0wx0
} ),
name = name
}
fun mkWriter { fd, name, appendMode, chunkSize } = let
iod = W32FS::hndlToIOD fd
lockMV = md::mVarInit()
fun withLock f x = (
md::mTake lockMV;
(Syscall::doSyscall f x) then md::mPut (lockMV, ()))
except ex => (md::mPut (lockMV, ()); raise exception ex)
fun withLock' NULL = NULL
| withLock' (THE f) = THE (withLock f)
closed = REF FALSE
fun ensureOpen () = if *closed then raise exception io::CLOSED_IO_STREAM else ()
fun putV x = W32IO::writeVec x
fun putA x = W32IO::writeArr x
fun write put arg = (ensureOpen(); put (W32FS::IODToHndl iod, arg))
writeEvt =
IOManager::ioEvt (winix__premicrothread::io::pollOut (null_or::the (winix__premicrothread::io::pollDesc iod)))
fun eventWrap f x = threadkit::withNack (\\ nack => (
if *closed then raise exception io::CLOSED_IO_STREAM
case (md::mTakePoll lockMV)
of NULL => let
replV = md::iVariable()
in
threadkit::make_thread "winix_base_data_file_io_driver_for_posix__premicrothread writer" (\\ () => threadkit::do_one_mailop [
threadkit::wrap (writeEvt, \\ _ => md::iPut (replV, ())),
nack
]);
threadkit::wrap (md::iGetEvt replV, \\ _ => f x)
end
| (THE _) => threadkit::wrap (writeEvt,
\\ _ => (md::mPut (lockMV, ()); f x))
/* end case */))
fun close () = if *closed
then ()
else (closed:=TRUE; W32IO::close (W32FS::IODToHndl iod))
my { pos, getPos, setPos, endPos, verifyPos } = posFns (iod)
in
winix_base_data_file_io_driver_for_posix::FILEWRITER {
name = name,
chunkSize = chunkSize,
writeVec = withLock (write putV),
writeArr = withLock (write putA),
writeVecEvt = eventWrap (write putV),
writeArrEvt = eventWrap (write putA),
getPos = withLock' getPos,
setPos = withLock' setPos,
endPos = withLock' endPos,
verifyPos = withLock' verifyPos,
close = withLock close,
ioDesc = THE iod
}
end
fun openWr name = mkWriter {
fd = checkHndl "openWr" (W32IO::createFile {
name=name,
access=W32IO::GENERIC_WRITE,
share=shareAll,
mode=W32IO::CREATE_ALWAYS,
attributes=W32FS::FILE_ATTRIBUTE_NORMAL
} ),
name = name,
appendMode = FALSE,
chunkSize = bufferSzB
}
fun openApp name = let
h = checkHndl "openApp" (W32IO::createFile {
name=name,
access=W32IO::GENERIC_WRITE,
share=shareAll,
mode=W32IO::OPEN_EXISTING,
attributes=W32FS::FILE_ATTRIBUTE_NORMAL
} )
W32IO::setFilePointer' (h, 0wx0, W32IO::FILE_END)
in
mkWriter { fd = h, name = name, appendMode = TRUE, chunkSize = bufferSzB }
end
}; # winix_data_file_io_driver_for_win32