CommV24:
Код:
MODULE CommV24;
(*
A. V. Shiryaev, 2012.11
Linux, OpenBSD
32-bit
Interface corresponds to original BlackBox 1.6-rc6 CommV24
*)
IMPORT SYSTEM, Libc := LinLibc, Termios := LinTermios, Ioctl := LinIoctl;
CONST
nonblocking = FALSE;
CONST
bits4* = 0; bits5* = 1; bits6* = 2; bits7* = 3; stop15* = 4; stop2* = 5; even* = 6; odd* = 7;
inXonXoff* = 8; outXonXoff* = 9; inRTS* = 10; inDTR* = 11; outCTS* = 12; outDSR* = 13;
TYPE
Connection* = POINTER TO LIMITED RECORD
hnd: INTEGER; (* # -1: open *)
opts: SET
END;
PROCEDURE DecodeBaud (baud: INTEGER; OUT speed: Termios.speed_t);
BEGIN
IF baud = 50 THEN speed := Termios.B50
ELSIF baud = 75 THEN speed := Termios.B75
ELSIF baud = 110 THEN speed := Termios.B110
ELSIF baud = 134 THEN speed := Termios.B134
ELSIF baud = 150 THEN speed := Termios.B150
ELSIF baud = 200 THEN speed := Termios.B200
ELSIF baud = 300 THEN speed := Termios.B300
ELSIF baud = 600 THEN speed := Termios.B600
ELSIF baud = 1200 THEN speed := Termios.B1200
ELSIF baud = 1800 THEN speed := Termios.B1800
ELSIF baud = 2400 THEN speed := Termios.B2400
ELSIF baud = 4800 THEN speed := Termios.B4800
(* ELSIF baud = 7200 THEN speed := Termios.B7200 *) (* not present in Linux *)
ELSIF baud = 9600 THEN speed := Termios.B9600
(* ELSIF baud = 14400 THEN speed := Termios.B14400 *) (* not present in Linux *)
ELSIF baud = 19200 THEN speed := Termios.B19200
(* ELSIF baud = 28800 THEN speed := Termios.B28800 *) (* not present in Linux *)
ELSIF baud = 38400 THEN speed := Termios.B38400
ELSIF baud = 57600 THEN speed := Termios.B57600
(* ELSIF baud = 76800 THEN speed := Termios.B76800 *) (* not present in Linux *)
ELSIF baud = 115200 THEN speed := Termios.B115200
ELSIF baud = 230400 THEN speed := Termios.B230400
ELSE HALT(100)
END
END DecodeBaud;
PROCEDURE Open* (device: ARRAY OF CHAR; baud: INTEGER; opts: SET; OUT conn: Connection);
VAR c: Connection;
fd: INTEGER;
ss: ARRAY Libc.NAME_MAX + 1 OF SHORTCHAR;
res: INTEGER;
t: Termios.termios;
speed: Termios.speed_t;
flags: SET;
BEGIN
conn := NIL;
ASSERT(opts * {even,odd} # {even,odd}, 20);
IF bits4 IN opts THEN ASSERT(opts * {bits5,bits6,bits7} = {}, 21) END;
IF bits5 IN opts THEN ASSERT(opts * {bits4,bits6,bits7} = {}, 22) END;
IF bits6 IN opts THEN ASSERT(opts * {bits4,bits5,bits7} = {}, 23) END;
IF bits7 IN opts THEN ASSERT(opts * {bits4,bits5,bits6} = {}, 24) END;
ASSERT(opts * {stop15,stop2} # {stop15,stop2}, 25);
IF stop15 IN opts THEN ASSERT(opts * {bits4,bits5} # {}, 26) END;
IF stop2 IN opts THEN ASSERT(opts * {bits4,bits5} = {}, 27) END;
DecodeBaud(baud, speed);
ss := SHORT(device$);
flags := Libc.O_RDWR; IF nonblocking THEN flags := flags + Libc.O_NONBLOCK END;
fd := Libc.open(ss, flags, {1,4} (* 022 *));
IF fd # -1 THEN
res := Termios.tcgetattr(fd, t);
IF res = 0 THEN
t.c_iflag := Termios.IGNBRK (* ignore BREAK condition *)
+ Termios.IGNPAR (* ignore (discard) parity errors *);
IF opts * {even,odd} # {} THEN
t.c_iflag := t.c_iflag + Termios.INPCK (* enable input parity checking *)
END;
t.c_oflag := 0;
t.c_cflag := Termios.CREAD (* enable receiver *)
+ Termios.CLOCAL (* ignore modem status lines *);
IF bits4 IN opts THEN HALT(126) (* not implemented *)
ELSIF bits5 IN opts THEN t.c_cflag := t.c_cflag + Termios.CS5
ELSIF bits6 IN opts THEN t.c_cflag := t.c_cflag + Termios.CS6
ELSIF bits7 IN opts THEN t.c_cflag := t.c_cflag + Termios.CS6
ELSE t.c_cflag := t.c_cflag + Termios.CS8
END;
IF opts * {stop15,stop2} # {} THEN t.c_cflag := t.c_cflag + Termios.CSTOPB END;
IF even IN opts THEN t.c_cflag := t.c_cflag + Termios.PARENB
ELSIF odd IN opts THEN t.c_cflag := t.c_cflag + Termios.PARENB + Termios.PARODD
(* ELSE parity none *)
END;
IF outCTS IN opts THEN HALT(126) END; (* CTS out flow control *)
IF outDSR IN opts THEN HALT(126) END; (* DSR out flow control *)
IF inDTR IN opts THEN HALT(126) END; (* DTR flow control handshake *)
IF outXonXoff IN opts THEN HALT(126) END; (* Xon/Xoff out flow control *)
IF inXonXoff IN opts THEN HALT(126) END; (* Xon/Xoff in flow control *)
IF inRTS IN opts THEN HALT(126) END; (* RTS flow control handshake *)
t.c_lflag := 0;
res := Termios.cfsetispeed(t, speed);
IF res = 0 THEN
res := Termios.cfsetospeed(t, speed);
IF res = 0 THEN
res := Termios.tcsetattr(fd, Termios.TCSANOW, t);
IF res = 0 THEN
res := Termios.tcflush(fd, Termios.TCIOFLUSH);
IF res = 0 THEN
NEW(c); c.hnd := fd; c.opts := opts; conn := c
ELSE res := Libc.close(fd)
END
ELSE res := Libc.close(fd)
END
ELSE res := Libc.close(fd)
END
ELSE res := Libc.close(fd)
END
ELSE res := Libc.close(fd)
END
END
END Open;
PROCEDURE Close* (c: Connection);
VAR res: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
res := Libc.close(c.hnd);
c.hnd := -1
END Close;
PROCEDURE (c: Connection) FINALIZE-;
BEGIN
IF c.hnd # -1 THEN Close(c) END
END FINALIZE;
PROCEDURE SendByte* (c: Connection; x: BYTE);
VAR res: Libc.ssize_t;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
res := Libc.write(c.hnd, SYSTEM.ADR(x), 1);
IF ~nonblocking THEN ASSERT(res = 1, 100) END
END SendByte;
PROCEDURE SendBytes* (c: Connection; IN x: ARRAY OF BYTE; beg, len: INTEGER);
VAR res: Libc.ssize_t;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
ASSERT(LEN(x) >= beg + len, 22);
ASSERT(len > 0, 23);
res := Libc.write(c.hnd, SYSTEM.ADR(x) + beg, len);
IF ~nonblocking THEN ASSERT(res = len, 100) END
END SendBytes;
PROCEDURE Available* (c: Connection): INTEGER;
VAR res: INTEGER;
read: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
read := -1;
res := Ioctl.ioctl1(c.hnd, Ioctl.FIONREAD, read);
ASSERT(res # -1, 100);
ASSERT(read >= 0, 101);
RETURN read
END Available;
PROCEDURE ReceiveByte* (c: Connection; OUT x: BYTE);
VAR res: Libc.ssize_t;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
res := Libc.read(c.hnd, SYSTEM.ADR(x), 1);
ASSERT(res = 1, 100)
END ReceiveByte;
PROCEDURE ReceiveBytes* (c: Connection; OUT x: ARRAY OF BYTE; beg, len: INTEGER);
VAR res: Libc.ssize_t;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
ASSERT(LEN(x) >= beg + len, 22);
ASSERT(len > 0, 23);
res := Libc.read(c.hnd, SYSTEM.ADR(x) + beg, len);
ASSERT(res = len, 100)
END ReceiveBytes;
PROCEDURE SetBuffers* (c: Connection; inpBufSize, outBufSize: INTEGER);
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
(* HALT(126) *)
END SetBuffers;
PROCEDURE SetDTR* (c: Connection; on: BOOLEAN);
VAR res: INTEGER;
modembits: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
ASSERT(~(inDTR IN c.opts), 22);
res := Ioctl.ioctl1(c.hnd, Ioctl.TIOCMGET, modembits);
ASSERT(res # -1, 100);
IF on THEN
modembits := ORD(BITS(modembits) + Ioctl.TIOCM_DTR)
ELSE
modembits := ORD(BITS(modembits) - Ioctl.TIOCM_DTR)
END;
res := Ioctl.ioctl1(c.hnd, Ioctl.TIOCMSET, modembits);
ASSERT(res # -1, 101)
END SetDTR;
PROCEDURE SetRTS* (c: Connection; on: BOOLEAN);
VAR res: INTEGER;
modembits: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
ASSERT(~(inRTS IN c.opts), 22);
res := Ioctl.ioctl1(c.hnd, Ioctl.TIOCMGET, modembits);
ASSERT(res # -1, 100);
IF on THEN
modembits := ORD(BITS(modembits) + Ioctl.TIOCM_RTS)
ELSE
modembits := ORD(BITS(modembits) - Ioctl.TIOCM_RTS)
END;
res := Ioctl.ioctl1(c.hnd, Ioctl.TIOCMSET, modembits);
ASSERT(res # -1, 101)
END SetRTS;
PROCEDURE SetBreak* (c: Connection; on: BOOLEAN);
VAR res: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
IF on THEN
res := Ioctl.ioctl0(c.hnd, Ioctl.TIOCSBRK)
ELSE
res := Ioctl.ioctl0(c.hnd, Ioctl.TIOCCBRK)
END;
ASSERT(res # -1, 100)
END SetBreak;
PROCEDURE CTSState* (c: Connection): BOOLEAN;
VAR res: INTEGER;
modembits: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
res := Ioctl.ioctl1(c.hnd, Ioctl.TIOCMGET, modembits);
ASSERT(res # -1, 100);
RETURN BITS(modembits) * Ioctl.TIOCM_CTS = Ioctl.TIOCM_CTS
END CTSState;
PROCEDURE DSRState* (c: Connection): BOOLEAN;
VAR res: INTEGER;
modembits: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
res := Ioctl.ioctl1(c.hnd, Ioctl.TIOCMGET, modembits);
ASSERT(res # -1, 100);
RETURN BITS(modembits) * Ioctl.TIOCM_DSR = Ioctl.TIOCM_DSR
END DSRState;
PROCEDURE CDState* (c: Connection): BOOLEAN;
VAR res, errno: INTEGER;
modembits: INTEGER;
BEGIN
ASSERT(c # NIL, 20); ASSERT(c.hnd # -1, 21);
res := Ioctl.ioctl1(c.hnd, Ioctl.TIOCMGET, modembits);
ASSERT(res # -1, 100);
RETURN BITS(modembits) * Ioctl.TIOCM_CAR = Ioctl.TIOCM_CAR
END CDState;
END CommV24.
Ioctl:
Код:
MODULE LinIoctl ["libc.so.6"];
(*
A. V. Shiryaev, 2012.11
GNU/Linux
i386
*)
CONST
(* /usr/include/i386-linux-gnu/bits/ioctl-types.h *)
TIOCM_LE* = {0};
TIOCM_DTR* = {1};
TIOCM_RTS* = {2};
TIOCM_ST* = {3};
TIOCM_SR* = {4};
TIOCM_CTS* = {5};
TIOCM_CAR* = {6};
TIOCM_RNG* = {7};
TIOCM_DSR* = {8};
FIOCLEX* = 21585;
FIONCLEX* = 21584;
FIONREAD* = 21531;
FIONBIO* = 21537;
FIOASYNC* = 21586;
TIOCMGET* = 21525;
TIOCMSET* = 21528;
TIOCEXCL* = 21516;
TIOCNXCL* = 21517;
TIOCOUTQ* = 21521;
TIOCSBRK* = 21543;
TIOCCBRK* = 21544;
TIOCMBIS* = 21526;
TIOCMBIC* = 21527;
PROCEDURE [ccall] ioctl0* ["ioctl"] (d: INTEGER; req: INTEGER): INTEGER;
PROCEDURE [ccall] ioctl1* ["ioctl"] (d: INTEGER; req: INTEGER; VAR arg: INTEGER): INTEGER;
END LinIoctl.
Termios:
Код:
MODULE LinTermios ["libc.so.6"];
(*
A. V. Shiryaev, 2012.11
GNU/Linux
i386
*)
CONST
NCCS* = 32;
VINTR* = 0;
VQUIT* = 1;
VERASE* = 2;
VKILL* = 3;
VEOF* = 4;
VTIME* = 5;
VMIN* = 6;
VSWTC* = 7;
VSTART* = 8;
VSTOP* = 9;
VSUSP* = 10;
VEOL* = 11;
VREPRINT* = 12;
VDISCARD* = 13;
VWERASE* = 14;
VLNEXT* = 15;
VEOL2* = 16;
IGNBRK* = 1; (* {0} *)
BRKINT* = 2; (* {1} *)
IGNPAR* = 4; (* {2} *)
PARMRK* = 8; (* {3} *)
INPCK* = 16; (* {4} *)
ISTRIP* = 32; (* {5} *)
INLCR* = 64; (* {6} *)
IGNCR* = 128; (* {7} *)
ICRNL* = 256; (* {8} *)
IUCLC* = 512; (* {9} *)
IXON* = 1024; (* {10} *)
IXANY* = 2048; (* {11} *)
IXOFF* = 4096; (* {12} *)
IMAXBEL* = 8192; (* {13} *)
IUTF8* = 16384; (* {14} *)
OPOST* = 1; (* {0} *)
OLCUC* = 2; (* {1} *)
ONLCR* = 4; (* {2} *)
OCRNL* = 8; (* {3} *)
ONOCR* = 16; (* {4} *)
ONLRET* = 32; (* {5} *)
OFILL* = 64; (* {6} *)
OFDEL* = 128; (* {7} *)
VTDLY* = 16384; (* {14} *)
VT0* = 0; (* {} *)
VT1* = 16384; (* {14} *)
B0* = 0; (* {} *) (* hang up *)
B50* = 1; (* {0} *)
B75* = 2; (* {1} *)
B110* = 3; (* {0,1} *)
B134* = 4; (* {2} *)
B150* = 5; (* {0,2} *)
B200* = 6; (* {1,2} *)
B300* = 7; (* {0..2} *)
B600* = 8; (* {3} *)
B1200* = 9; (* {0,3} *)
B1800* = 10; (* {1,3} *)
B2400* = 11; (* {0,1,3} *)
B4800* = 12; (* {2,3} *)
B9600* = 13; (* {0,2,3} *)
B19200* = 14; (* {1..3} *)
B38400* = 15; (* {0..3} *)
CSIZE* = 48; (* {4,5} *)
CS5* = 0; (* {} *)
CS6* = 16; (* {4} *)
CS7* = 32; (* {5} *)
CS8* = 48; (* {4,5} *)
CSTOPB* = 64; (* {6} *)
CREAD* = 128; (* {7} *)
PARENB* = 256; (* {8} *)
PARODD* = 512; (* {9} *)
HUPCL* = 1024; (* {10} *)
CLOCAL* = 2048; (* {11} *)
B57600* = 4097; (* {0,12} *)
B115200* = 4098; (* {1,12} *)
B230400* = 4099; (* {0,1,12} *)
B460800* = 4100; (* {2,12} *)
B500000* = 4101; (* {0,2,12} *)
B576000* = 4102; (* {1,2,12} *)
B921600* = 4103; (* {0..2,12} *)
B1000000* = 4104; (* {3,12} *)
B1152000* = 4105; (* {0,3,12} *)
B1500000* = 4106; (* {1,3,12} *)
B2000000* = 4107; (* {0,1,3,12} *)
B2500000* = 4108; (* {2,3,12} *)
B3000000* = 4109; (* {0,2,3,12} *)
B3500000* = 4110; (* {1..3,12} *)
B4000000* = 4111; (* {0..3,12} *)
__MAX_BAUD* = B4000000;
ISIG* = 1; (* {0} *)
ICANON* = 2; (* {1} *)
ECHO* = 8; (* {3} *)
ECHOE* = 16; (* {4} *)
ECHOK* = 32; (* {5} *)
ECHONL* = 64; (* {6} *)
NOFLSH* = 128; (* {7} *)
TOSTOP* = 256; (* {8} *)
IEXTEN* = 32768; (* {15} *)
TCOOFF* = 0;
TCOON* = 1;
TCIOFF* = 2;
TCION* = 3;
TCIFLUSH* = 0;
TCOFLUSH* = 1;
TCIOFLUSH* = 2;
TCSANOW* = 0;
TCSADRAIN* = 1;
TCSAFLUSH* = 2;
TYPE
tcflag_t* = INTEGER; (* unsigned int *)
cc_t* = SHORTCHAR; (* unsigned char *)
speed_t* = INTEGER; (* unsigned int *)
termios* = RECORD [untagged]
c_iflag*: tcflag_t; (* input mode flags *)
c_oflag*: tcflag_t; (* output mode flags *)
c_cflag*: tcflag_t; (* control mode flags *)
c_lflag*: tcflag_t; (* local mode flags *)
c_line*: cc_t; (* line discipline *)
cc_c*: ARRAY [untagged] NCCS OF cc_t; (* control chars *)
c_ispeed*: INTEGER; (* input speed *)
c_ospeed*: INTEGER; (* output speed *)
END;
(* POSIX.1 *)
PROCEDURE [ccall] cfgetispeed* (VAR tp: termios): speed_t;
PROCEDURE [ccall] cfsetispeed* (VAR tp: termios; ispeed: speed_t): INTEGER;
PROCEDURE [ccall] cfgetospeed* (VAR tp: termios): speed_t;
PROCEDURE [ccall] cfsetospeed* (VAR tp: termios; ospeed: speed_t): INTEGER;
PROCEDURE [ccall] tcgetattr* (fd: INTEGER; VAR tp: termios): INTEGER;
PROCEDURE [ccall] tcsetattr* (fd: INTEGER; action: INTEGER; VAR tp: termios): INTEGER;
PROCEDURE [ccall] tcdrain* (fd: INTEGER): INTEGER;
PROCEDURE [ccall] tcflow* (fd: INTEGER; action: INTEGER): INTEGER;
PROCEDURE [ccall] tcflush* (fd: INTEGER; action: INTEGER): INTEGER;
PROCEDURE [ccall] tcsendbreak* (fd: INTEGER; len: INTEGER): INTEGER;
END LinTermios.
В OpenBSD работает, в Linux не проверял.