## posix-tty.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib# Package for POSIX 1003.1 operations on terminal devices
# This is a subpackage of the POSIX 1003.1 based
# 'Posix_1003_1b' package
#
# src/lib/std/src/posix-1003.1b/posix-1003-1b.pkgstipulate
package host_unt
=
host_unt_guts; # host_unt_guts is from src/lib/std/src/bind-sysword-32.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.pkgherein
package posix_tty {
#
package fs = posix_file; # posix_file is from src/lib/std/src/posix-1003.1b/posix-file.pkg package p = posix_process; # posix_process is from src/lib/std/src/posix-1003.1b/posix-process.pkg #
Process_Id = posix_process::Process_Id;
File_Descriptor
=
posix_file::File_Descriptor;
Unt = host_unt::Unt;
Sy_Int = host_int::Int;
# my op | = host_unt::bitwise_or;
# my op & = host_unt::bitwise_and;
# infix | & ;
fun cfun fun_name
=
ci::find_c_function { lib_name => "posix_tty", fun_name };
my osval: String -> Sy_Int
=
cfun "osval";
w_osval = host_unt::from_int o osval;
package i {
stipulate
package bf = bit_flags_g ();
herein
include bf;
end;
brkint = from_unt (w_osval "BRKINT");
icrnl = from_unt (w_osval "ICRNL");
ignbrk = from_unt (w_osval "IGNBRK");
igncr = from_unt (w_osval "IGNCR");
ignpar = from_unt (w_osval "IGNPAR");
inlcr = from_unt (w_osval "INLCR");
inpck = from_unt (w_osval "INPCK");
istrip = from_unt (w_osval "ISTRIP");
ixoff = from_unt (w_osval "IXOFF");
ixon = from_unt (w_osval "IXON");
parmrk = from_unt (w_osval "PARMRK");
};
package o {
stipulate
package bf = bit_flags_g ();
herein
include bf;
end;
opost = from_unt (w_osval "OPOST");
};
package c {
stipulate
package bf = bit_flags_g ();
herein
include bf;
end;
clocal = from_unt (w_osval "CLOCAL");
cread = from_unt (w_osval "CREAD");
csize = from_unt (w_osval "CSIZE");
cs5 = from_unt (w_osval "CS5");
cs6 = from_unt (w_osval "CS6");
cs7 = from_unt (w_osval "CS7");
cs8 = from_unt (w_osval "CS8");
cstopb = from_unt (w_osval "CSTOPB");
hupcl = from_unt (w_osval "HUPCL");
parenb = from_unt (w_osval "PARENB");
parodd = from_unt (w_osval "PARODD");
};
package l {
stipulate
package bf = bit_flags_g ();
herein
include bf;
end;
echo = from_unt (w_osval "ECHO");
echoe = from_unt (w_osval "ECHOE");
echok = from_unt (w_osval "ECHOK");
echonl = from_unt (w_osval "ECHONL");
icanon = from_unt (w_osval "ICANON");
iexten = from_unt (w_osval "IEXTEN");
isig = from_unt (w_osval "ISIG");
noflsh = from_unt (w_osval "NOFLSH");
tostop = from_unt (w_osval "TOSTOP");
};
package v {
package wv = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package wa = 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 b = byte; # byte is from src/lib/std/src/byte.pkg nccs = osval "NCCS";
eof = (osval "EOF");
eol = (osval "EOL");
erase = (osval "ERASE");
intr = (osval "INTR");
kill = (osval "KILL");
min = (osval "MIN");
quit = (osval "QUIT");
susp = (osval "SUSP");
time = (osval "TIME");
start = (osval "START");
stop = (osval "STOP");
# All through here "cc" is "control characters",
# centering on a termios vector recording the
# special handling the terminal driver is
# currently implementing for ^C ^S ^Q and so forth:
Cc = CC wv::Vector;
fun mk_cc (arr, l)
=
{ fun set (i, c)
=
wa::set (arr, i, b::char_to_byte c);
list::apply set l;
CC (wa::to_vector arr);
};
fun cc vals
=
mk_cc (wa::make_rw_vector (nccs, 0u0), vals);
fun update (CC v, vals)
=
mk_cc (wa::tabulate (nccs, fn i = wv::get (v, i)), vals);
fun sub (CC v, i)
=
b::byte_to_char (wv::get (v, i));
};
Speed = BITSPEED Unt;
fun compare_speed (BITSPEED w, BITSPEED w')
=
if (host_unt::(<) (w, w') ) LESS;
elif (w == w' ) EQUAL;
else GREATER;
fi;
fun speed_to_unt (BITSPEED w)
=
w;
fun unt_to_speed w
=
BITSPEED w;
b0 = BITSPEED (w_osval "B0");
b50 = BITSPEED (w_osval "B50");
b75 = BITSPEED (w_osval "B75");
b110 = BITSPEED (w_osval "B110");
b134 = BITSPEED (w_osval "B134");
b150 = BITSPEED (w_osval "B150");
b200 = BITSPEED (w_osval "B200");
b300 = BITSPEED (w_osval "B300");
b600 = BITSPEED (w_osval "B600");
b1200 = BITSPEED (w_osval "B1200");
b1800 = BITSPEED (w_osval "B1800");
b2400 = BITSPEED (w_osval "B2400");
b4800 = BITSPEED (w_osval "B4800");
b9600 = BITSPEED (w_osval "B9600");
b19200 = BITSPEED (w_osval "B19200");
b38400 = BITSPEED (w_osval "B38400");
Termios
=
TIOS
{
iflag: i::Flags,
oflag: o::Flags,
cflag: c::Flags,
lflag: l::Flags,
cc: v::Cc,
ispeed: Speed,
ospeed: Speed
};
fun termios arg = TIOS arg;
fun fields_of (TIOS arg) = arg;
fun getiflag (TIOS { iflag, ... } ) = iflag;
fun getoflag (TIOS { oflag, ... } ) = oflag;
fun getcflag (TIOS { cflag, ... } ) = cflag;
fun getlflag (TIOS { lflag, ... } ) = lflag;
fun getcc (TIOS { cc, ... } ) = cc;
fun getospeed (TIOS { ospeed, ... } ) = ospeed;
fun getispeed (TIOS { ispeed, ... } ) = ispeed;
fun setospeed (TIOS r, ospeed)
=
TIOS {
iflag => r.iflag,
oflag => r.oflag,
cflag => r.cflag,
lflag => r.lflag,
cc => r.cc,
ispeed => r.ispeed,
ospeed
};
fun setispeed (TIOS r, ispeed)
=
TIOS {
iflag => r.iflag,
oflag => r.oflag,
cflag => r.cflag,
lflag => r.lflag,
cc => r.cc,
ispeed,
ospeed => r.ospeed
};
package tc {
Set_Action = SA Sy_Int;
sanow = SA (osval "TCSANOW");
sadrain = SA (osval "TCSADRAIN");
saflush = SA (osval "TCSAFLUSH");
Flow_Action = FA Sy_Int;
ooff = FA (osval "TCOOFF");
oon = FA (osval "TCOON");
ioff = FA (osval "TCIOFF");
ion = FA (osval "TCION");
Queue_Sel = QS Sy_Int;
iflush = QS (osval "TCIFLUSH");
oflush = QS (osval "TCOFLUSH");
ioflush = QS (osval "TCIOFLUSH");
};
Termio_Rep
=
( Unt, # iflags
Unt, # oflags
Unt, # Cflags
Unt, # lflags
v::wv::Vector, # Cc
Unt, # inspeed
Unt # outspeed
);
my tcgetattr: Int -> Termio_Rep
=
cfun "tcgetattr"; # tcgetattr def in src/c/lib/posix-tty/tcgetattr.c
fun getattr fd
=
{ my (ifs, ofs, cfs, lfs, cc, isp, osp)
=
tcgetattr (fs::fd_to_int fd);
TIOS {
iflag => i::from_unt ifs,
oflag => o::from_unt ofs,
cflag => c::from_unt cfs,
lflag => l::from_unt lfs,
cc => v::CC cc,
ispeed => BITSPEED isp,
ospeed => BITSPEED osp
};
};
my tcsetattr: (Int, Sy_Int, Termio_Rep) -> Void
=
cfun "tcsetattr"; # tcsetattr def in src/c/lib/posix-tty/tcsetattr.c
fun setattr (fd, tc::SA sa, TIOS tios)
=
{
iflag = i::to_unt tios.iflag;
oflag = o::to_unt tios.oflag;
cflag = c::to_unt tios.cflag;
lflag = l::to_unt tios.lflag;
my (v::CC cc) = tios.cc;
my (BITSPEED ispeed) = tios.ispeed;
my (BITSPEED ospeed) = tios.ospeed;
trep = (iflag, oflag, cflag, lflag, cc, ispeed, ospeed);
tcsetattr (fs::fd_to_int fd, sa, trep);
};
my tcsendbreak: (Int, Int) -> Void = cfun "tcsendbreak"; # tcsendbreak def in src/c/lib/posix-tty/tcsendbreak.c
#
fun sendbreak (fd, duration)
=
tcsendbreak (fs::fd_to_int fd, duration);
my tcdrain: Int -> Void = cfun "tcdrain"; # tcdrain def in src/c/lib/posix-tty/tcdrain.c
#
fun drain fd
=
tcdrain (fs::fd_to_int fd);
my tcflush: (Int, Sy_Int) -> Void = cfun "tcflush"; # tcflush def in src/c/lib/posix-tty/tcflush.c
#
fun flush (fd, tc::QS qs)
=
tcflush (fs::fd_to_int fd, qs);
my tcflow: (Int, Sy_Int) -> Void = cfun "tcflow"; # tcflow def in src/c/lib/posix-tty/tcflow.c
#
fun flow (fd, tc::FA action)
=
tcflow (fs::fd_to_int fd, action);
my tcgetpgrp: Int -> Sy_Int = cfun "tcgetpgrp"; # tcgetpgrp def in src/c/lib/posix-tty/tcgetpgrp.c
#
fun getpgrp fd
=
p::PID (tcgetpgrp (fs::fd_to_int fd));
my tcsetpgrp: (Int, Sy_Int) -> Void = cfun "tcsetpgrp"; # tcsetpgrp def in src/c/lib/posix-tty/tcsetpgrp.c
#
fun setpgrp (fd, p::PID pid)
=
tcsetpgrp (fs::fd_to_int fd, pid);
};
end;