PreviousUpNext

15.4.948  src/lib/src/lib/thread-kit/src/win32/winix-data-file-io-driver-for-win32.pkg

## 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.pkg

package 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 



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext