## posix-io.pkg
#
# Package for POSIX 1003.1 primitive I/O operations
# This is a subpackage of the POSIX 1003.1 based
# 'Posix' package
#
# src/lib/std/src/psx/posixlib.pkg#
# An alternate portable (cross-platform)
# I/O interface is defined and implemented in:
#
# src/lib/std/src/winix/winix-io--premicrothread.api# src/lib/std/src/posix/winix-io--premicrothread.pkg# Compiled by:
# src/lib/std/src/standard-core.sublibstipulate
package bio = winix_base_data_file_io_driver_for_posix__premicrothread; # winix_base_data_file_io_driver_for_posix__premicrothread is from src/lib/std/src/io/winix-base-data-file-io-driver-for-posix--premicrothread.pkg package tio = winix_base_text_file_io_driver_for_posix__premicrothread; # winix_base_text_file_io_driver_for_posix__premicrothread is from src/lib/std/src/io/winix-base-text-file-io-driver-for-posix--premicrothread.pkg #
package iox = io_exceptions; # io_exceptions is from src/lib/std/src/io/io-exceptions.pkg #
package hu = host_unt_guts; # host_unt_guts is from src/lib/std/src/bind-sysword-32.pkg package hi = host_int; # host_int is from src/lib/std/src/psx/host-int.pkg package int = int_guts; # int_guts is from src/lib/std/src/int-guts.pkg package ti = tagged_int; # tagged_int is from src/lib/std/types-only/basis-structs.pkg package pos = file_position_guts; # file_position_guts is from src/lib/std/src/bind-position-31.pkg package ci = mythryl_callable_c_library_interface; # mythryl_callable_c_library_interface is from src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkg package rus = vector_slice_of_one_byte_unts; # vector_slice_of_one_byte_unts is from src/lib/std/src/vector-slice-of-one-byte-unts.pkg package wus = rw_vector_slice_of_one_byte_unts; # rw_vector_slice_of_one_byte_unts is from src/lib/std/src/rw-vector-slice-of-one-byte-unts.pkg package ru = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package wu = rw_vector_of_one_byte_unts; # rw_vector_of_one_byte_unts is from src/lib/std/src/rw-vector-of-one-byte-unts.pkg package rcs = vector_slice_of_chars; # vector_slice_of_chars is from src/lib/std/src/vector-slice-of-chars.pkg package wcs = rw_vector_slice_of_chars; # rw_vector_slice_of_chars is from src/lib/std/src/rw-vector-slice-of-chars.pkg package wc = rw_vector_of_chars; # rw_vector_of_chars is from src/lib/std/src/rw-vector-of-chars.pkg package pf = posix_file; # posix_file is from src/lib/std/src/psx/posix-file.pkg fun cfun fun_name
=
ci::find_c_function'' { lib_name => "posix_io", fun_name };
herein
package posix_io { # Posix_Io is from src/lib/std/src/psx/posix-io.api #
Open_Mode == pf::Open_Mode;
Sy_Unt = hu::Unt;
Sy_Int = hi::Int;
# my op | = hu::bitwise_or;
# my op & = hu::bitwise_and;
(cfun "osval") # osval def in src/c/lib/posix-io/osval.c
->
( osval2__syscall: String -> Sy_Int, # The '2's here are just because otherwise when this pkg gets included into the posix package we get complaints about duplicate osval defs.
osval2__ref,
set__osval2__ref
);
fun osval string # Private to this file.
=
*osval2__ref string;
w_osval = hu::from_int o osval;
fun fail (fct, msg)
=
raise exception DIE ("POSIX_IO." + fct + ": " + msg);
File_Descriptor = pf::File_Descriptor;
Process_Id = posix_process::Process_Id;
(cfun "pipe") # pipe def in src/c/lib/posix-io/pipe.c
->
( make_pipe__syscall: Void -> (Sy_Int, Sy_Int),
make_pipe__ref,
set__make_pipe__ref
);
#
fun make_pipe ()
=
{ (*make_pipe__ref ()) -> (ifd, ofd);
#
{ infd => pf::int_to_fd ifd,
outfd => pf::int_to_fd ofd
};
};
fun make_pipe__without_syscall_redirection ()
=
{ (make_pipe__syscall ()) -> (ifd, ofd);
#
{ infd => pf::int_to_fd ifd,
outfd => pf::int_to_fd ofd
};
};
(cfun "dup") # dup def in src/c/lib/posix-io/dup.c
->
( dup__syscall: Sy_Int -> Sy_Int,
dup__ref,
set__dup__ref
);
#
fun dup fd
=
pf::int_to_fd (*dup__ref (pf::fd_to_int fd));
(cfun "dup2") # dup2 def in src/c/lib/posix-io/dup2.c
->
( dup2__syscall: (Sy_Int, Sy_Int) -> Void,
dup2__ref,
set__dup2__ref
);
#
fun dup2 { old, new }
=
*dup2__ref ( pf::fd_to_int old,
pf::fd_to_int new
);
fun dup2__without_syscall_redirection { old, new }
=
dup2__syscall ( pf::fd_to_int old,
pf::fd_to_int new
);
(cfun "close") # close def in src/c/lib/posix-io/close.c
->
( close__syscall: Sy_Int -> Void,
close__ref,
set__close__ref
);
#
fun close fd
=
{
*close__ref (pf::fd_to_int fd);
};
#
fun close__without_syscall_redirection fd
=
{
close__syscall (pf::fd_to_int fd);
};
(cfun "read") # read def in src/c/lib/posix-io/read.c
->
( read__syscall: (Int, Int) -> ru::Vector,
read__ref,
set__read__ref
);
(cfun "readbuf") # readbuf def in src/c/lib/posix-io/readbuf.c
->
( readbuf__syscall: (Int, wu::Rw_Vector, Int, Int) -> Int,
readbuf__ref,
set__readbuf__ref
);
fun read_as_vector { file_descriptor, max_bytes_to_read }
=
{ if (max_bytes_to_read < 0) raise exception SIZE; fi;
#
*read__ref ( pf::fd_to_int file_descriptor,
max_bytes_to_read
);
};
fun read_as_vector__without_syscall_redirection { file_descriptor, max_bytes_to_read }
=
{ if (max_bytes_to_read < 0) raise exception SIZE; fi;
#
read__syscall ( pf::fd_to_int file_descriptor,
max_bytes_to_read
);
};
fun read_into_buffer { file_descriptor => fd, read_buffer }
=
{ (wus::burst_slice read_buffer)
->
(buf, i, len);
*readbuf__ref ( pf::fd_to_int fd,
buf,
len,
i
);
};
fun read_into_buffer__without_syscall_redirection { file_descriptor => fd, read_buffer }
=
{ (wus::burst_slice read_buffer)
->
(buf, i, len);
readbuf__syscall ( pf::fd_to_int fd,
buf,
len,
i
);
};
# Oddly, we nowhere call cfun "write" == src/c/lib/posix-io/write.c The file should be used or deleted. XXX BUGGO FIXME
# These two are motivated by a desire to have
# src/lib/x-kit/widget/edit/eval-mode.pkg # be able to capture all stdout/stderr output
# from evaluated Mythryl code.
# The safest, simplest approach seems to be
# to do the redirect as late and low in the I/O
# stack as practical, which is here in this file.
# There will be problems if the redirects are
# into concurrent code but the calls wind up
# coming from non-concurrent code (Mythryl code
# executing in other hostthreads). Got a fix? XXX SUCKO FIXME.
stdout_redirect = REF (NULL: (Null_Or( String -> Void ) ));
stderr_redirect = REF (NULL: (Null_Or( String -> Void ) ));
(cfun "writebuf") # fd buffer nbytes offset bytes_written # writebuf def in src/c/lib/posix-io/writebuf.c
-> # -- ------------- ------ ------ -------------
( write_ro_slice__syscall: (Int, ru::Vector, Int, Int ) -> Int,
write_ro_slice__ref,
set__write_ro_slice__ref
);
(cfun "writebuf") # fd buffer nbytes offset bytes_written # writebuf def in src/c/lib/posix-io/writebuf.c
-> # -- ------------- ------ ------ -------------
( write_rw_slice__syscall: (Int, wu::Rw_Vector, Int, Int ) -> Int,
write_rw_slice__ref,
set__write_rw_slice__ref
);
fun write_rw_vector (fd, rw_vector_slice) # This fn is exported to clients.
=
{ (wus::burst_slice rw_vector_slice)
->
(buf, i, len);
fd = pf::fd_to_int fd;
fun slice_to_string vector_slice
=
{ bytes = wus::to_vector vector_slice;
#
byte::bytes_to_string bytes;
};
case fd # Handle optional stdout/stderr redirection to an arbitrary concurrent Mythryl fn instead of the usual C-layer output fn.
#
1 => case *stdout_redirect THE fn => { fn (slice_to_string rw_vector_slice); len; };
NULL => *write_rw_slice__ref (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
esac;
2 => case *stderr_redirect THE fn => { fn (slice_to_string rw_vector_slice); len; };
NULL => *write_rw_slice__ref (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
esac;
_ => *write_rw_slice__ref (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
esac;
};
fun write_rw_vector__without_syscall_redirection (fd, rw_vector_slice) # This fn is exported to clients. I can't find any current uses of this call. 2015-07-14 CrT
=
{ (wus::burst_slice rw_vector_slice)
->
(buf, i, len);
# We don't do the stdout/stderr redirection dance here because we're intended to be called from secondary hostthreads and we expect the redirection to be in the
fd = pf::fd_to_int fd; # primary (concurrent) hostthread and calling concurrent code from nonconcurrent code won't work trivially. Feel free to code that up. XXX SUCKO FIXME.
write_rw_slice__syscall (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
};
fun write_vector (fd, vector_slice) # This fn is exported to clients.
=
{ (rus::burst_slice vector_slice)
->
(buf, i, len);
fd = pf::fd_to_int fd;
fun slice_to_string vector_slice
=
{ bytes = rus::to_vector vector_slice;
#
byte::bytes_to_string bytes;
};
case fd # Handle optional stdout/stderr redirection to an arbitrary concurrent Mythryl fn instead of the usual C-layer output fn.
#
1 => case *stdout_redirect THE fn => { fn (slice_to_string vector_slice); len; };
NULL => *write_ro_slice__ref (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
esac;
2 => case *stderr_redirect THE fn => { fn (slice_to_string vector_slice); len; };
NULL => *write_ro_slice__ref (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
esac;
_ => *write_ro_slice__ref (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
esac;
};
fun write_vector__without_syscall_redirection (fd, vector_slice) # This fn is exported to clients.
=
{ (rus::burst_slice vector_slice)
->
(buf, i, len);
# We don't do the stdout/stderr redirection dance here because we're intended to be called from secondary hostthreads and we expect the redirection to be in the
fd = pf::fd_to_int fd; # primary (concurrent) hostthread and calling concurrent code from nonconcurrent code won't work trivially. Feel free to code that up. XXX SUCKO FIXME.
write_ro_slice__syscall (fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
};
fun write_string (fd, string) # This fn is exported to clients. This fn added to support src/lib/make-library-glue/patchfile.pkg = # Seems strange it wasn't added earlier. :-)
{ buf = byte::string_to_bytes string;
#
len = ru::length buf;
#
fd = pf::fd_to_int fd;
case fd # Handle optional stdout/stderr redirection to an arbitrary concurrent Mythryl fn instead of the usual C-layer output fn.
#
1 => case *stdout_redirect THE fn => { fn string; len; };
NULL => *write_ro_slice__ref (fd, buf, len, 0); # Write (to fd) 'len' bytes starting at &buf[0], via an atomic C write() call.
esac;
2 => case *stderr_redirect THE fn => { fn string; len; };
NULL => *write_ro_slice__ref (fd, buf, len, 0); # Write (to fd) 'len' bytes starting at &buf[0], via an atomic C write() call.
esac;
_ => *write_ro_slice__ref (fd, buf, len, 0); # Write (to fd) 'len' bytes starting at &buf[0], via an atomic C write() call.
esac;
};
Whence = SEEK_SET | SEEK_CUR | SEEK_END;
seek_set = osval "SEEK_SET";
seek_cur = osval "SEEK_CUR";
seek_end = osval "SEEK_END";
fun wh_to_unt SEEK_SET => seek_set;
wh_to_unt SEEK_CUR => seek_cur;
wh_to_unt SEEK_END => seek_end;
end;
fun wh_from_unt wh
=
if (wh == seek_set ) SEEK_SET;
elif (wh == seek_cur ) SEEK_CUR;
elif (wh == seek_end ) SEEK_END;
else fail ("whFromUnt", "unknown whence " + (int::to_string wh));
fi;
package fd {
#
stipulate
package bit_flags = bit_flags_g (); # bit_flags_g is from src/lib/std/src/bit-flags-g.pkg herein
include package bit_flags;
end;
cloexec = from_unt (w_osval "cloexec");
};
package flags {
#
stipulate
package bit_flags = bit_flags_g ();
herein
include package bit_flags;
end;
append = from_unt (w_osval "append");
dsync = from_unt (w_osval "dsync");
nonblock = from_unt (w_osval "nonblock");
rsync = from_unt (w_osval "rsync");
sync = from_unt (w_osval "sync");
};
(cfun "fcntl_d") # fcntl_d def in src/c/lib/posix-io/fcntl_d.c
->
( fcntl_d__syscall: (Sy_Int, Sy_Int) -> Sy_Int,
fcntl_d__ref,
set__fcntl_d__ref
);
(cfun "fcntl_gfd") # fcntl_gfd def in src/c/lib/posix-io/fcntl_gfd.c
->
( fcntl_gfd__syscall: Sy_Int -> Sy_Unt,
fcntl_gfd__ref,
set__fcntl_gfd__ref
);
(cfun "fcntl_sfd") # fcntl_sfd def in src/c/lib/posix-io/fcntl_sfd.c
->
( fcntl_sfd__syscall: (Sy_Int, Sy_Unt) -> Void,
fcntl_sfd__ref,
set__fcntl_sfd__ref
);
(cfun "fcntl_gfl") # fcntl_gfl def in src/c/lib/posix-io/fcntl_gfl.c
->
( fcntl_gfl__syscall: Sy_Int -> (Sy_Unt, Sy_Unt),
fcntl_gfl__ref,
set__fcntl_gfl__ref
);
(cfun "fcntl_sfl") # fcntl_sfl def in src/c/lib/posix-io/fcntl_sfl.c
->
( fcntl_sfl__syscall: (Sy_Int, Sy_Unt) -> Void,
fcntl_sfl__ref,
set__fcntl_sfl__ref
);
fun dupfd { old, base }
=
pf::int_to_fd (*fcntl_d__ref (pf::fd_to_int old, pf::fd_to_int base));
fun getfd fd
=
fd::from_unt (*fcntl_gfd__ref (pf::fd_to_int fd));
fun setfd (fd, fl) = *fcntl_sfd__ref (pf::fd_to_int fd, fd::to_unt fl);
fun setfd__without_syscall_redirection (fd, fl) = fcntl_sfd__syscall (pf::fd_to_int fd, fd::to_unt fl);
fun getfl fd # "getfl" may be "get_flags", in particular ok_to_block (non/blocking mode) flag.
=
{ (*fcntl_gfl__ref (pf::fd_to_int fd))
->
(status, omode);
#
( flags::from_unt status,
pf::omode_from_unt omode
);
};
fun setfl (fd, status) # "setfl" may be "set_flags", in particular ok_to_block (non/blocking mode) flag.
=
*fcntl_sfl__ref (pf::fd_to_int fd, flags::to_unt status);
Lock_Type
=
F_RDLCK | F_WRLCK | F_UNLCK;
package flock {
#
Flock = FLOCK
{ locktype: Lock_Type,
whence: Whence,
start: pos::Int,
len: pos::Int,
pid: Null_Or( Process_Id )
};
fun flock fv = FLOCK fv;
fun locktype (FLOCK fv) = fv.locktype;
fun whence (FLOCK fv) = fv.whence;
fun start (FLOCK fv) = fv.start;
fun len (FLOCK fv) = fv.len;
fun pid (FLOCK fv) = fv.pid;
};
Flock_Rep = (Sy_Int, Sy_Int, ti::Int, ti::Int, Sy_Int);
(cfun "fcntl_l") # fcntl_l is from src/c/lib/posix-io/fcntl_l.c
->
( fcntl_l__syscall: (Sy_Int, Sy_Int, Flock_Rep) -> Flock_Rep,
fcntl_l__ref,
set__fcntl_l__ref
);
f_getlk = osval "F_GETLK";
f_setlk = osval "F_SETLK";
f_setlkw = osval "F_SETLKW";
f_rdlck = osval "F_RDLCK";
f_wrlck = osval "F_WRLCK";
f_unlck = osval "F_UNLCK";
fun flock_to_rep (flock::FLOCK { locktype, whence, start, len, ... } )
=
(locktype_of locktype, wh_to_unt whence, start, len, 0)
where
fun locktype_of F_RDLCK => f_rdlck;
locktype_of F_WRLCK => f_wrlck;
locktype_of F_UNLCK => f_unlck;
end;
end;
fun flock_from_rep (usepid, (locktype, whence, start, len, pid))
=
flock::FLOCK
{
locktype => locktype_of locktype,
whence => wh_from_unt whence,
start,
len,
pid => usepid ?? THE (posix_process::PID pid)
:: NULL
}
where
fun locktype_of locktype
=
if (locktype == f_rdlck ) F_RDLCK;
elif (locktype == f_wrlck ) F_WRLCK;
elif (locktype == f_unlck ) F_UNLCK;
else fail ("flockFromRep", "unknown lock type " + (int::to_string locktype));
fi;
end;
fun getlk (fd, flock)
=
flock_from_rep (TRUE, *fcntl_l__ref (pf::fd_to_int fd, f_getlk, flock_to_rep flock));
fun setlk (fd, flock)
=
flock_from_rep (FALSE, *fcntl_l__ref (pf::fd_to_int fd, f_setlk, flock_to_rep flock));
fun setlkw (fd, flock)
=
flock_from_rep (FALSE, *fcntl_l__ref (pf::fd_to_int fd, f_setlkw, flock_to_rep flock));
(cfun "lseek") # lseek def in src/c/lib/posix-io/lseek.c
->
( lseek__syscall: (Sy_Int, ti::Int, Sy_Int) -> ti::Int,
lseek__ref,
set__lseek__ref
);
fun lseek (fd, offset, whence)
=
*lseek__ref (pf::fd_to_int fd, offset, wh_to_unt whence);
(cfun "fsync") # fsync def in src/c/lib/posix-io/fsync.c
->
( fsync__syscall: Sy_Int -> Void,
fsync__ref,
set__fsync__ref
);
fun fsync fd
=
*fsync__ref (pf::fd_to_int fd);
(cfun "copy") # copy def in src/c/lib/posix-io/copy.c
->
( copy__syscall: (String, String) -> Int,
copy__ref,
set__copy__ref
);
fun copy_file { from, to }
=
*copy__ref (from, to);
(cfun "equal") # equal def in src/c/lib/posix-io/equal.c
->
( equal__syscall: (String, String) -> Bool,
equal__ref,
set__equal__ref
);
fun file_contents_are_identical (filename1, filename2)
=
*equal__ref (filename1, filename2);
# Making filereaders and filewriters
# -- code moved here from winix-base-data-file-io-driver-for-posix--premicrothread.pkg
# and winix-base-text-file-io-driver-for-posix--premicrothread.pkg
fun announce s x y
=
{ # print "Posix: "; print (s: String); print "\n";
#
x y;
};
best_io_quantum = 4096; # Reading and writing 4KB at a time should be reasonably efficient.
fun is_plain_file fd
=
pf::stat::is_file (pf::fstat fd);
fun make_file_position_fns (closed, fd)
=
if (not (is_plain_file fd))
#
{ file_position => REF (pos::from_int 0),
get_file_position => NULL,
set_file_position => NULL,
end_file_position => NULL,
verify_file_position => NULL
};
else
#
file_position = REF (pos::from_int 0);
fun get_file_position ()
=
*file_position;
fun set_file_position p
=
{ if *closed raise exception iox::CLOSED_IO_STREAM; fi;
#
file_position := announce "lseek" lseek (fd, p, SEEK_SET);
};
fun end_file_position ()
=
{ if *closed raise exception iox::CLOSED_IO_STREAM; fi;
#
pf::stat::size (announce "fstat" pf::fstat fd);
};
fun verify_file_position ()
=
{ current_position = lseek (fd, pos::from_int 0, SEEK_CUR);
#
file_position := current_position;
#
current_position;
};
ignore (verify_file_position ());
{ file_position,
get_file_position => THE get_file_position,
set_file_position => THE set_file_position,
end_file_position => THE end_file_position,
verify_file_position => THE verify_file_position
};
fi;
fun make_filereader
{ filereader_constructor, # Either bio::FILEREADER
# or tio::FILEREADER -- core def in src/lib/std/src/io/winix-base-file-io-driver-for-posix-g--premicrothread.pkg cvt_vec,
cvt_arr_slice
}
{ file_descriptor, filename, ok_to_block => initial_ok_to_block }
=
{ closed = REF FALSE;
#
(make_file_position_fns (closed, file_descriptor))
->
{ file_position, get_file_position, set_file_position, end_file_position, verify_file_position };
ok_to_block = REF initial_ok_to_block; # Hidden state shared by below fns. We'll do nonblocking I/O whenever this is FALSE.
fun blocking_on () = { setfl (file_descriptor, flags::flags []); ok_to_block := TRUE; };
fun blocking_off () = { setfl (file_descriptor, flags::nonblock); ok_to_block := FALSE; };
fun advance_file_position k
=
file_position := pos::(+) (*file_position, pos::from_int k);
fun r_read_ro_vector max_bytes_to_read
=
{ v = announce "read" read_as_vector { file_descriptor, max_bytes_to_read };
#
advance_file_position (ru::length v);
cvt_vec v;
};
fun block_wrap f x
=
{ if *closed raise exception iox::CLOSED_IO_STREAM; fi;
if (not *ok_to_block) blocking_on (); fi;
f x;
};
fun no_block_wrap f x
=
{ if *closed raise exception iox::CLOSED_IO_STREAM; fi;
if *ok_to_block blocking_off (); fi;
THE (f x)
except
(e as runtime::RUNTIME_EXCEPTION(_, THE cause))
=
if (cause == posix_error::again) NULL;
else raise exception e;
fi;
};
fun close_if_open ()
=
if (not *closed)
#
closed := TRUE;
#
# print "close_if_open (Read) calling close... -- posix-io.pkg\n";
announce "close" close file_descriptor;
# print "close_if_open (Read) called close... -- posix-io.pkg\n";
fi;
stipulate
is_plain = is_plain_file file_descriptor;
herein
fun avail () # Number of bytes currently available to read.
= # This is usually just (file_length - file_position).
if *closed
#
THE 0;
#
elif is_plain
#
THE (pos::to_int (pf::stat::size (pf::fstat file_descriptor) - *file_position));
else
NULL;
fi;
end;
filereader_constructor
{
filename,
best_io_quantum,
#
read_vector => (block_wrap r_read_ro_vector),
#
blockx => NULL,
can_readx => NULL,
#
avail,
#
get_file_position,
set_file_position,
#
end_file_position,
verify_file_position,
#
close => close_if_open,
io_descriptor => THE (pf::fd_to_iod file_descriptor)
};
};
fun make_filewriter
#
{ filewriter_constructor, # Either bio::FILEWRITER (for binary files)
# or tio::FILEWRITER (for text files) -- see src/lib/std/src/io/winix-base-file-io-driver-for-posix-g--premicrothread.pkg cvt_vec_slice,
cvt_arr_slice
}
#
{ file_descriptor, filename, ok_to_block => initial_ok_to_block, append_mode, best_io_quantum }
=
{ closed = REF FALSE;
#
(make_file_position_fns (closed, file_descriptor))
->
{ file_position, get_file_position, set_file_position, end_file_position, verify_file_position };
fun advance_file_position k
=
{ file_position := pos::(+) (*file_position, pos::from_int k);
#
k;
};
ok_to_block = REF initial_ok_to_block; # Hidden state shared by below fns. We'll do nonblocking I/O whenever this is FALSE.
stipulate
append_flags = flags::flags (append_mode ?? [flags::append] :: NIL);
herein
fun update_status ()
=
{ flgs = if *ok_to_block append_flags;
else flags::flags [flags::nonblock, append_flags];
fi;
announce "setfl" setfl (file_descriptor, flgs);
};
end;
fun ensure_open ()
=
if *closed raise exception iox::CLOSED_IO_STREAM; fi;
fun ensure_block x
=
if (*ok_to_block != x)
#
ok_to_block := x;
update_status();
fi;
fun write_ro_vector' (fd, s) = write_vector (fd, cvt_vec_slice s);
fun write_rw_vector' (fd, s) = write_rw_vector (fd, cvt_arr_slice s);
fun put_ro_vector x = advance_file_position (announce "put_ro_vector" write_ro_vector' x);
fun put_rw_vector x = advance_file_position (announce "put_rw_vector" write_rw_vector' x);
fun write (put, block) arg
=
{ ensure_open ();
ensure_block block;
put (file_descriptor, arg);
};
fun handle_block writer arg
=
THE (writer arg)
except
(e as runtime::RUNTIME_EXCEPTION(_, THE cause))
=
if (cause == posix_error::again) NULL;
else raise exception e;
fi;
fun close_if_open ()
=
if (not *closed)
#
closed:=TRUE;
# print "close_if_open (Write) calling close... -- posix-io.pkg\n";
announce "close" close file_descriptor;
# print "close_if_open (Write) called close... -- posix-io.pkg\n";
fi;
filewriter_constructor
{
filename,
best_io_quantum,
#
write_vector => THE (write (put_ro_vector, TRUE)),
write_rw_vector => THE (write (put_rw_vector, TRUE)),
#
blockx => NULL,
can_output => NULL,
#
get_file_position,
set_file_position,
#
end_file_position,
verify_file_position,
#
io_descriptor => THE (pf::fd_to_iod file_descriptor),
close => close_if_open
};
};
stipulate
fun convert__vector_slice_of_chars__to__vector_slice_of_one_byte_unts
#
(vector_slice_of_chars: rcs::Slice): rus::Slice
=
{ (rcs::burst_slice vector_slice_of_chars)
->
(vector_of_chars, s, l);
vector_of_one_byte_unts = byte::string_to_bytes vector_of_chars;
rus::make_slice (vector_of_one_byte_unts, s, THE l);
};
fun convert__rw_vector_slice_of_chars__to__rw_vector_slice_of_one_byte_unts
#
(rw_vector_slice_of_chars: wcs::Slice): wus::Slice
=
{ (wcs::burst_slice rw_vector_slice_of_chars)
->
(rw_vector_of_chars: wc::Rw_Vector, s, l);
rw_vector_of_one_byte_unts
=
convert__rw_vector_of_chars__to__rw_vector_of_one_byte_unts
#
rw_vector_of_chars;
wus::make_slice (rw_vector_of_one_byte_unts: wu::Rw_Vector, s, THE l);
}
where
convert__rw_vector_of_chars__to__rw_vector_of_one_byte_unts
=
inline_t::cast: wc::Rw_Vector -> wu::Rw_Vector; # inline_t is from src/lib/core/init/built-in.pkg # XXX SUCKO FIXME these sorts of hacks should be collected in one file someplace instead of buried throughout the codebase.
# Hack!!! Above only works because
# rw_vector_of_chars::Rw_Vector
# rw_vector_of_one_byte_unts::Rw_Vector
# are really the same internally:
end;
herein
make_data_filereader # "data" == "binary"
=
make_filereader
{
filereader_constructor => bio::FILEREADER,
cvt_vec => \\ v = v,
cvt_arr_slice => \\ s = s
};
make_text_filereader
=
make_filereader
{
filereader_constructor => tio::FILEREADER,
cvt_vec => byte::bytes_to_string,
cvt_arr_slice => convert__rw_vector_slice_of_chars__to__rw_vector_slice_of_one_byte_unts
};
make_data_filewriter # "data" == "binary"
=
make_filewriter
{
filewriter_constructor => bio::FILEWRITER,
cvt_vec_slice => \\ s = s,
cvt_arr_slice => \\ s = s
};
make_text_filewriter
=
make_filewriter
{
filewriter_constructor => tio::FILEWRITER,
cvt_vec_slice => convert__vector_slice_of_chars__to__vector_slice_of_one_byte_unts,
cvt_arr_slice => convert__rw_vector_slice_of_chars__to__rw_vector_slice_of_one_byte_unts
};
end; # stipulate
}; # package posix_io
end; # stipulate