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

    {
    >     Ok... I have fifty million different modem units, sources, docs
    > I have not been able to get any where with any of them....  All i want

    I remember being in your shoes a long time ago, my friend.  I haven't
    a Unit, per se, but here is _WORKING_ Pascal source (excuse the
    documentation style, I originally wrote the code in C) that compiles under
    TP 6.0.

      Written by Dave Jarvis.

      The purpose of this program is to do a simple communications protocol and
      demonstrate how Serial communications can be Serially driven.
    }

    USES DOS, Crt;

    CONST
      COM1      = $3F8;    { Communications port 1 address.     }
      COM2      = $2F8;    { Communications port 2 address.     }
      THR       = $00;     { Transmitter holding register.      }
      RDR       = $00;     { Receiver data register.            }
      BRDL      = $00;     { Baud rate low divisor register.    }
      BRDH      = $01;     { Baud rate high divisor register.   }
      IER       = $01;     { Interrupt enable register.         }
      IIR       = $02;     { Interrupt identIFication register. }
      LCR       = $03;     { Line control register.             }
      MCR       = $04;     { Modem control register.            }
      LSR       = $05;     { Line status register.              }
      MSR       = $06;     { Modem status register.             }

      SET_BAUD  = $80;     { DLAB.                              }
      CTS_DSR   = $30;     { Check for DSR and CTS in MSR.      }
      THREMPTY  = $20;     { Check for THR empty in LSR.        }

      WORD7      = $02;    { Bits 0 and 1 when setting LCR.     }
      WORD8      = $03;
      BIT1       = $00;    { Bit 3 when setting LCR.            }
      BIT2       = $04;
      NONE       = $00;    { Bits 4, 5, and 6 when setting LCR. }
      EVEN       = $30;
      ODD        = $20;

      INT_ENABL  = $0B;    { Tell UART to perform interrupts.   }
      PIC        = $20;    { Address of PIC.                    }
      PIC_CNTL   = $21;    { Address of PIC control register.   }
      IRQ4_MASK  = $EF;    { Mask for IRQ4.                     }
      COM_INT    = $0C;    { Communications interrupt to tap.   }
      EOI        = $20;    { End of interrupt signal for PIC.   }
      DATA_REC   = $01;    { Interrupt on data received.        }
      WRITE_CH   = $0E;    { Write character function.          }

      XON_CH     = #$11;   { XON protocol control character.    }
      XOFF_CH    = #$13;   { XOFF protocol control character.   }
      EOT        = #$04;   { End of transmission character.     }

      MAX_BUFF   = 256;     { Maximum characters in the buffer.  }
      BUFF_FULL  = 0.75;    { Buffer full @ 75% of MAX_BUFF.     }
      BUFF_EMPT  = 0.50;    { Buffer empty @ 50% of MAX_BUFF.    }

      ERR        = -1;

    TYPE
      RecLinkPtr = ^Receive;

      Receive = RECORD
                  rec_char : CHAR;
                  Next     : RecLinkPtr;
                End;

    VAR
      rec_buff,                  { Global linked list. }
      to_write   : RecLinkPtr;
      buff_Count : INTEGER;      { Number of characters in buffer.    }
      xon        : BOOLEAN;      { Enable send ability.               }

    PROCEDURE ShowUsage;
    Begin
       WriteLn( 'Usage : TERMINAL <baud> <parity> <data bits> <stop bits>' );
       WriteLn( 'Where : <baud> is any of 300, 1200, 2400, 9600;' );
       WriteLn( '        <parity> is any of N, O, E;' );
       WriteLn( '        <data bits> is either 7 or 8;' );
       WriteLn( '        <stop bits> is either 1 or 2.' );

       Halt( 0 );

    End;

    PROCEDURE setup( baud, parity, data_bits, stop_bits : INTEGER );
    VAR
      setup : INTEGER;

    Begin
      setup := parity;

      { Set DLAB such that baud rate can be changed/set. }
      Port[ COM1 + LCR ] := SET_BAUD;

      CASE baud OF
         300 : Begin
                 Port[ COM1 + BRDL ] := $80;
                 Port[ COM1 + BRDH ] := $01;
               End;
        1200 : Begin
                 Port[ COM1 + BRDL ] := $60;
                 Port[ COM1 + BRDH ] := $00;
               End;
        2400 : Begin
                 Port[ COM1 + BRDL ] := $30;
                 Port[ COM1 + BRDH ] := $00;
               End;
        9600 : Begin
                 Port[ COM1 + BRDL ] := $0C;
                 Port[ COM1 + BRDH ] := $00;
               End;
        ELSE
          ShowUsage;
      End;

      CASE data_bits OF
        7  : setup := setup OR WORD7;
        8  : setup := setup OR WORD8;
        ELSE
          ShowUsage;
      End;

      CASE stop_bits OF
        1  : setup := setup OR BIT1;
        2  : setup := setup OR BIT2;
        ELSE
          ShowUsage;
      End;

      { Send final (calculated) setup Value to the communications port. }
      Port[ COM1 + LCR ] := setup;
    End;

    PROCEDURE add_char( ch : CHAR );
    Begin
      { IF the buffer is full, then sound the speaker twice -- toss char. }
      IF( buff_Count = MAX_BUFF ) THEN
      Begin
        Sound( 1000 );
        Sound( 900 );
        NoSound;

        Exit;
      End;

      { Store character in buffer. }
      rec_buff^.rec_char := ch;

      { Point to next storage position. }
      rec_buff := rec_buff^.next;

      { Increment number of characters in buffer. }
      INC( buff_Count );
    End;

    {$F+}
    PROCEDURE receive_ch; INTERRUPT;
    VAR
      ch : CHAR;

    Begin
      ch := CHAR(Port[ COM1 + RDR ]);

      IF( ch = XON_CH ) THEN
        xon := TRUE
      ELSE IF( ch = XOFF_CH ) THEN
        xon := FALSE
      ELSE
        add_char( CHAR(ch) );

      { Send End of interrupt signal to PIC chip. }
      Port[ PIC ] := EOI;
    End;
    {$F-}

    PROCEDURE xmit( ch : CHAR );
    Begin
      Port[ COM1 + THR ] := INTEGER(ch);
    End;

    FUNCTION can_xmit : BOOLEAN;
    Begin
      {  IF input characters can be sent, and the DSR, CTS and THREMPTY are
         all set high, then the character read from keyboard can be sent.
      }
      IF( xon AND ((Port[ COM1 + MSR ] AND CTS_DSR)  = CTS_DSR) AND
                 ((Port[ COM1 + LSR ] AND THREMPTY) = THREMPTY) ) THEN
        can_xmit := TRUE
      ELSE
        can_xmit := FALSE;

    End;

    PROCEDURE writech;
    Begin
      Write( to_write^.rec_char );

      { Decrement the number of actual elements in the buffer. }
      DEC( buff_Count );

      { Point to the next character to write (IF any are left). }
      to_write := to_write^.next;
    End;

    PROCEDURE send_string( s : STRING );
    VAR
      Count : INTEGER;

    Begin
      FOR Count := 1 TO Length( S ) DO
      Begin
        WHILE( NOT can_xmit ) DO
          ;

        xmit( s[ Count ] );
      End;
    End;

    PROCEDURE Serial;
    VAR
      ch       : CHAR;       { Character read from the keyboard.    }
      done,                  { Loop until done = TRUE.              }
      send_xon : BOOLEAN;    { TRUE IF XON character has been sent. }

    Begin
      done     := FALSE;
      send_xon := TRUE;

      Repeat
        {  IF a character is in the keyboard buffer, and it can be sent to the
           UART, then read it from the keyboard buffer, and transmit it.
        }
        IF( can_xmit AND KeyPressed ) THEN
        Begin
          ch := ReadKey;

          IF( ch = EOT ) THEN
            done := TRUE
          ELSE
            xmit( ch );
        End;

        IF( buff_Count > 0 ) THEN
        Begin
          { Display a character from the buffer. }
          writech;

          { IF the buffer is more than 75% full, then send XOFF char ASAP. }
          IF( (buff_Count / (MAX_BUFF * 1.0)) > BUFF_FULL ) THEN
          Begin
            { Wait until a character can be sent. }
            WHILE( NOT can_xmit ) DO
              ;

            { Send the XOFF control code. }
            xmit( XOFF_CH );

            { Indicate that an XON can be sent anytime. }
            send_xon := FALSE;
          End;

          { IF the buffer is less than 50% full, then send XON char ASAP. }
          IF( ((buff_Count / (MAX_BUFF * 1.0)) < BUFF_EMPT) AND
               (NOT send_xon) ) THEN
          Begin
            { Wait until a character can be sent. }
            WHILE( NOT can_xmit ) DO
              ;

            { Send the XON control code. }
            xmit( XON_CH );

            { An XON control code has been sent. }
            send_xon := TRUE;
          End;
        End;
      Until( done );
    End;

    FUNCTION Value( NumS : STRING ) : LONGINT;
    VAR
      O, M, S, C : LONGINT;

    Begin
      S := 0;
      M := 1;

      FOR C := Length(NumS) DOWNTO 1 DO
      Begin
        O := Ord( NumS[C] );

        IF NumS[C] IN ['0'..'9'] THEN
        Begin
          INC( S, M * (O - 48) );
          M := M * 10;
        End;
      End;

      Value := S;
    End;

    FUNCTION UCase( S : STRING ) : STRING;
    VAR
      C : BYTE;

    Begin
      FOR C := 1 TO Length(S) DO
        S[C] := UpCase( S[C] );

      UCase := S;
    End;

    VAR
      Count,                { Simple Counter.                    }
      baud,                 { Baud rate.                         }
      parity,               { Parity    - NONE, EVEN, ODD.       }
      data_bits,            { Data bits - 7, 8.                  }
      stop_bits  : INTEGER; { Stop bits - 1, 2.                  }
      temp,
      current    : RecLinkPtr;
      SecParam   : STRING;
      save_int   : POINTER;

    Begin
      buff_Count := 0;
      xon        := TRUE;

      { 4 command line arguments (include program name) are required. }
      IF( ParamCount <> 4 ) THEN
        ShowUsage;

      { The first command line argument is specified to be the baud rate. }
      baud := Value( ParamStr( 1 ) );

      { Convert second argument to upper case so first letter can be checked
        for parity. }
      SecParam := ParamStr( 2 );
      SecParam := UCase( SecParam );

      { Check first character of 2nd command line parameter for parity. }
      CASE SecParam[1] OF
        'N' : parity := NONE;
        'O' : parity := ODD;
        'E' : parity := EVEN;
      ELSE
        ShowUsage;
      End;

      rec_buff := NIL;
      {  Allocate enough memory for MAX_BUFF characters (New is not re-entrant).
      }
      FOR Count := 0 TO MAX_BUFF - 1 DO
      Begin
        New( temp );

        temp^.next     := NIL;
        temp^.rec_char := #0;

        IF( rec_buff = NIL ) THEN
          rec_buff := temp
        ELSE
        Begin
          current := rec_buff;

          WHILE( current^.next <> NIL ) DO
            current := current^.next;

          current^.next := temp;
        End;
      End;

      {  Create a circular buffer by pointing the last element in the list to
         the start (head) of the list.
      }
      temp^.next := rec_buff;

      { Point to the first character to write within the buffer. }
      to_write := rec_buff;

      data_bits := Value( ParamStr( 3 ) );

      stop_bits := Value( ParamStr( 4 ) );

      getintvec( COM_INT, save_int );

      { Set vector = $0C to new interrupt routine. }
      SetIntVec( COM_INT, Addr( receive_ch ) );

      { Initialize the modem according to the command line parameters. }
      setup( baud, parity, data_bits, stop_bits );

      { Interrupt on received character. }
      Port[ COM1 + IER ] := DATA_REC;

      { Enable interrupts }
      Port[ COM1 + MCR ] := INT_ENABL;

      { Set PIC control register to enable IRQ4. }
      Port[ PIC_CNTL ] := Port[ PIC_CNTL ] AND IRQ4_MASK;

      { Set MSR such that CTS and DSR are high. }
      Port[ COM1 + MSR ] := CTS_DSR;

      ClrScr;
      WriteLn( 'Type Control-D at any time to quit.' );

      { Repeat Serial communications. }
      Serial;

      { Disable interrupts }
      Port[ COM1 + IER ] := 0;

      { Set PIC control register to disable IRQ4. }
      Port[ PIC_CNTL ] := Port[ PIC_CNTL ] AND (NOT IRQ4_MASK);

      { Set vector = $0C to old interrupt routine. }
      SetIntVec( COM_INT, save_int );

      { Deallocate all the memory used in the buffer. }
      FOR Count := 0 TO MAX_BUFF - 1 DO
      Begin
        temp     := rec_buff;
        rec_buff := rec_buff^.next;

        Dispose( temp );
      End;
    End.

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