Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPTOOL3.ZIP/IBMCOM2.INC

Text File | 1987-03-28 | 5.3 KB | 253 lines

const ibmcom2_tag: string[90]
   = #0'@(#)CURRENT_FILE LAST_UPDATE COM port interrupt library 1.0'#0;
#log COM port interrupt library 1.0

(*
 * package summary:
 *
 *    procedure ComLowerDtr;
 *    procedure ComRaiseDtr;
 *    function ComCarrierPresent: Boolean;
 *    function ComRxChars: Integer;
 *    procedure ComSetParams (Parity: Byte);
 *                     ComEven, ComOdd, ComNone, ComMark, ComSpace
 *    procedure ComSetSpeed (Rate: Integer);
 *    procedure ComFlushRx;
 *    procedure ComInstall (PortNum: Byte);
 *    procedure ComRemove;
 *    procedure ComTx (S: ComString);
 *    procedure ComRx (var Ch: Char);
 *
 *)

const
  ComRxQueueSize = 1000;

var
  ComRxQueue     : Array [1..ComRxQueueSize] of Byte;
  ComRxQueueIn   : Integer;
  ComRxQueueOut  : Integer;
  ComRxQueueChars: Integer;

const
  ComDsSav: Integer = 0;

var
  ComOldVecSeg: Integer;
  ComOldvecOfs: Integer;
  ComBase     : Integer;
  ComInt      : Byte;
  Com_8259bit : Byte;

var
  ComRegw: record
    ax, bx, cx, dx, bp, si, di, ds, es, flags: Integer
  end;

type
  ComRegbyte = record
    al, ah, bl, bh, cl, ch, dl, dh: Byte
  end;

var
  ComRegb: ComRegbyte absolute ComRegw;

const
  ComEven = $1a;
  ComOdd  = $0a;
  ComNone = $03;
  ComMark = $2a;
  ComSpace= $3a;

type
  ComString = string[255];


procedure ComLowerDtr;
begin
  Port [ComBase + 4] := Port [ComBase + 4] and not 1
end;

procedure ComRaiseDtr;
begin
  Port [ComBase + 4] := Port [ComBase + 4] or 1
end;

function ComCarrierPresent: Boolean;
begin
  ComCarrierPresent := Odd (Port [ComBase + 6] shr 7)
end;

function ComRxChars: Integer;
begin
  ComRxChars := ComRxQueueChars
end;

procedure ComSetParams (Parity: Byte);
begin
  InLine ($fa);
  Port [ComBase + 3] := Port [ComBase + 3] and $bf or Parity;
  InLine ($fb)
end;

procedure ComSetSpeed (Rate: Integer);
var
  Divisor: Integer;
begin
  Divisor := Round (115200. / Rate);
  Inline ($fa);
  Port [ComBase + 3] := Port [ComBase + 3] or $80;
  Port [ComBase] := Lo (Divisor);
  Port [ComBase + 1] := Hi (Divisor);
  Port [ComBase + 3] := Port [ComBase + 3] and not $80;
  Inline ($fb)
end;

procedure ComFlushRx;
begin
  InLine ($fa);
  ComRxQueueIn    := 1;
  ComRxQueueOut   := 1;
  ComRxQueueChars := 0;
  InLine ($fb)
end;

procedure ComInterruptDriver;
var
  Data: Byte;
begin
  InLine
   ($50/          {Push ax      }
    $53/          {Push bx      }
    $51/          {Push cx      }
    $52/          {Push dx      }
    $57/          {Push di      }
    $56/          {Push si      }
    $06/          {Push es      }
    $1E/          {Push ds      }
    $2E/          {cs:          }
    $A1/ComDsSav/ {Mov  ax,DsSav}
    $8E/$D8);     {Mov  ds,ax   }

  while Odd (Port [ComBase + 5] ) do begin
    Data := Port [ComBase];

    if ComRxQueueChars < ComRxQueueSize then begin
      ComRxQueue [ComRxQueueIn] := Data;
      if ComRxQueueIn < ComRxQueueSize then
        ComRxQueueIn := ComRxQueueIn + 1
      else
        ComRxQueueIn := 1;

      ComRxQueueChars := ComRxQueueChars + 1
    end
  end;

  Port [$20] := $20;

  InLine
   ($1F/       {Pop  ds      }
    $07/       {Pop  es      }
    $5E/       {Pop  si      }
    $5F/       {Pop  di      }
    $5A/       {Pop  dx      }
    $59/       {Pop  cx      }
    $5B/       {Pop  bx      }
    $58/       {Pop  ax      }
    $89/$EC/   {Mov  Sp,bp   }
    $5D/       {Pop  bp      }
    $CF)       {IRet         }
end;

procedure ComInstall (PortNum: Byte);
begin
  with ComRegb do
  with ComRegw do begin

    case PortNum of
      1: begin
          ComBase     := $3f8;
          ComInt      := $0c;
          Com_8259bit := $10;
        end;

      2: begin
          ComBase     := $2f8;
          ComInt      := $0b;
          Com_8259bit := $08;
        end
    end;

    ComDsSav := Dseg;
    ah := $35;
    al := ComInt;
    MsDos (ComRegw);

    ComOldVecSeg := es;
    ComOldVecOfs := bx;
    ah := $25;
    al := ComInt;
    dx := Ofs (ComInterruptDriver);
    ds := CSeg;
    MsDos (ComRegw);

    InLine ($fa);
    Port [ComBase + 3] := Port [ComBase + 3] and not $80;
    Port [ComBase + 1] := $01;
    Port [ComBase + 4] := $0B;
    Port [$21] := Port [$21] and not Com_8259bit;
    InLine ($fb);

    ComFlushRx
  end
end;

procedure ComRemove;
begin
  with ComRegb do
  with ComRegw do begin
    Inline ($fa);
    Port [$21] := Port [$21] or Com_8259bit;
    Port [ComBase + 4] := Port [ComBase + 4] and $f7;
    InLine ($fb);

    ah := $25;
    al := ComInt;
    ds := ComOldVecSeg;
    dx := ComOldVecOfs;
    MsDos (ComRegw)
  end
end;

procedure ComTx (S: ComString);
var
  i: integer;
begin
  for i := 1 to length(s) do
  begin
     InLine ($fb);
     while not Odd (Port [ComBase + 5] shr 5) do ;
     InLine ($fa);
     Port [ComBase] := Ord (S[i]);
     InLine ($fb)
  end;
end;

procedure ComRx (var Ch: Char);
begin
  InLine ($fb);
  repeat until ComRxQueueChars > 0;
  InLine ($fa);

  Ch := Chr (ComRxQueue [ComRxQueueOut] );
  if ComRxQueueOut < ComRxQueueSize then
    ComRxQueueOut := ComRxQueueOut + 1
  else
    ComRxQueueOut := 1;

  ComRxQueueChars := ComRxQueueChars - 1;
  InLine ($fb)
end;