Oakland CPM Archive/oakcpm.iso/cpm/bbs/turbobbs.ark/MACHDEP.180

Text File | 1986-12-21 | 7.6 KB | 283 lines

(**************************************************************************)
(* This is a temporary machdep.inc for the SB-180 computer.  It is a bit  *)
(* quick and dirty, but it works.  Original by Robert Maxwell, conversion *)
(* by Alan Cairns.  Any questions to TurboBBS or get me on Frog Hollow.   *)
(* If you have a reluctant modem, it may be advisable to include a call to*)
(* Clearmodem in the main program near the end to make sure that you go   *)
(* back to a ready state.                                                 *)
(*                                                                        *)
(* Version 1.0 completed and put in the public domain 19 April 1986       *)
(**************************************************************************)

 const
  cntla0    = $00;    {control channel a - generates RTS*, data parameters}
  cntlb0    = $02;    {control channel b - baud rate, CTS*}
  stat0     = $04;    {ASCI status register for channel 0}
  tdr0      = $06;    {Transmit data}
  rdr0      = $08;    {Receive data}


procedure lineout(message: line); forward;
 {lineout is in IO.INC - don't change this declaration!}

procedure clearstatus;

{Resets latching status flags on SIO chip -
 replace with empty procedure if not needed}

  begin
    port[cntla0] := $64; {sets EFR bit =0}
  end;

function outready: boolean;

{Returns true if serial output port is
 ready to transmit a new character}

  begin
    clearstatus;
    outready := ((port[stat0] shr 1) and 1) = 1;  {TDRE bit 1, stat0}
  end;

procedure xmitchar(ch: char);

{Transmits ch when serial output port is ready,
   unless we're in the local mode.}

  begin
    if not local then begin
      repeat until outready;
      port[tdr0] := ord(ch);
    end;
  end;

function cts: boolean;

{This function returns true if a carrier tone is present on the modem
 and is frequently checked to see if the caller is still present.
 It always returns "true" in the local mode.  In this adaptation for
 the SB-180 with a Hayes Smartmodem I have used DCD as carrier detect,
 but cts occurs so often throughout the program that I am keeping the
 function name.  Option switch #6 must be up for this file to work    AJC}

  begin
    clearstatus;
    cts := (((port[stat0] shr 2) and 1) = 0) or local;
    cts := (((port[stat0] shr 2) and 1) = 0) or local;

 {reads the dcd bit in stat0. In some circumstances it is necessary to
  read the register twice for an accurate result}

end;

function inready: boolean;

{Returns true if we've got a character received
 from the serial port or keyboard.}
{Reads the RDRF bit in stat0}

  begin
   clearstatus;
   inready := keypressed or ((port[stat0]shr 7) and 1 = 1);
  end;

function recvchar: char;

{Returns character from serial input port,
  REGARDLESS of the status of inready.}

  begin
    recvchar := chr(port[rdr0]);
  end;

procedure setbaud(speed: rate);

{For changing the hardware baud rate setting}
{From the Hitachi HD64180 manual, table 2.10.2     AJC}
  begin
    case speed of
      slow: port[cntlb0] := $0D;     { 300 baud}
      fast: port[cntlb0] := $0B;     {1200 baud}
    end;
    baud := speed;
  end;

procedure clearSIO;

{ Initializes serial I/O chip - an on-chip usart in this case.
  sets up for 8 bits, no parity and one stop bit on both
  transmit and receive, and allows character transmission
  with CTS low. Also sets RTS line high. }

  begin
    port[cntla0] := $74;   {sets RTS high}
  end;

procedure clearmodem;
{Sets modem for auto-answer, DCD line (switch six up)as carrier detect,
no command echo.  The direct aproach here is the only one that works
reliably.  I've tried the xmitchar route, and it works occasionally -
very unreliable.             AJC}

  begin
    write(aux,'ATS0=1',#13);
    delay(500);
    write(aux,'S0=1',#13);
    delay(500);
    write(aux,'M0 Q1 ',#13);
    writeln;
    write('Delaying...');
    delay(1000); {Delays while modem digests initialization codes}
    writeln;
  end;

procedure setup;

{Hardware initializion for system to start BBS program}

  begin
    setbaud(fast);
    clearSIO;
    clearmodem;
  end;

function badframe: boolean;

{Indicates Framing Error on serial I/O chip - return false if not available.}
{Reads PE bit in stat0      AJC}
  begin
    badframe := (port[stat0] and $ef) = 1;
  end;

procedure dropRTS;

{Since the only way to control the Hayes modem on my system without
crossing pins 6 and 8 on the cable is by direct order to the modem I
have written these two procedures accordingly.  For consistency I have
retained the names            AJC   }

  begin
       write(aux,'ATS0=0',#13);
       delay(1000);
  end;


procedure setlocal;

{Sets local flag true and inhibits modem auto-answer}

  begin
    setbaud(fast);
    dropRTS; {Inhibits Hayes auto-answer}
    local := true;
  end;

procedure clearlocal;

{Clears local flag and allows modem auto-answer}

  begin
    setbaud(fast);
    clearmodem;
    local := false;
  end;

procedure unload;

{Halts Kaypro disk drives - normally they run for about 15 secs. This is
not a problem, as I am running the system on the RAM disk.  It would be
simple to implement for 180 by programming the CSIO ports as in the Hitachi
manual                  AJC}

  begin
  end;

procedure dispcaller;

{Displays caller's name on protected 25th line of host CRT;
 Replace with empty procedure if not desired.  On my Qume terminal I
cannot do this.  I need a relatively difficult procedure to set up a
status line and enable normal scrolling.  I'll get round to this later. AJC}

  begin
  end;

procedure hangup;

{Signals modem to hang up - in this case by using Hayes controls.}

  begin
    if cts then lineout('--- Disconnected ---' + cr + lf);
    delay(2000);
    write(aux,'+++');
    delay(2000);
    write(aux,'ATH',#13);
    if local then clearlocal else repeat until not cts;
  end;

{Real-time clock support begins here - this routine is called
 even if there is NO clock, so leave it and set clockin accordingly}
{I have no clock, but might be able to fake it with the timer utility
that comes with the SB 180.  Another project for later.  AJC}
const
  rtca    = $20;  {Kaypro 4/84 and (modified) Kaypro 2/84 }
  rtcs    = $22;  {real-time clock control registers: will}
  rtcd    = $24;  {differ significantly on other hardware.}

procedure clock(var month,date,hour,min,sec: byte);

{Returns with month in range 1(Jan)..12(Dec),
 date in 1..length of month, hour in 0..23 (24-hr clock),
 minute and second in 0..59}

  var
    temp: byte;

  function bcd_to_dec(bcd: byte): byte;

  {Converts 2-digit/byte BCD to decimal}

    begin
      bcd_to_dec := (bcd and 15) + 10 * (bcd div 16);
    end;

  function inport(loc: byte): byte;

  {Reads Kaypro clock port data from register loc}

    begin
      port[rtca] := loc;
      inport := bcd_to_dec(port[rtcd]);
    end;

  procedure setupclock;

  {Sets Kaypro internal I/O port to address clock}

    var
      junk: byte;

    begin
      port[rtcs] := $CF;
      port[rtcs] := $E0;
      port[rtcs] := $03;
      junk := inport($14);
    end;

  begin
    if clockin then begin
      setupclock;
      repeat
        sec   := inport(2);
        min   := inport(3);
        hour  := inport(4);
        date  := inport(6);
        month := inport(7);
        temp  := inport(2);
      until temp = sec; {Make sure clock hasn't changed during reading}
    end;
  end;
t(7);
        temp  := inport(2);
      until temp = sec; {Make sure clock hasn't changed during reading}
    end;