OberonCore

Библиотека  Wiki  Форум  BlackBox  Компоненты  Проекты
Текущее время: Четверг, 28 Март, 2024 23:01

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ 1 сообщение ] 
Автор Сообщение
 Заголовок сообщения: CommV24
СообщениеДобавлено: Понедельник, 12 Ноябрь, 2012 22:44 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
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 не проверял.


Вернуться к началу
 Профиль  
 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ 1 сообщение ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Вся информация, размещаемая участниками на конференции (тексты сообщений, вложения и пр.) © 2005-2024, участники конференции «OberonCore», если специально не оговорено иное.
Администрация не несет ответственности за мнения, стиль и достоверность высказываний участников, равно как и за безопасность материалов, предоставляемых участниками во вложениях.
Без разрешения участников и ссылки на конференцию «OberonCore» любое воспроизведение и/или копирование высказываний полностью и/или по частям запрещено.
Powered by phpBB® Forum Software © phpBB Group
Русская поддержка phpBB