[comp.lang.pascal] TP4 Serial Communications

caasi@sdsu.UUCP (Richard Caasi) (07/21/88)

Does anyone have any code for doing serial communications I/O on an
IBM PC that works under Turbo Pascal 4.0?  I have routines that work
under Turbo Pascal 3.0 if anyone wants to convert it to TP4.0.

Send responses to sdsu@caasi.uucp

pervect@bsu-cs.UUCP (Barrett Kreiner) (07/22/88)

about the serial comm stuff..
Me too Me too!

`^ -'
 `='
|---------------------------------------------------------------------------|
|Barrett Kreiner     UUCP:  <backbones>!{iuvax,pur-ee,uunet}!bsu-cs!pervect |
|un|official archiver IBM-PC|-----------------------------------------------|
| Ball State U. Muncie, IN  | "I'll tell ya kid, the main problem with      |
|---------------------------| Pervish food is keeping the goo from crawling |
| out of the bowl while you're eating it"|  TOON: THE game for modern times |
| Disclamer: "I don't know them!  I'm a student, nobody listens to ME!"     |
|---------------------------------------------------------------------------|

tobeye@eleazar.dartmouth.edu (Anthony V. Edwards) (07/23/88)

In article <3077@sdsu.UUCP> caasi@sdsu.UUCP (Richard Caasi) writes:
>
>Does anyone have any code for doing serial communications I/O on an
>IBM PC that works under Turbo Pascal 4.0?  
>

Following is a clip of code that I got from a BBS about 4 years ago for
Turbo Pascal, V3.  I did not write it myself, but I did modify it so it
works under TP4.

Under TP3, it worked without problems (unless nothing was hooked up
to the serial port in which case it would fill about a 4K buffer and 
then lock up the computer).  I tested it briefly under TP4 and seems to
be working the same.

Tecnical note:  There are a couple routines that refer to a variable
AsyncDS.  In upgrading to TP4, I made that variable obsolete (because 
TP4 handles interrupts much more gracefully); however I have been too
lazy to trim it out of the code.  

   - Anthony


{$B+}    {Boolean complete evaluation on}
 
(**********************************************************************)
(*                     ASYNCHRONOUS I/O ROUTINES                      *)
(*                       Version 1.01, 4/8/85                         *)
(*                                                                    *)
(* The following are data definitions and procedures which perform    *)
(* I/O functions for IBM PC asynchronous communications adapters.     *)
(* Comments here and there, below, explain what's what.  Enjoy!       *)
(*                                                                    *)
(* Although these routines are set-up to support COM1 and COM2, which *)
(* may be open simultaneously if you wish, it's probably not too much *)
(* of an effort to make them support more - like in the PC/AT.  Also, *)
(* it's a trivial excercise to support up to 9600 baud - presuming    *)
(* the machine is fast enough.  You might also consider adding such   *)
(* stuff as XON/XOFF pacing, port-to-port communication, and so on.   *)
(*                                                                    *)
(* In any case, writing this took a bunch of groping around, head     *)
(* scratching, trial and error, plus cursing at IBM's inadequate and  *)
(* obscure documentation on the subject.  It's almost like they don't *)
(* want the general public to write stuff like this.  Too bad, IBM!   *)
(*                                                                    *)
(* Written and placed in the public domain by:                        *)
(*                       Glen F. Marshall                             *)
(*                       1006 Gwilym Circle                           *)
(*                       Berwyn, PA 19312                             *)
(**********************************************************************)
 
 
type
  ComPort      = (Com1,Com2);                     { Asynchronous ports }
  ComSpeed     = (LowSpeed,MedSpeed,HighSpeed);   { 300/1200/2400 baud }
  ComParity    = (NoParity,EvenParity,OddParity); { no/even/odd parity }
  ComInBuffer  = array[0..4095] of byte;          { 4K ring buffer     }
  ComOutBuffer = array[0..4095] of byte;          { 4K ring buffer     }
  ComCtlPtr    = ^ComCtlRec;                      { Ptr, port control  }
  ComCtlRec    = record
                   ComCtlSpeed:      ComSpeed;    { current baud rate  }
                   ComCtlParity:     ComParity;   { current parity     }
                   LastComIdent:     byte;        { interrupt reason   }
                   LastComLineStat:  byte;        { line status        }
                   LastComModemStat: byte;        { modem status       }
                   SavedVector:      ^byte;       { pre-open vector    }
                   InputInIx:        integer;     { ring buffer index  }
                   InputOutIx:       integer;     { ring buffer index  }
                   OutputOutIx:      integer;     { ring buffer index  }
                   OutputInIx:       integer;     { ring buffer index  }
                   InputBuffer:      ComInBuffer; { input ring buffer  }
                   OutputBuffer:     ComOutBuffer;{ output ring buffer }
                 end;
 
const
  AsyncDS:     integer = -1; { NOTE: contrary to the idea of constants,
                               but to give the interrupt handler access
                               to the ComCtl array, this constant is
                               modified.  See StoreDS. }
  ComInt:      array[Com1..Com2] of byte = ($C,$B);
  ComData      = 0;       { Communications port data xmit/recv      }
  ComEnable    = 1;       { Communications port interrupt enable    }
  ComEnableRD  = 1;       {   data received                         }
  ComEnableTX  = 2;       {   transmit register empty               }
  ComEnableLS  = 4;       {   line status                           }
  ComEnableMS  = 8;       {   modem status                          }
  ComIdent     = 2;       { Communications port interrupt identity  }
  ComIdentNot  = 1;       {   interrupt not pending                 }
  ComIdentMS   = 0;       {   modem status interrupt                }
  ComIdentTX   = 2;       {   transmit register empty               }
  ComIdentRD   = 4;       {   data received                         }
  ComIdentLS   = 6;       {   line status interrupt                 }
  ComLineCtl   = 3;       { Communications port line control        }
  ComLineInit: array[NoParity..OddParity] of byte = ($03,$1A,$0A);
  ComLineBreak = 64;      { Communications Line Send Break          }
  ComLineDLAB  = 128;     { Communications Divisor Latch Access Bit }
  ComModemCtl  = 4;       { Communications port modem control       }
  ComModemDTR  = 1;       {   data terminal ready                   }
  ComModemRTS  = 2;       {   request to send                       }
  ComModemOUT1 = 4;       {   Out 1 signal (enables ring)           }
  ComModemOUT2 = 8;       {   Out 2 signal (enables data receive)   }
  ComLineStat  = 5;       { Communications port line status         }
  ComLineOR    = 2;       {   overrun                               }
  ComLinePE    = 4;       {   parity error                          }
  ComLineFE    = 8;       {   framing error                         }
  ConLineBI    = 16;      {   break interrupt                       }
  ComLineTHRE  = 32;      {   transmit holding register empty       }
  ComModemStat = 6;       { Communications port modem status        }
  ComModemCTS  = 16;      {   clear to send                         }
  ComModemDSR  = 32;      {   data set ready                        }
  ComModemRI   = 64;      {   phone ring                            }
  ComModemCD   = 128;     {   carrier detect                        }
  ComDivLo     = 0;       { Communications port baud-rate divisor 1 }
  ComDivHi     = 1;       { Communications port baud-rate divisor 2 }
  ComBaudDiv:  array[LowSpeed..HighSpeed] of integer = (384,96,48);
  Cmd_8259     = $20;     { 8259 interrupt controller command port  }
  EOI_8259     = $20;     {   "End Of Interrupt" command            }
  RIL_8259     = $0B;     {   "Report Interrupt Level" command      }
  Msk_8259     = $21;     { 8259 interrupt controller mask port     }
  MskVal_8259: array[Com1..Com2] of byte = ($EF,$F7);
 
var
  ComBase: array[Com1..Com2] of integer absolute $0040:0000;
  ComPtr:  array[Com1..Com2] of ComCtlPtr; { for each comm port }
 
{ This is called to modify AsyncDS }
procedure StoreDS(var SavedDS: integer);
  begin
    savedDS := DSEG;
  end;
 
{ This turns the communications interrupts on or off }
procedure Set_8259(ComDev: ComPort; Sw: boolean);
  begin
    inline($FA); {stop interrupts while we do this}
    case Sw of
      true:  port[Msk_8259] :=
                 port[Msk_8259] and MskVal_8259[ComDev];
      false: port[Msk_8259] :=
                 port[Msk_8259] or ($FF xor MskVal_8259[ComDev]);
    end;
    inline($FB); {reenable interrupts}
  end {Set_8259};
 
{ Communications interrupt handler: do NOT call this! }
procedure AsyncInterrupt;
  interrupt;
  var
    pushes: array[1..8] of integer; {allows for inline pushes}
    ComDev: ComPort;
  begin
    port[Cmd_8259] := RIL_8259; { find out which COM port interrupted }
    if (port[Cmd_8259] and ($FF xor MskVal_8259[Com1])) <> 0
      then ComDev := Com1
      else ComDev := Com2;
    with ComPtr[ComDev]^ do { Having deduced the port, find out why }
    begin
      LastComIdent := Port[ComBase[ComDev]+ComIdent];
      if (LastComIdent and ComIdentNot) = 0 then { There is a reason }
      begin
        case LastComIdent of
          ComIdentLS: LastComLineStat :=
                        port[ComBase[ComDev]+ComLineStat];
          ComIdentMS: LastComModemStat :=
                        port[ComBase[ComDev]+ComModemStat];
          ComIdentRD: begin
                        if ((InputInIx+1) mod sizeof(InputBuffer))
                        <> InputOutIx then
                        begin { store input character in ring buffer }
                          InputBuffer[InputInIx] :=
                            port[ComBase[ComDev]+ComData];
                          InputInIx :=
                            (InputInIx+1) mod sizeof(InputBuffer);
                        end
                        else LastComLineStat := { buffer overrun }
                               LastComLineStat or ComLineOR;
                      end;
          ComIdentTX: if OutputOutIx <> OutputInIx then
                      begin { write output character from ring buffer }
                        port[ComBase[ComDev]+ComData] :=
                          OutputBuffer[OutputOutIx];
                        OutputOutIx :=
                          (OutputOutIx+1) mod sizeof(OutputBuffer);
                      end;
        end;
      end;
    end;
    port[Cmd_8259] := EOI_8259;
  end {AsyncInterrupt};
 
{ This modifies the communications interrupt vector }
procedure SetInterrupt(ComDev: ComPort; Sw: boolean);
  var
    MsDosRegs: record
                 AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: integer;
{! 5. Instead use the Registers type from the Turbo 4.0 DOS unit.  ^ }
               end;
  begin
    inline($FA); {stop interrupts while we do this}
    with MsDosRegs, ComPtr[ComDev]^ do
    begin
      case Sw of
        true:  begin
                 AX := $3500+ComInt[ComDev]; { get interrupt vector}
                 MsDos(Dos.Registers(MsDosRegs));
{! 7. Parameter to MsDo^s must be of the type Registers defined in DOS unit.}
                 SavedVector := Ptr(ES,BX);
                 DS := CSEG;
{! 8. Assure that Cseg ^refers to the intended segment.}
                 DX := ofs(AsyncInterrupt);
               end;
        false: begin
                 DS := seg(SavedVector^);
                 DX := ofs(SavedVector^);
               end;
      end;
      AX := $2500+ComInt[ComDev]; { set interrupt vector }
      MsDos(Dos.Registers(MsDosRegs))
    end;
    inline($FB); {reenable interrupts}
  end {SetInterrupt};
 
{ This sets the communications baud rate }
procedure SetSpeed(ComDev: ComPort; ComRate: ComSpeed);
  begin
    inline($FA); {stop interrupts while we do this}
    with ComPtr[ComDev]^ do ComCtlSpeed  := ComRate;
    port[ComBase[ComDev]+ComLineCtl] :=
      port[ComBase[ComDev]+ComLineCtl] or ComLineDLAB;
    port[ComBase[ComDev]+ComDivLo] := lo(ComBaudDiv[ComRate]);
    port[ComBase[ComDev]+ComDivHi] := hi(ComBaudDiv[ComRate]);
    port[ComBase[ComDev]+ComLineCtl] :=
      port[ComBase[ComDev]+ComLineCtl] and ($FF xor ComLineDLAB);
    inline($FB); {reenable interrupts}
  end {SetSpeed};
 
{ This modifies the line control register for parity & data bits }
procedure SetFormat(ComDev: ComPort; ComFormat: ComParity);
  begin
    inline($FA); {stop interrupts while we do this}
    with ComPtr[ComDev]^ do ComCtlParity := ComFormat;
    port[ComBase[ComDev]+ComLineCtl] := ComLineInit[ComFormat];
    inline($FB); {reenable interrupts}
  end {SetFormat};
 
{ This modifies the modem control register for DTR, RTS, etc. }
procedure SetModem(ComDev: ComPort; ModemCtl: byte);
  begin
    inline($FA); {stop interrupts while we do this}
    port[ComBase[ComDev]+ComModemCtl] := ModemCtl;
    inline($FB); {reenable interrupts}
  end {SetModem};
 
{ This modifies the communications interrupt enable register }
procedure SetEnable(ComDev: ComPort; Enable: byte);
  begin
    inline($FA); {stop interrupts while we do this}
    port[ComBase[ComDev]+ComEnable] := Enable;
    inline($FB); {reenable interrupts}
  end {SetModem};
 
{ This procedure MUST be called before doing any I/O. }
procedure ComOpen(ComDev: ComPort;
                  ComRate: ComSpeed; ComFormat: ComParity);
  begin
    Set_8259(ComDev,false);
    StoreDS(AsyncDS);
    new(ComPtr[ComDev]);
    with ComPtr[ComDev]^ do
    begin
      LastComIdent := 1;
      InputInIx    := 0;
      InputOutIx   := 0;
      OutputOutIx  := 0;
      OutputInIx   := 0;
    end;
    SetInterrupt(ComDev,true);
    Set_8259(ComDev,true);
    SetEnable(ComDev, ComEnableRD+ComEnableTX+ComEnableLS+ComEnableMS);
    SetModem(ComDev, ComModemDTR+ComModemRTS+ComModemOUT1+ComModemOUT2);
    SetSpeed(ComDev, ComRate);
    SetFormat(ComDev, ComFormat);
    with ComPtr[ComDev]^ do
    begin
      LastComLineStat  := port[ComBase[ComDev]+ComLineStat];
      LastComModemStat := port[ComBase[ComDev]+ComModemStat];
    end;
  end {ComOpen};
 
{ This procedure shuts-down communications }
procedure ComClose(ComDev: ComPort);
  begin
    Set_8259(ComDev,false);
    SetEnable(ComDev, $00);
    SetInterrupt(ComDev, false);
    SetModem(ComDev, $00);
    port[ComBase[ComDev]+ComLineCtl] := $00;
    dispose(ComPtr[ComDev]);
  end {ComClose};
 
{ This procedure tells you if there's any input }
function ComInReady(ComDev: ComPort): boolean;
  begin
    with ComPtr[ComDev]^ do ComInReady := InputInIx <> InputOutIx;
  end {ComInReady};
 
{ This procedure reads input from the ring buffer }
function ComIn(ComDev: ComPort): char;
  begin
    with ComPtr[ComDev]^ do
    begin
      repeat until ComInReady(ComDev);
      ComIn := chr(InputBuffer[InputOutIx]);
      InputOutIx := (InputOutIx+1) mod sizeof(InputBuffer);
    end;
  end {ComIn};
 
{ This procedure writes output, filling the ring buffer if necessary. }
procedure ComOut(ComDev: ComPort; Data: char);
  begin
    with ComPtr[ComDev]^ do
    begin
      if ((port[ComBase[ComDev]+ComLineStat] and ComLineTHRE) <> 0) and
         (OutputInIx = OutputOutIx) then
      begin
        port[ComBase[ComDev]+ComData] := ord(Data);
      end
      else
      begin
        repeat
        until ((OutputInIx+1) mod sizeof(outputBuffer)) <> OutputOutIx;
        OutputBuffer[OutputInIx] := ord(Data);
        OutputInIx := (OutputInIx+1) mod sizeof(OutputBuffer);
      end;
    end;
  end {ComOut};