## threadkit-posix-binary-base-io.pkg
# Compiled by:
# src/lib/std/standard.lib# This implements the UNIX version of the OS specific binary primitive
# IO package. The Text IO version is implemented by a trivial translation
# of these operations (see posix-text-base-io.pkg).
# We get compiletime passed as a generic arg in:
# src/lib/std/src/posix/posix-threadkit-binary-io.pkgstipulate
package io = threadkit_io_manager; # threadkit_io_manager is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-io-manager.pkg package md = maildrop; # maildrop is from src/lib/src/lib/thread-kit/src/core-thread-kit/maildrop.pkg package md1 = oneshot_maildrop; # oneshot_maildrop is from src/lib/src/lib/thread-kit/src/core-thread-kit/oneshot-maildrop.pkg #
package vec = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package pf = posix_1003_1b; # posix_1003_1b is from src/lib/std/src/posix-1003.1b/posix-1003-1b.pkg package pio = posix_1003_1b;
package rse = retry_syscall_on_eintr; # retry_syscall_on_eintr; is from src/lib/std/src/threadkit/posix/retry-syscall-on-eintr.pkgherein
package threadkit_posix_binary_base_io
: (weak) Threadkit_Winix_Base_Io # Threadkit_Winix_Base_Io is from src/lib/std/src/io/threadkit-winix-base-io.api {
package base_io = threadkit_binary_base_io; # threadkit_binary_base_io is from src/lib/std/src/io/threadkit-binary-base-io.pkg File_Descriptor = pf::File_Descriptor;
to_fpi = file_position::from_int;
buffer_size_b = 4096;
fun is_reg_file fd
=
pf::stat::is_file (pf::fstat fd);
fun pos_fns (closed, fd)
=
if (is_reg_file fd)
pos = REF (file_position::from_int 0);
fun get_position ()
=
*pos;
fun set_position p
=
{ if *closed
raise exception io_exceptions::CLOSED_IO_STREAM;
fi;
pos := pio::lseek (fd, p, pio::SEEK_SET);
};
fun end_position ()
=
{ if *closed
raise exception io_exceptions::CLOSED_IO_STREAM;
fi;
pf::stat::size (pf::fstat fd);
};
fun verify_position ()
=
{ cur_pos = pio::lseek (fd, file_position::from_int 0, pio::SEEK_CUR);
pos := cur_pos;
cur_pos;
};
ignore (verify_position());
{ pos,
get_position => THE get_position,
set_position => THE set_position,
end_position => THE end_position,
verify_position => THE verify_position
};
else
{ pos => REF (file_position::from_int 0),
get_position => NULL,
set_position => NULL,
end_position => NULL,
verify_position => NULL
};
fi;
fun make_reader { fd, name }
=
{ include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg io_descriptor = pf::fd_to_iod fd;
lock_mv = md::make_full_maildrop ();
fun with_lock f x
=
{ md::empty lock_mv;
(rse::do_syscall_retry_on_eintr f x)
before
md::fill (lock_mv, ());
}
except
ex = { md::fill (lock_mv, ());
raise exception ex;
};
fun with_lock' (THE f)
=>
THE (with_lock f);
with_lock' NULL
=>
NULL;
end;
closed = REF FALSE;
my { pos, get_position, set_position, end_position, verify_position }
=
pos_fns (closed, fd);
fun inc_pos k
=
pos := file_position::(+) (*pos, to_fpi k);
fun block_wrap f x
=
{ if *closed
raise exception io_exceptions::CLOSED_IO_STREAM;
fi;
f x;
};
read_mailop
=
io::io_mailop { io_descriptor, readable => TRUE, writable => FALSE, oobdable => FALSE };
fun mailop_wrap f x
=
with_nack
(fn nack
=
{ if *closed
raise exception io_exceptions::CLOSED_IO_STREAM;
fi;
case (md::nonblocking_empty lock_mv)
NULL =>
{ repl_v = md1::make_oneshot_maildrop ();
make_thread "binary primitive I/O"
.{ select [
read_mailop ==> (fn _ = md1::set (repl_v, ())),
nack
];
};
md1::get' repl_v
==>
(fn _ = f x);
};
THE _
=>
read_mailop
==>
(fn _ = { md::fill (lock_mv, ());
f x;
}
);
esac;
}
);
fun read_vector n
=
{ do_mailop read_mailop;
v = pio::read_vector (fd, n);
inc_pos (vec::length v);
v;
};
fun read_rw_vector arg
=
{ do_mailop read_mailop;
k = pio::read_rw_vector (fd, arg);
inc_pos k;
k;
};
fun close ()
=
if (not *closed)
closed := TRUE;
pio::close fd;
fi;
is_reg = is_reg_file fd;
fun avail ()
=
if *closed
#
THE 0;
else
is_reg ?? THE (file_position::to_int (pf::stat::size (pf::fstat fd) - *pos))
:: NULL;
fi;
threadkit_binary_base_io::READER
{
name,
chunk_size => buffer_size_b,
read_vector => with_lock (block_wrap read_vector),
read_rw_vector => with_lock (block_wrap read_rw_vector),
read_vec_mailop => mailop_wrap read_vector,
read_arr_mailop => mailop_wrap read_rw_vector,
avail => with_lock avail,
get_position => with_lock' get_position,
set_position => with_lock' set_position,
end_position => with_lock' end_position,
verify_position => with_lock' verify_position,
close => with_lock close,
io_descriptor => THE io_descriptor
};
};
fun open_for_read name
=
make_reader {
fd => pf::openf (name, pf::O_RDONLY, pf::o::flags []),
name
};
fun make_writer { fd, name, append_mode, chunk_size }
=
{ include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg io_descriptor = pf::fd_to_iod fd;
lock_drop = md::make_full_maildrop ();
fun with_lock f x
=
{ md::empty lock_drop;
(rse::do_syscall_retry_on_eintr f x)
before
md::fill (lock_drop, ());
}
except
ex = { md::fill (lock_drop, ());
raise exception ex;
};
fun with_lock' (THE f) => THE (with_lock f);
with_lock' NULL => NULL;
end;
closed = REF FALSE;
append_fs
=
pio::flags::flags
if append_mode [pio::flags::append];
else [];
fi;
fun update_status ()
=
pio::setfl (fd, append_fs);
fun ensure_open ()
=
if *closed
raise exception io_exceptions::CLOSED_IO_STREAM;
fi;
fun put_v x = pio::write_vector x;
fun put_a x = pio::write_rw_vector x;
fun write put arg
=
{ ensure_open ();
put (fd, arg);
};
write_mailop
=
io::io_mailop { io_descriptor, readable => FALSE, writable => TRUE, oobdable => FALSE };
fun mailop_wrap f x
=
with_nack
(fn nack = { if *closed
raise exception io_exceptions::CLOSED_IO_STREAM;
fi;
case (md::nonblocking_empty lock_drop)
NULL =>
{ reply_drop = md1::make_oneshot_maildrop ();
make_thread "binary primitive I/O II"
.{ select
[ write_mailop ==> (fn _ = md1::set (reply_drop, ())),
nack
];
};
md1::get' reply_drop
==>
(fn _ = f x);
};
THE _
=>
write_mailop
==>
(fn _ = { md::fill (lock_drop, ());
f x;
}
);
esac;
}
);
fun close ()
=
if (not *closed)
closed := TRUE;
pio::close fd;
fi;
my { pos, get_position, set_position, end_position, verify_position }
=
pos_fns (closed, fd);
threadkit_binary_base_io::WRITER
{
name => name,
chunk_size => chunk_size,
write_vector => with_lock (write put_v),
write_rw_vector => with_lock (write put_a),
write_vec_mailop => mailop_wrap (write put_v),
write_arr_mailop => mailop_wrap (write put_a),
get_position => with_lock' get_position,
set_position => with_lock' set_position,
end_position => with_lock' end_position,
verify_position => with_lock' verify_position,
close => with_lock close,
io_descriptor => THE io_descriptor
};
};
standard_mode # mode 0666
=
pf::s::flags
[
pf::s::irusr, pf::s::iwusr,
pf::s::irgrp, pf::s::iwgrp,
pf::s::iroth, pf::s::iwoth
];
fun create_file (name, mode, flags) # "In order to make an apple pie from scratch, you must first create the universe." -- Carl Sagan
=
pf::createf (name, mode, flags, standard_mode);
fun open_for_write name
=
make_writer
{
name,
fd => create_file (name, pf::O_WRONLY, pf::o::trunc),
append_mode => FALSE,
chunk_size => buffer_size_b
};
fun open_for_append name
=
make_writer
{
name,
fd => create_file (name, pf::O_WRONLY, pf::o::append),
append_mode => TRUE,
chunk_size => buffer_size_b
};
}; # package posix_binary_base_io
end;