## threadkit-posix-test-base-io.pkg
# Compiled by:
# src/lib/std/standard.lib# This implements the UNIX version of the OS specific text primitive
# IO package. It is implemented by a trivial translation of the
# binary operations (see posix-binary-base-io.pkg).
package threadkit_posix_text_base_io: (weak)
api {
include Threadkit_Winix_Base_Io; # Threadkit_Winix_Base_Io is from src/lib/std/src/io/threadkit-winix-base-io.api stdin: Void -> base_io::Reader;
stdout: Void -> base_io::Writer;
stderr: Void -> base_io::Writer;
string_reader: String -> base_io::Reader;
}
{
package md = maildrop; # maildrop is from src/lib/src/lib/thread-kit/src/core-thread-kit/maildrop.pkg package pf = posix_1003_1b; # posix_1003_1b is from src/lib/std/src/posix-1003.1b/posix-1003-1b.pkg package binary_base_io = threadkit_posix_binary_base_io; # threadkit_posix_binary_base_io is from src/lib/std/src/posix/threadkit-posix-binary-base-io.pkg package base_io = threadkit_text_base_io; # threadkit_text_base_io is from src/lib/std/src/io/threadkit-text-base-io.pkg File_Descriptor = pf::File_Descriptor;
buffer_size_b = 4096;
# If char::char is really one_byte_unt::word
# then very efficient versions of
# translate_in and translate_out are possible:
#
my translate_in: binary_base_io::base_io::Reader -> base_io::Reader = unsafe::cast;
my translate_out: binary_base_io::base_io::Writer -> base_io::Writer = unsafe::cast;
fun open_for_read fname = translate_in (binary_base_io::open_for_read fname);
fun open_for_write fname = translate_out (binary_base_io::open_for_write fname);
fun open_for_append fname = translate_out (binary_base_io::open_for_append fname);
fun make_reader args = translate_in (binary_base_io::make_reader args);
fun make_writer args = translate_out (binary_base_io::make_writer args);
fun stdin ()
=
make_reader {
fd => pf::stdin,
name => "<stdin>"
};
fun stdout ()
=
make_writer {
fd => pf::stdout,
name => "<stdout>",
append_mode => FALSE, # Bug! Should check!
chunk_size => buffer_size_b
};
fun stderr ()
=
make_writer {
fd => pf::stderr,
name => "<stderr>",
append_mode => FALSE, # Bug! Should check!
chunk_size => buffer_size_b
};
fun string_reader src
=
{
lock_mv = md::make_full_maildrop ();
fun with_lock f x
=
{ md::empty lock_mv;
f x
before
md::fill (lock_mv, ());
}
except
x = { md::fill (lock_mv, ());
raise exception x;
};
pos = REF 0;
closed = REF FALSE;
fun check_closed ()
=
if *closed
raise exception io_exceptions::CLOSED_IO_STREAM;
fi;
len = string::length src;
plen = file_position::from_int len;
fun avail ()
=
len - *pos;
fun read_v n
=
{ p = *pos;
m = int::min (n, len-p);
check_closed ();
pos := p+m;
# NOTE: Could use unchecked operations here.
string::substring (src, p, m);
};
fun read_a asl
=
{ p = *pos;
my (buf, i, n)
=
rw_vector_slice_of_chars::base asl;
m = int::min (n, len - p);
check_closed ();
pos := p+m;
rw_vector_slice_of_chars::copy_vec
{ from => vector_slice_of_chars::make_slice (src, p, THE m),
to => buf,
di => i
};
m;
};
fun get_position ()
=
{ check_closed();
file_position::from_int *pos;
};
fun set_position p
=
{ check_closed ();
if (p >= 0 and p <= plen)
#
pos := file_position::to_int p;
else
raise exception SUBSCRIPT;
fi;
};
base_io::READER
{
name => "<string>",
chunk_size => len,
read_vector => with_lock read_v,
read_rw_vector => with_lock read_a,
read_vec_mailop => with_lock (threadkit::always_mailop o read_v),
read_arr_mailop => with_lock (threadkit::always_mailop o read_a),
avail => THE o avail,
get_position => THE (with_lock get_position),
set_position => THE (with_lock set_position),
end_position => THE (with_lock (fn () = { check_closed(); plen; })),
verify_position => THE (with_lock get_position),
close => with_lock (fn () = closed := TRUE),
io_descriptor => NULL
};
};
}; # posix_text_base_io