## posix-tty.pkg
#
# Package for POSIX 1003.1 operations on terminal devices
# This is a subpackage of the POSIX 1003.1 based
# 'Posixlib' package
#
# src/lib/std/src/psx/posixlib.pkg# Compiled by:
# src/lib/std/src/standard-core.sublibstipulate
package byt = byte; # byte is from src/lib/std/src/byte.pkg 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 hi = host_int; # host_int is from src/lib/std/src/psx/host-int.pkg package pf = posix_file; # posix_file is from src/lib/std/src/psx/posix-file.pkg package pp = posix_process; # posix_process is from src/lib/std/src/psx/posix-process.pkg package hug = 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.pkg #
fun cfun fun_name
=
ci::find_c_function'' { lib_name => "posix_tty", fun_name };
herein
package posix_tty { # Posix_Tty is from src/lib/std/src/psx/posix-tty.api #
#
Process_Id = pp::Process_Id;
File_Descriptor = pf::File_Descriptor;
Unt = hug::Unt;
Sy_Int = hi::Int;
# my op | = hug::bitwise_or;
# my op & = hug::bitwise_and;
# infix | & ;
(cfun "osval") #
->
( osval4__syscall: String -> Sy_Int, # The '4's are to avoid duplicate-definition complaints when we get 'include'ed into the posix package.
osval4__ref,
set__osval4__ref
);
fun osval string
=
*osval4__ref string;
w_osval = hug::from_int o osval;
package i {
stipulate
package bf = bit_flags_g ();
herein
include package 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 package bf;
end;
opost = from_unt (w_osval "OPOST");
};
package c {
stipulate
package bf = bit_flags_g ();
herein
include package 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 package 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 {
#
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, byt::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::from_fn (nccs, \\ i = wv::get (v, i)), vals);
fun sub (CC v, i)
=
byt::byte_to_char (wv::get (v, i));
};
Speed = BITSPEED Unt;
fun compare_speed (BITSPEED w, BITSPEED w')
=
if (hug::(<) (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 = TERMIOS
{
iflag: i::Flags,
oflag: o::Flags,
cflag: c::Flags,
lflag: l::Flags,
cc: v::Cc,
ispeed: Speed,
ospeed: Speed
};
fun termios arg = TERMIOS arg;
fun fields_of (TERMIOS arg) = arg;
fun getiflag (TERMIOS t) = t.iflag;
fun getoflag (TERMIOS t) = t.oflag;
fun getcflag (TERMIOS t) = t.cflag;
fun getlflag (TERMIOS t) = t.lflag;
fun getcc (TERMIOS t) = t.cc;
fun getospeed (TERMIOS t) = t.ospeed;
fun getispeed (TERMIOS t) = t.ispeed;
fun setospeed (TERMIOS r, ospeed)
=
TERMIOS {
iflag => r.iflag,
oflag => r.oflag,
cflag => r.cflag,
lflag => r.lflag,
cc => r.cc,
ispeed => r.ispeed,
ospeed
};
fun setispeed (TERMIOS r, ispeed)
=
TERMIOS {
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
wv::Vector, # Cc
Unt, # inspeed
Unt # outspeed
);
(cfun "tcgetattr") # tcgetattr def in src/c/lib/posix-tty/tcgetattr.c
->
( tcgetattr__syscall: Int -> Termio_Rep,
tcgetattr__ref,
set__tcgetattr__ref
);
fun getattr fd
=
{ (*tcgetattr__ref (pf::fd_to_int fd))
->
(ifs, ofs, cfs, lfs, cc, isp, osp);
TERMIOS
{
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
};
};
(cfun "tcsetattr") # tcsetattr def in src/c/lib/posix-tty/tcsetattr.c
->
( tcsetattr__syscall: (Int, Sy_Int, Termio_Rep) -> Void,
tcsetattr__ref,
set__tcsetattr__ref
);
#
fun setattr (fd, tc::SA sa, TERMIOS 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;
tios.cc -> (v::CC cc);
tios.ispeed -> (BITSPEED ispeed);
tios.ospeed -> (BITSPEED ospeed);
trep = (iflag, oflag, cflag, lflag, cc, ispeed, ospeed);
*tcsetattr__ref (pf::fd_to_int fd, sa, trep);
};
(cfun "tcsendbreak") # tcsendbreak def in src/c/lib/posix-tty/tcsendbreak.c
->
( tcsendbreak__syscall: (Int, Int) -> Void,
tcsendbreak__ref,
set__tcsendbreak__ref
);
#
fun sendbreak (fd, duration)
=
*tcsendbreak__ref (pf::fd_to_int fd, duration);
(cfun "tcdrain") # tcdrain def in src/c/lib/posix-tty/tcdrain.c
->
( tcdrain__syscall: Int -> Void,
tcdrain__ref,
set__tcdrain__ref
);
#
fun drain fd
=
*tcdrain__ref (pf::fd_to_int fd);
(cfun "tcflush") # tcflush def in src/c/lib/posix-tty/tcflush.c
->
( tcflush__syscall: (Int, Sy_Int) -> Void,
tcflush__ref,
set__tcflush__ref
);
#
fun flush (fd, tc::QS qs)
=
*tcflush__ref (pf::fd_to_int fd, qs);
(cfun "tcflow") # tcflow def in src/c/lib/posix-tty/tcflow.c
->
( tcflow__syscall: (Int, Sy_Int) -> Void,
tcflow__ref,
set__tcflow__ref
);
#
fun flow (fd, tc::FA action)
=
*tcflow__ref (pf::fd_to_int fd, action);
(cfun "tcgetpgrp") # tcgetpgrp def in src/c/lib/posix-tty/tcgetpgrp.c
->
( tcgetpgrp__syscall: Int -> Sy_Int,
tcgetpgrp__ref,
set__tcgetpgrp__ref
);
#
fun getpgrp fd
=
pp::PID (*tcgetpgrp__ref (pf::fd_to_int fd));
(cfun "tcsetpgrp") # tcsetpgrp def in src/c/lib/posix-tty/tcsetpgrp.c
->
( tcsetpgrp__syscall: (Int, Sy_Int) -> Void,
tcsetpgrp__ref,
set__tcsetpgrp__ref
);
#
fun setpgrp (fd, pp::PID pid)
=
*tcsetpgrp__ref (pf::fd_to_int fd, pid);
};
end;