PreviousUpNext

15.4.1246  src/lib/std/src/win32/win32-io.pkg

## win32-io.pkg



# Hooks to Win32 IO system.



package Win32_IO
:       Win32_IO
{
        package W32G = win32_general
        type hndl = W32G::hndl

        type word = W32G::word

        type offset = file_position::Int

        fun cf name = W32G::cfun "win32_io" name

        my setFilePointer' : (hndl * word * word) -> word =
            cf "set_file_pointer"

        cc = W32G::getConst "FILE"
        my FILE_BEGIN:  word = cc "BEGIN"
        my FILE_CURRENT:  word = cc "CURRENT"
        my FILE_END:  word = cc "END"

        my readVec' : hndl * Int -> vector_of_one_byte_unts::Vector = cf "read_vector"
        my readArr' : (hndl * rw_vector_of_one_byte_unts::Rw_Vector * Int * Int)
                      -> Int = cf "read_rw_vector"

        my readVecTxt' : hndl * Int -> vector_of_chars::Vector = cf "read_vec_txt"
        my readArrTxt' : (hndl * rw_vector_of_chars::Rw_Vector * Int * Int)
            -> Int = cf "read_arr_txt"

        fun vecF f (h, i) = 
            if i < 0 then raise exception INDEX_OUT_OF_BOUNDS else f (h, i)

        fun bufF (f, baseF) (h, sl) = let
            my (buf, i, size) = baseF sl
        in
            f (h, buf, size, i)
        end

        readVec = vecF readVec'
        readArr = bufF (readArr', rw_vector_slice_of_one_byte_unts::base)
        readVecTxt = vecF readVecTxt'
        readArrTxt = bufF (readArrTxt', rw_vector_slice_of_chars::base)

        my close:  hndl -> Void = cf "close"

        cc = W32G::getConst "GENERIC"
        my GENERIC_READ:  word = cc "READ"
        my GENERIC_WRITE:  word = cc "WRITE"

        cc = W32G::getConst "FILE_SHARE"
        my FILE_SHARE_READ:  word = cc "READ"
        my FILE_SHARE_WRITE:  word = cc "WRITE"

        cc = W32G::getConst "FILE_FLAG"
        my FILE_FLAG_WRITE_THROUGH:  word = cc "WRITE_THROUGH"
        my FILE_FLAG_OVERLAPPED:  word = cc "OVERLAPPED"
        my FILE_FLAG_NO_BUFFERING:  word = cc "NO_BUFFERING"
        my FILE_FLAG_RANDOM_ACCESS:  word = cc "RANDOM_ACCESS"
        my FILE_FLAG_SEQUENTIAL_SCAN:  word = cc "SEQUENTIAL_SCAN"
        my FILE_FLAG_DELETE_ON_CLOSE:  word = cc "DELETE_ON_CLOSE"
        my FILE_FLAG_BACKUP_SEMANTICS:  word = cc "BACKUP_SEMANTICS"
        my FILE_FLAG_POSIX_SEMANTICS:  word = cc "POSIX_SEMANTICS"

        cc = W32G::getConst "FILE_MODE"
        my CREATE_NEW:  word = cc "CREATE_NEW"
        my CREATE_ALWAYS:  word = cc "CREATE_ALWAYS"
        my OPEN_EXISTING:  word = cc "OPEN_EXISTING"
        my OPEN_ALWAYS:  word = cc "OPEN_ALWAYS"
        my TRUNCATE_EXISTING:  word = cc "TRUNCATE_EXISTING"

                           #  name, access, share, mode, attributes 
        my createFile' : (String * word * word * word * word) -> hndl =
            cf "create_file"

        fun createFile { name: String,
                        access: word, share: word, mode: word, attributes: word } = 
            createFile'(name, access, share, mode, attributes)

        my writeVec' : (hndl * vector_of_one_byte_unts::Vector * Int * Int) -> Int = 
            cf "write_vector"
        my writeArr' : (hndl * rw_vector_of_one_byte_unts::Rw_Vector * Int * Int) -> Int =
            cf "write_rw_vector"

        my writeVecTxt' : (hndl * vector_of_chars::Vector * Int * Int) -> Int =
            cf "write_vec_txt"
        my writeArrTxt' : (hndl * rw_vector_of_chars::Rw_Vector * Int * Int) -> Int = 
            cf "write_arr_txt"

        writeVec = bufF (writeVec', vector_slice_of_one_byte_unts::base)
        writeArr = bufF (writeArr', rw_vector_slice_of_one_byte_unts::base)
        writeVecTxt = bufF (writeVecTxt', vector_slice_of_chars::base)
        writeArrTxt = bufF (writeArrTxt', rw_vector_slice_of_chars::base)

        cc = W32G::getConst "STD_HANDLE"
        my STD_INPUT_HANDLE:  word = cc "INPUT"
        my STD_OUTPUT_HANDLE:  word = cc "OUTPUT"
        my STD_ERROR_HANDLE:  word = cc "ERROR"

        my getStdHandle:  win32_general::word -> hndl = cf "get_std_handle"
}



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext