PROGRAM setup(cmd, output);
(* BYERSX auxiliary.  Control/display baud, parity, stops *)
(* Usage:                                                 *)
(*       d>setup [? | [nnnn] [odd|even|no [s]] ]          *)
(* where nnnn is one of 110, 300, 600, 1200,2400, 4800,   *)
(*   9600, 19200, and (optional) odd|even|no sets the     *)
(* communication parity/word length.  s is the stop bits  *)
(* setting of 1, 1.5, or 2.  Omitted fields are unchanged *)
(*       d>setup                                          *)
(* displays present settings and gives a short help msg.  *)
(*       d>setup ?                                        *)
(* displays present settings                              *)
(*                                                        *)
(* Copyright (c) 1985 by C.B. Falconer, Hamden, Conn.     *)
(* all rights reserved.                                   *)
(* released for non-profit use.  This program may not be  *)
(* sold or incorporated in products for sale without the  *)
(* express written permission of C.B. Falconer.  It may   *)
(* be copied and distributed without charge.              *)
(*                                                        *)
(* 1.1  85/12/4  Corrected report order to match input.   *)
(* 1.0  85/12/4  Original version                         *)

(*$n-,d- no line numbers nor range checks *)

  CONST
    ver       = 'SETUP v1.1 (c) 1985 by C.B. Falconer, for BYERSX';
    rsxmast   = 87;      (* byersx system calls *)
    sgbaud    = 86;

  TYPE
    anerror   = (norsx, badbaud, badstops);

  VAR
    cmd       : text;    (* default input command line *)

  (* 1---------------1 *)

  PROCEDURE displaysettings;

    VAR
      baud,
      stops,
      parity,
      settings     : integer;

    (* 2---------------2 *)

    PROCEDURE unknown;  (* for easy change of unknown display *)

      BEGIN (* unknown *)
      write('UNKNOWN');
      END; (* unknown *)

    (* 2---------------2 *)

    BEGIN (* displaysettings *)
    settings := syscall(sgbaud, 0); (* get present settings *)
    baud := mask(settings, 15);
    stops := mask(lsr(settings, 6), 3);
    parity := mask(lsr(settings, 4), 3);
    CASE baud OF
1:    baud := 110;
2:    baud := 300;
3:    baud := 450;
4:    baud := 600;
5:    baud := 710;
6:    baud := 1200;
7:    baud := 2400;
8:    baud := 4800;
9:    baud := 9600;
10:   baud := 19200;
(*$s-*)
    OTHERWISE baud := 0; END; (* case *)
(*$s+*)
    IF baud = 0 THEN unknown
    ELSE write(baud : 1);
    write(' baud, ');
    IF      parity = 1 THEN write('NO')
    ELSE IF parity = 2 THEN write('ODD')
    ELSE IF parity = 3 THEN write('EVEN')
    ELSE unknown;
    write(' parity, ');
    IF      stops = 1 THEN write('1')
    ELSE IF stops = 2 THEN write('1.5')
    ELSE IF stops = 3 THEN write('2')
    ELSE unknown;
    writeln(' stop bit(s)');
    END; (* displaysettings *)

  (* 1---------------1 *)

  PROCEDURE help;

    BEGIN (* help *)
    writeln(ver);
    writeln;
    writeln('Usage: SETUP [nnn][odd|even|no][ s]');
    writeln(' where nnn is baud rate desired (110, 300, etc)');
    writeln(' and the (optional) odd|even|no sets parity');
    writeln(' no parity uses 8 bit chars, otherwise 7 bits');
    writeln(' s may be 1, 1.5, or 2 and sets stop bits');
    writeln(' Stop bits setting requires parity or baud setting');
    writeln('ex: d>SETUP 2400 no 1');
    writeln('    d>SETUP ?       displays current settings');
    writeln;
    displaysettings;
    END; (* help *)

  (* 1---------------1 *)

  PROCEDURE skipblanks(VAR f : text); (* and redirection areas *)

    BEGIN (* skipblanks *)
    REPEAT
      WHILE NOT eoln(cmd) AND (cmd^ = ' ') DO get(cmd);
      IF cmd^ IN ['<', '>'] THEN
        WHILE cmd^ <> ' ' DO get(cmd);
    UNTIL eoln(cmd) OR (cmd^ <> ' ');
    END; (* skipblanks *)

  (* 1---------------1 *)

  PROCEDURE upshift(VAR ch : char);

    BEGIN (* upshift *)
    IF ch IN ['a'..'z'] THEN ch := chr(ord(ch) - 32);
    END; (* upshift *)

  (* 1---------------1 *)

  PROCEDURE error(x : anerror);

    BEGIN (* error *)
    write(chr(7), '*** ERROR *** Invalid ');
    IF x = norsx THEN write('while BYERSX not running')
    ELSE IF x = badbaud THEN write('baud rate')
    ELSE write('stop bits');
    writeln; writeln; help; terminate;
    END; (* error *)

  (* 1---------------1 *)

  PROCEDURE altersettings;

    VAR
      baud,
      stops,
      parity    : integer;

    (* 2---------------2 *)

    PROCEDURE getbaud;

      VAR
        b        : integer;

       BEGIN (* getbaud *)
       read(cmd, b); skipblanks(cmd);
       IF      b = 110   THEN baud := 1
       ELSE IF b = 300   THEN baud := 2
       ELSE IF b = 450   THEN baud := 3
       ELSE IF b = 600   THEN baud := 4
       ELSE IF b = 710   THEN baud := 5
       ELSE IF b = 1200  THEN baud := 6
       ELSE IF b = 2400  THEN baud := 7
       ELSE IF b = 4800  THEN baud := 8
       ELSE IF b = 9600  THEN baud := 9
       ELSE IF b = 19200 THEN baud := 10
       ELSE error(badbaud);
       END; (* getbaud *)

    (* 2---------------2 *)

    PROCEDURE getparity;

      BEGIN (* getparity *)
      IF cmd^ = 'N' THEN parity := 1
      ELSE IF cmd^ = 'O' THEN parity := 2
      ELSE parity := 3;
      WHILE cmd^ <> ' ' DO get(cmd);
      skipblanks(cmd);
      END; (* getparity *)

    (* 2---------------2 *)

    PROCEDURE getstops;

      BEGIN (* getstops *)
      IF cmd^ = '2' THEN BEGIN
        stops := 3; get(cmd); END
      ELSE IF cmd^ = '1' THEN BEGIN
        stops := 1; get(cmd);
        IF cmd^ = '.' THEN BEGIN
          get(cmd);
          IF cmd^ = '5' THEN BEGIN
            stops := 2; get(cmd); END;
          END;
        END;
      IF cmd^ <> ' ' THEN error(badstops); (* allows for eoln *)
      END; (* getstops *)

    (* 2---------------2 *)

    PROCEDURE revisettings;

      VAR
        b       : integer;      (* encoded command *)

      BEGIN (* revisettings *)
      b := syscall(sgbaud, 0);      (* present settings *)
      IF baud <> 0 THEN b := mask(b, 256 - 16) + baud;
      IF parity <> 0 THEN b := mask(b, 256 - 64 + 15) + lsl(parity, 4);
      IF stops <> 0 THEN b := mask(b, 63) + lsl(stops, 6);
      b := syscall(sgbaud, b);      (* update the system *)
      END; (* revisettings *)

    (* 2---------------2 *)

    BEGIN (* altersettings *)
    baud := 0; stops := 0; parity := 0;  (* default unchanged *)
    IF cmd^ IN ['0'..'9'] THEN getbaud;
    upshift(cmd^);
    IF cmd^ IN ['O', 'E', 'N'] THEN getparity;
    IF cmd^ IN ['0'..'9'] THEN getstops;
    skipblanks(cmd);
    IF cmd^ <> ' ' THEN BEGIN
      write('Ignoring "');
      WHILE NOT eoln(cmd) DO BEGIN
        write(cmd^); get(cmd); END;
      writeln('"'); END;
    revisettings; displaysettings;
    END; (* altersettings *)

  (* 1---------------1 *)

  BEGIN (* setup *)
  IF syscall(rsxmast, 0) = 0 THEN error(norsx)
  ELSE BEGIN
    reset(cmd);
    skipblanks(cmd); upshift(cmd^);
    IF cmd^ = '?' THEN displaysettings
    ELSE IF (cmd^ IN ['0'..'9', 'O', 'E', 'N']) THEN altersettings
    ELSE help; END;
  END. (* setup *)