[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

    PROGRAM ComChk;

    USES Crt;

      FUNCTION HexWord(a : Word) : String;
      CONST
        Digit          : ARRAY[$0..$F] OF Char = '0123456789ABCDEF';
      VAR
        I              : Byte;
        HexStr         : String;

      BEGIN
        HexStr := '';
        FOR I := 1 TO 4 DO
        BEGIN
          Insert(Digit[a AND $000F], HexStr, 1);
          a := a SHR 4
        END;
        HexWord := HexStr;
      END;                            {hex}

    PROCEDURE UncodePort(NR : integer);
      VAR
        B, M, V1, V2, TLRC, D, MSB, LSB : integer;
        S, CO : integer;
        Baud : real;
        Answer : string[10];
        ComList : array[1..4] OF word ABSOLUTE $0000:$0400;
      BEGIN
        CO := ComList[NR];
        WriteLn;
        WriteLn ('Communications Port ', NR, ':');
        IF CO = 0 THEN
          BEGIN
            WriteLn ('  Not installed.');
            Exit;
          END;

        S := Port[CO + 3];
        TLRC := Port[CO + 3];
        Port[CO + 3] := TLRC OR $80;
        LSB := Port[CO];
        MSB := Port[CO + 1];
        D := 256 * MSB + LSB;
        Baud := 115200.0 / D;
        Port[CO + 3] := TLRC AND $7F;

        {Display port address}
        WriteLn ('  Port address: ', HexWord (ComList[NR]));

        {Display baud rate}
        WriteLn ('     Baud rate: ', Baud:5:0);

        {Display data bits}
        IF (S AND 3) = 3 THEN
          B := 8
        ELSE IF (S AND 2) = 2 THEN
          B := 7
        ELSE IF (S AND 1) = 1 THEN
          B := 6
        ELSE
          B := 5;
        WriteLn ('     Data bits: ', B:5);

        {Display stop bits}
        IF (S AND 4) = 4 THEN
          B := 2
        ELSE
          B := 1;
        WriteLn ('     Stop bits: ', B:5);

        IF (S AND 24) = 24 THEN
          Answer := 'Even'
        ELSE IF (S AND 8) = 8 THEN
          Answer := 'Odd'
        ELSE
          Answer := 'None';
        WriteLn ('        Parity: ', Answer:5);
      END; {procedure Uncode_Setup_Of_Port}

    BEGIN
      ClrScr;
      WriteLn ('Communications Port Status--------------------------');
      UncodePort (1);
      UncodePort (2);
      UncodePort (3);
      UncodePort (4);
    END.

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]