Frostbyte's 1980s DOS Shareware Collection/floppyshareware.zip/floppyshareware/USCX/TURBO-06.ZIP/COMMCALL.PAS

Pascal/Delphi Source File | 1985-02-23 | 6KB | 314 lines

{Communications routines for TURBO Pascal written by Alan Bishop
 Handles standart COM1: ports with interrupt handling.  Includes
 support for only one port, and with no overflow, parity, or other
 such checking.  However, even some of the best communication programs
 don't do this anyway, and I never use it.  If you make modifications,
 please send me a copy if you have a simple way of doing it (CIS EMAIL,
 Usenet, MCI Mail, etc)  Hope these are useful.

Alan Bishop - CIS      - 72405,647
              Usenet   - bishop@ecsvax
              MCI Mail - ABISHOP


All routines copywrite 1984 by Alan Bishop.  To be used in any
personal or public domain programs.  Permission to be used in
any Freeware type program or any sold program must come from
Alan Bishop.
}

{$C-}
program commcall;

const recv_buf_size = 2048;  {this may be changed to whatever size you need}

type buffer_pointer   = integer;  {just for readability}
     smallstring      = string[2];  {for compatibility with my INKEY routine}
     bigstring        = string[255];  {general purpose}
     storage          = byte;  {readability}
     check_bit        = (none,even);  {readability and expansion}

var buf_start, buf_end    : buffer_pointer;  {NOTE: these will change by them-
                                             selves in the background}
    recv_buffer           : array [1..recv_buf_size] of storage; {also self-
                                                                  changing}
    speed                 : integer;  {I don't know the top speed these
                                       routines will handle}
    dbits                 : 7..8;  {only ones most people use}
    stop_bits             : 1..2;  {does anyone use 2?}
    parity                : check_bit;  {even and none are the common ones}

procedure check_range(var range : integer);

{this is used to adjust buffer pointers}

begin
 if range > recv_buf_size then range := 1;
end;

function commpressed : boolean;

{like keypressed, but for the comm port}

begin
 commpressed := (buf_start <> buf_end);
end;

function cinkey : smallstring;

{returns nothing or a code from the buffer - 2 bytes are used for
 ease of use with a two byte inkey routine}

var result : smallstring;
    temp   : integer;

begin
 if not commpressed then result := ''
 else
 begin
  inline ($FA);  {very important}
  temp := recv_buffer[buf_start];
  buf_start := buf_start +1;
  check_range(buf_start);
  inline ($FB);  {very important}
  result := chr(temp);
 end;
 cinkey := result;
end;


function carrier : boolean;

{true if carrier, false if not}

begin
 carrier := odd(port[$3FE] shr 7);
end;


procedure set_up_recv_buffer;

{big procedure isn't it?}

begin
 buf_start := 1;
 buf_end   := 1;
end;


procedure set_baud(rate : integer);

{has no problems with non-standard bauds}

var a : byte;
    divided : real;

begin
 if rate<=9600 then
 begin
  speed := rate;
  divided := 115200.0/rate;
  rate := trunc(divided);
  a := port[$3fb];
  if a < 128 then a := a+128;
  port[$3fb] := a;
  port[$3f8] := lo(rate);
  port[$3f9] := hi(rate);
  port[$3fb] := a-128;
 end;
end;

procedure update_uart;

{uses dbits, stop_bits, and parity}

var a : byte;

begin
 a := dbits-5;
 if stop_bits = 2 then a := a + 4;
 if parity = even then a := a + 24;
 port[$3fb] := a;
end;


procedure init_port;

{sets up most anything necessary}

var a,b : integer;
    buf_len : integer;

begin
 update_uart;
 port[$3f9] := 1;             {interupt enable}
 a := port[$3fc];
 if odd(a) then a := 1 else a := 0;   {keep terminal ready}
 a := a+10;
 port[$3fc] := a;                     {turn on req to send and out2}
 a := port[$3fa];
 port[$21]  := $c;
 set_baud(1200);
 buf_len := recv_buf_size;

 {this is the background routine}

 inline (
  $1E/
  $0E/
  $1F/
  $BA/*+23/
  $B8/$0C/$25/
  $CD/$21/
  $8B/$BE/BUF_LEN/
  $89/$3E/*+87/
  $1F/
  $2E/$8C/$1E/*+83/
  $EB/$51/
  $FB/
  $1E/
  $50/
  $53/
  $52/
  $56/
  $2E/$8E/$1E/*+70/
  $BA/$F8/$03/
  $EC/
  $BE/RECV_BUFFER/
  $8B/$1E/BUF_END/
  $88/$40/$FF/
  $43/
  $E8/$22/$00/
  $89/$1E/BUF_END/
  $3B/$1E/BUF_START/
  $75/$0C/
  $8B/$1E/BUF_START/
  $43/
  $E8/$10/$00/
  $89/$1E/BUF_START/
  $BA/$20/$00/
  $B0/$20/
  $EE/
  $5E/
  $5A/
  $5B/
  $58/
  $1F/
  $CF/
  $2E/$8B/$16/*+11/
  $42/
  $39/$DA/
  $75/$03/
  $BB/$01/$00/
  $C3/
  $00/$00/
  $00/$01/
  $90
 );
end;

procedure term_ready(state : boolean);

{send a true for on, false for off}

var a : byte;

begin
 a := port[$3fc];
 if odd(a) then a := a - 1;
 a := a + ord(state);
 port[$3fc] := a;
end;

procedure remove_port;

{gets rid of most problems}

var a : byte;

begin
 port[$3f9] := 0;
 a := port[$3fc];
 if odd(a) then a := 1 else a := 0;
 port[$3fc] := a;
 port[$21]  := $BC;
end;

procedure write_byte(to_send : bigstring);

{sends out up to 255 bytes}

var a,b,c : byte;

begin
 for b := 1 to length(to_send) do
 begin
  c := ord(to_send[b]);
  repeat a := port[$3fd];
  until odd(a shr 5);
  port[$3f8] := c;
 end;
end;

procedure break;

{send a break}

var a,b : byte;

begin
 a := port[$3fb];
 b := a;
 if b > 127 then b := b - 128;
 if b <= 63 then b := b + 64;
 port[$3fb] := b;
 delay(400);
 port[$3fb] := a;
end;

procedure setup;

{initialize most stuff - you may want to replace this routine completely}

var a : byte;

begin
 dbits        := 8;
 parity       := none;
 stop_bits    := 1;
 speed        := 1200;
 init_port;
 term_ready(true);
end;


{    The following is a sample program illustrating the use of these
     routines.  The '|' key exits and ESC sends a break.  Because
     of TURBO's standard handling of function keys and other things
     like that, they will also.
}


var leave : boolean;
    a     : char;
    b     : smallstring;

begin
 setup;
 leave := false;
 while not leave do
 begin
  if keypressed then
  begin
   read(kbd,a);
   if a = '|' then leave := true else
   if a = chr(27) then break else
   write_byte(a);
  end;
  if commpressed then write(cinkey);
 end;
 remove_port;
 term_ready(false);
end.