## posix-io.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib# 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/posix-1003.1b/posix-1003-1b.pkg# An alternate portable (cross-platform)
# I/O interface is defined and implemented in:
#
# src/lib/std/src/winix/winix-io.api# src/lib/std/src/posix/winix-io.pkgstipulate
package bio = winix_base_data_file_io_driver_for_posix; # winix_base_data_file_io_driver_for_posix is from src/lib/std/src/io/winix-base-data-file-io-driver-for-posix.pkg package tio = winix_base_text_file_io_driver_for_posix; # winix_base_text_file_io_driver_for_posix is from src/lib/std/src/io/winix-base-text-file-io-driver-for-posix.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/posix-1003.1b/posix-prelude.pkg package int = int_guts; # int_guts is from src/lib/std/src/bind-int-32.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/posix-1003.1b/posix-file.pkgherein
package posix_io {
#
stipulate
package open_mode
#
: (weak) api { Open_Mode = O_RDONLY | O_WRONLY | O_RDWR; }
=
pf;
herein
include open_mode;
end;
Sy_Unt = hu::Unt;
Sy_Int = hi::Int;
# my op | = hu::bitwise_or;
# my op & = hu::bitwise_and;
fun cfun fun_name
=
ci::find_c_function { lib_name => "posix_io", fun_name };
osval = cfun "osval": String -> Sy_Int; # osval def in src/c/lib/posix-io/osval.c
w_osval = hu::from_int o osval;
fun fail (fct, msg)
=
raise exception FAIL ("POSIX_IO." + fct + ": " + msg);
File_Descriptor = pf::File_Descriptor;
Process_Id = posix_process::Process_Id;
make_pipe' = cfun "pipe": Void -> (Sy_Int, Sy_Int); # pipe def in src/c/lib/posix-io/pipe.c
#
fun make_pipe ()
=
{ (make_pipe' ()) -> (ifd, ofd);
#
{ infd => pf::int_to_fd ifd,
outfd => pf::int_to_fd ofd
};
};
dup' = cfun "dup": Sy_Int -> Sy_Int ; # dup def in src/c/lib/posix-io/dup.c
#
fun dup fd
=
pf::int_to_fd (dup' (pf::fd_to_int fd));
dup2' = cfun "dup2": (Sy_Int, Sy_Int) -> Void; # dup2 def in src/c/lib/posix-io/dup2.c
#
fun dup2 { old, new }
=
dup2'(pf::fd_to_int old, pf::fd_to_int new);
close' = cfun "close": Sy_Int -> Void; # close def in src/c/lib/posix-io/close.c
#
fun close fd
=
close' (pf::fd_to_int fd);
read' = cfun "read": (Int, Int) -> ru::Vector; # read def in src/c/lib/posix-io/read.c
readbuf' = cfun "readbuf": (Int, wu::Rw_Vector, Int, Int) -> Int; # readbuf def in src/c/lib/posix-io/readbuf.c
fun read_as_vector { file_descriptor, max_bytes_to_read }
=
{ if (max_bytes_to_read < 0) raise exception SIZE; fi;
#
read' (pf::fd_to_int file_descriptor, max_bytes_to_read);
};
fun read_into_buffer { file_descriptor => fd, buffer }
=
{ (wus::base buffer)
->
(buf, i, len);
readbuf' (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
stipulate
# fd buffer nbytes offset
# -- ------------- ------ ------
write_ro_slice' = cfun "writebuf": (Int, ru::Vector, Int, Int ) -> Int; # writebuf def in src/c/lib/posix-io/writebuf.c
write_rw_slice' = cfun "writebuf": (Int, wu::Rw_Vector, Int, Int ) -> Int; # writebuf def in src/c/lib/posix-io/writebuf.c
herein
fun write_rw_vector (fd, asl) # This fn is exported to clients.
=
{ (wus::base asl)
->
(buf, i, len);
write_rw_slice' (pf::fd_to_int fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
};
fun write_vector (fd, vsl) # This fn is exported to clients.
=
{ (rus::base vsl)
->
(buf, i, len);
write_ro_slice' (pf::fd_to_int fd, buf, len, i); # Write (to fd) 'len' bytes starting at &buf[i], via an atomic C write() call.
};
end;
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 bit_flags;
end;
cloexec = from_unt (w_osval "cloexec");
};
package flags {
#
stipulate
package bit_flags = bit_flags_g ();
herein
include 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");
};
fcntl_d = cfun "fcntl_d" : (Sy_Int, Sy_Int) -> Sy_Int ; # fcntl_d def in src/c/lib/posix-io/fcntl_d.c
fcntl_gfd = cfun "fcntl_gfd": Sy_Int -> Sy_Unt ; # fcntl_gfd def in src/c/lib/posix-io/fcntl_gfd.c
fcntl_sfd = cfun "fcntl_sfd": (Sy_Int, Sy_Unt) -> Void ; # fcntl_sfd def in src/c/lib/posix-io/fcntl_sfd.c
fcntl_gfl = cfun "fcntl_gfl": Sy_Int -> (Sy_Unt, Sy_Unt) ; # fcntl_gfl def in src/c/lib/posix-io/fcntl_gfl.c
fcntl_sfl = cfun "fcntl_sfl": (Sy_Int, Sy_Unt) -> Void ; # fcntl_sfl def in src/c/lib/posix-io/fcntl_sfl.c
fun dupfd { old, base }
=
pf::int_to_fd (fcntl_d (pf::fd_to_int old, pf::fd_to_int base));
fun getfd fd
=
fd::from_unt (fcntl_gfd (pf::fd_to_int fd));
fun setfd (fd, fl)
=
fcntl_sfd (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 (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 (pf::fd_to_int fd, flags::to_unt status);
Lock_Type
=
F_RDLCK | F_WRLCK | F_UNLCK;
package flock {
#
Flock = FLOCK
{ ltype: Lock_Type,
whence: Whence,
start: pos::Int,
len: pos::Int,
pid: Null_Or( Process_Id )
};
fun flock fv = FLOCK fv;
fun ltype (FLOCK fv) = fv.ltype;
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, tagged_int::Int, tagged_int::Int, Sy_Int);
fcntl_l = cfun "fcntl_l": (Sy_Int, Sy_Int, Flock_Rep) -> Flock_Rep; # fcntl_l is from src/c/lib/posix-io/fcntl_l.c
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 { ltype, whence, start, len, ... } )
=
(ltype_of ltype, wh_to_unt whence, start, len, 0)
where
fun ltype_of F_RDLCK => f_rdlck;
ltype_of F_WRLCK => f_wrlck;
ltype_of F_UNLCK => f_unlck;
end;
end;
fun flock_from_rep (usepid, (ltype, whence, start, len, pid)) # 'ltype' may be 'locktype'.
=
flock::FLOCK
{
ltype => ltype_of ltype,
whence => wh_from_unt whence,
start,
len,
pid => usepid ?? THE (posix_process::PID pid)
:: NULL
}
where
fun ltype_of ltype
=
if (ltype == f_rdlck ) F_RDLCK;
elif (ltype == f_wrlck ) F_WRLCK;
elif (ltype == f_unlck ) F_UNLCK;
else fail ("flockFromRep", "unknown lock type " + (int::to_string ltype));
fi;
end;
fun getlk (fd, flock)
=
flock_from_rep (TRUE, fcntl_l (pf::fd_to_int fd, f_getlk, flock_to_rep flock));
fun setlk (fd, flock)
=
flock_from_rep (FALSE, fcntl_l (pf::fd_to_int fd, f_setlk, flock_to_rep flock));
fun setlkw (fd, flock)
=
flock_from_rep (FALSE, fcntl_l (pf::fd_to_int fd, f_setlkw, flock_to_rep flock));
lseek' = cfun "lseek": (Sy_Int, tagged_int::Int, Sy_Int) -> tagged_int::Int; # lseek def in src/c/lib/posix-io/lseek.c
fun lseek (fd, offset, whence)
=
lseek'(pf::fd_to_int fd, offset, wh_to_unt whence);
fsync' = cfun "fsync": Sy_Int -> Void; # fsync def in src/c/lib/posix-io/fsync.c
fun fsync fd
=
fsync' (pf::fd_to_int fd);
# Making filereaders and filewriters
# -- code moved here from winix-base-data-file-io-driver-for-posix.pkg
# and winix-base-text-file-io-driver-for-posix.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.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 r_read_rw_vector arg
=
{ k = announce "readBuf" read_into_buffer { file_descriptor, buffer => cvt_arr_slice arg };
#
advance_file_position k;
k;
};
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;
#
announce "close" close file_descriptor;
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 => THE ( block_wrap r_read_ro_vector),
read_rw_vector => THE ( block_wrap r_read_rw_vector),
#
read_vector_nonblocking => THE (no_block_wrap r_read_ro_vector),
read_rw_vector_nonblocking => THE (no_block_wrap r_read_rw_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.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;
announce "close" close file_descriptor;
fi;
filewriter_constructor
{
filename,
best_io_quantum,
#
write_vector => THE (write (put_ro_vector, TRUE)),
write_rw_vector => THE (write (put_rw_vector, TRUE)),
#
write_vector_nonblocking => THE (handle_block (write (put_ro_vector, FALSE))),
write_rw_vector_nonblocking => THE (handle_block (write (put_rw_vector, FALSE))),
#
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 c2w_vs cvs
=
{ (rcs::base cvs)
->
(cv, s, l);
wv = byte::string_to_bytes cv;
rus::make_slice (wv, s, THE l);
};
# inline_t is from src/lib/core/init/built-in.pkg c2w_a = inline_t::cast: wc::Rw_Vector -> wu::Rw_Vector;
#
# Hack!!! This only works because
# wc::Rw_Vector and
# wu::Rw_Vector
# are really the same internally:
fun c2w_as cas
=
{ (wcs::base cas)
->
(ca, s, l);
wa = c2w_a ca;
wus::make_slice (wa, s, THE l);
};
herein
make_data_filereader # "data" == "binary"
=
make_filereader
{
filereader_constructor => bio::FILEREADER,
cvt_vec => fn v = v,
cvt_arr_slice => fn s = s
};
make_text_filereader
=
make_filereader
{
filereader_constructor => tio::FILEREADER,
cvt_vec => byte::bytes_to_string,
cvt_arr_slice => c2w_as
};
make_data_filewriter # "data" == "binary"
=
make_filewriter
{
filewriter_constructor => bio::FILEWRITER,
cvt_vec_slice => fn s = s,
cvt_arr_slice => fn s = s
};
make_text_filewriter
=
make_filewriter
{
filewriter_constructor => tio::FILEWRITER,
cvt_vec_slice => c2w_vs,
cvt_arr_slice => c2w_as
};
end; # stipulate
}; # package posix_io
end; # stipulate