ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/BEEHIVE/BBS/C128PICS.ARC/C1650.MCH

Text File | 1991-08-11 | 4KB | 187 lines

{ PICS.MCH -
      Pascal Integrated Communications System Machine Dependent Routines }

{ File:        C1650.MCH
  Description: This driver set is designed to support a Commodore 1650 Modem
  Date:        7/7/89
  Author:      Peter B. Carter
}

{** System routines **}

procedure di;
begin
     inline($f3);
end;

procedure ei;
begin
     inline($fb);
end;

function inbc(io : integer) : integer;
{input from true 16b i/o space}
var
   ret_val : integer;
begin
     inline(
     $ed/$4b/io/               {ld   bc,(io)}
     $ed/$68/                  {in   l,(c)        ; input data off true 16b io space}
     $26/0/                    {ld   h,0          ; zero high nibble}
     $22/ret_val               {ld   (ret_val),hl}
     );
     inbc:=ret_val;
end;

procedure outbc(io, data : integer);
{output to true 16b i/o space}
begin
     inline(
     $3a/data/                 {ld   a,(data)}
     $ed/$4b/io/               {ld   bc,(io)}
     $ed/$79                   {out  (c),a}
     );
end;


procedure system_init;
{ Initialization to be done once when ROS first starts }
  begin
       mem[$fd4e]:=1; {8n1}
       outbc($dd03,38); {ddr}
       clock:=true;
       mem[$fd22]:=0;
       write(chr(26),chr(27),')');
  end;


procedure putstat(st: StrStd);
{ Display 'st' on status line }
  const
    status_line    = 25;                    { Line used for system status }
    last_line      = 24;                    { Last line on screen }
  begin
    GotoXY(1, status_line);
    ClrEol;
    write(st);
    GotoXY(1, last_line)
  end;

{** Remote channel routines **}

procedure ch_init;
{ Initialize the remote channel }
  begin
  end;

procedure ch_on;
{ Turn on remote channel (usually by enabling DTR) }
var
   data : byte;
begin
     data:=inbc($dd01);
     data:=data or 32;
     outbc($dd01,data);
end;

procedure ch_off;
{ Turn on remote channel (usually by disabling DTR) }
var
   data : byte;
begin
     data:=inbc($dd01);
     data:=data and 223;
     outbc($dd01,data);
end;

function ch_carck: boolean;
{ Check to see if carrier is present }
begin
     if (inbc($dd01) and 16) = 0 then ch_carck:=true else ch_carck:=false;
end;

function ch_ring : boolean;
{ Check to see if line is ringing }
begin
     if (inbc($dd01) and 8) = 8 then ch_ring:=true else ch_ring:=false;
end;

function ch_inprdy: boolean;
{ Check for ready to input from port }
begin
     if (mem[$fd4f] and 1) = 1 then ch_inprdy:=true else ch_inprdy:=false;
end;

function ch_inp: byte;
{ Input a byte from port - no wait - assumed ready }
var
   ch : byte;
begin
     ch:=mem[$fd51];
     di;
     mem[$fd4f]:=mem[$fd4f] and $fe;
     ei;
     ch_inp:=ch;
end;

procedure ch_purge;
{purge rs232 buffer (if any)}
var
   bt : byte;
begin
     while (mem[$fd4f] and 33) <> 0 do while ch_inprdy do bt:=ch_inp;
end;

procedure ch_out(bt: byte);
{ Output a byte to port - wait until ready }
begin
    repeat
    until (mem[$fd4f] and 128) = 0;
    mem[$fd50]:=bt;
    di;
    mem[$fd4f]:=mem[$fd4f] or $80;
    ei;
end;

procedure set_timer(val : integer);
var
   lh : array[0..1] of byte absolute val;
begin
     di;
     outbc($dc07,lh[1]);
     outbc($dc06,lh[0]);
     outbc($dc0f,$11);
     ei;
end;

procedure ch_set(r: integer);
{ Set the bps rate }
begin
    case r of
      300 : begin
                 set_timer(1136);
                 mem[$fd52]:=3;
                 rate:=300;
            end;
      450 : begin
        set_timer(757);
                mem[$fd52]:=4;
        rate:=450;
            end;
      1200: begin
                 set_timer(284);
                 mem[$fd52]:=12;
                 rate:=1200;
            end;
    end;
end;

procedure system_de_init;
{ De-initialization to be done once when ROS terminates }
  begin
       outbc($dd01,2); {dtr ok}
       write(chr(27),')');
       ch_set(300);
  end;