ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOPAS/PMODEM.ARK/ROS.MCH

Text File | 1987-02-22 | 5KB | 187 lines

{ ROS.MCH - Remote Operating System Machine Dependent Routines }

{ File:        KAYII.MCH
  Description: This driver set is designed to support the Kaypro II (83).
               taken from a Kaypro written by Chris DeBracy for 84&85 model
               kaypros.
  Date:        5/4/85
  Author:      Chris DeBracy

  Description: Comment update and code cleanup.
  Date:        9/7/85
  Author:      Steve Fox

  Description:  Driver Derived from KPRO.MCH by C. DeBracy
                In response to a comment by Dave Gannon, the procedure
                Drive_off was added.  To complete this mod, call the procedure
                from files
           ROSSND.INC, about line 55;
               while (remaining > 0) and (errcnt < maxerr) do
              begin
                blockread(XfrFile, Buffer, BufBlocks);
                Drive_off;
                remaining := pred(remaining);
           ROSSND.INC, About 195
                    EndOfFile := (IOresult <> 0);
                    Drive_off;
                  end;
             ROSRCV.INC, about line 60;
                                         Drive_off;
                          OK := (IOresult = 0);
                          Write_err := Not OK;

  Date:        4/20/86
  Author:      Coleman Smith
}

{** System routines **}
Procedure Reset_Drives;
          Begin
          End;

Procedure Drive_off; {suggested by Dave Gannon, 14 Mar 86}
  Var
    x  :  Integer;
  Begin
     x := port[28];
     x := (x or 64);
     port[28] := x;
end;

procedure system_init;
{ Initialization to be done once when ROS first starts }
  begin
  end;

procedure system_de_init;
{ De-initialization to be done once when ROS terminates }
  begin
  end;

procedure putstat(st: StrStd);
{ Display 'st'(status message) on status line }

  begin
    GOTOXY(1,24);
{    Write(^X);}
    writeln(st);
  end;

{** Remote channel routines **}

const

{ Port locations }

  DataPort   = $04;                         { Data port }
  StatusPort = $06;                         { Status port }
  RatePort   = $00;                         { Data rate (bps) port }

{ StatusPort commands }

  RESSTA     = $10;                         { Reset ext/status }
  RESCHN     = $18;                         { Reset channel }
  RESERR     = $30;                         { Reset error }
  WRREG1     = $00;                         { Value to write to register 1 }
  WRREG3     = $C1;                         { 8 bits/char, RX enable }
  WRREG4     = $44;                         { 16x, 1 stop bit, no parity }
  DTROFF     = $68;                         { DTR off, RTS off }
  DTRON      = $EA;                         { DTR on, 8 bits/char, TX enable, RTS on }

{ StatusPort masks }

  DAV        = $01;                         { Data available }
  TRDY       = $04;                         { Transmit buffer empty }
  DCD        = $08;                         { Data carrier detect }
  PE         = $10;                         { Parity error }
  OE         = $20;                         { Overrun error }
  FE         = $40;                         { Framing error }
  ERR        = $60;                         { Parity, overrun and framing error }

{ Rate setting commands }

  BD300      = $5;                         {  300 bps }
  BD1200     = $7;                         { 1200 bps }
  BD2400     = $A;                         { 2400 bps }

procedure ch_init;
{ Initialize the remote channel }
  const
    sio_init: array[1..8] of byte =
      (0, RESCHN, 4, WRREG4, 1, WRREG1, 3, WRREG3);
  var
    i: integer;
  begin
    for i := 1 to 8 do
      port[StatusPort] := sio_init[i]
  end;

procedure ch_on;
{ Turn on remote channel (usually by enabling DTR) }
  begin
    port[StatusPort] := 5;
    port[StatusPort] := DTRON
  end;

procedure ch_off;
{ Turn off remote channel (usually by disabling DTR) }
  begin
    port[StatusPort] := 5;
    port[StatusPort] := DTROFF
  end;

function ch_carck: boolean;
{ Check to see if carrier is present }
  begin
    port[StatusPort] := 0;
    port[StatusPort] := RESSTA;
    ch_carck := ((DCD and port[StatusPort]) <> 0)
  end;

function ch_inprdy: boolean;
{ Check for ready to input from port }
var
  bt: byte;
begin
  if (DAV and port[StatusPort]) <> 0
    then
      begin
        port[StatusPort] := 1;
        if (ERR and port[StatusPort]) <> 0
          then
            begin
              port[StatusPort] := RESERR;
              bt := port[DataPort];
              ch_inprdy := FALSE
            end
          else ch_inprdy := TRUE
      end
    else ch_inprdy := FALSE
end;

function ch_inp: byte;
{ Input a byte from port - no wait - assumed ready }
  begin
    ch_inp := port[DataPort]
  end;

procedure ch_out(bt: byte);
{ Output a byte to port - wait until ready }
  begin
    repeat
    until ((TRDY and port[StatusPort]) <> 0);
    port[DataPort] := bt
  end;

procedure ch_set(r: integer);
{ Set the bps rate }
  begin
    rate := r;
    case rate of
       300: port[RatePort] := BD300;
      1200: port[RatePort] := BD1200;
      2400: port[RatePort] := BD2400
    end
  end;