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

Text File | 1986-12-21 | 7.8 KB | 317 lines

(* MACHDEP.TI - TIPC overlay for TurboBBS version 1.05 - by R. Maxwell *)
(* TurboBBS Vancouver: [phone] 300/1200/2400 baud, online 24hrs *)

{This is a minimal overlay file the TI personal computer.
 It uses the addresses of the 8530 on the Sync-Async Communications card.
 The modem initialization is for a Hayes Smartmodem or clone thereof. - RHM}

{NOTE! This overlay contains a procedure "flush" which conflicts with
       a procedure with the same name in IO.INC. The routine here is
       preferred: delete or comment out the one occurring in IO.INC.}

const
  iobase    = $E0; {Port 1 address}

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
  end;

function outready: boolean;

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

  begin
    outready := ((port[iobase + 6] and 4) > 0);
  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[iobase + 7] := 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.}

  const checkvalue = 32; {change to 8 to monitor DCD line instead of CTS}

  begin
    cts := ((port[iobase + 6] and checkvalue) = checkvalue) or local;
  end;

function inready: boolean;

{Returns true if we've got a character received
 from the serial port or keyboard.}

  begin
    inready := keypressed or ((port[iobase + 6] and 1) > 0);
  end;

function recvchar: char;

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

  begin
    recvchar := chr(port[iobase + 7]);
  end;

procedure setbaud(speed: rate);

{For changing the hardware baud rate setting}

  begin
    port[iobase + 6] := 13;
    port[iobase + 6] := 0;
    port[iobase + 6] := 12;
    case speed of
      slow: port[iobase + 6] := 254;
      fast: port[iobase + 6] := 62;
    end;
    baud := speed;
  end;

procedure clearSIO;

{ Initializes serial I/O chip:
  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[iobase + 6] := 0;   {Port A initialization:}
    port[iobase + 6] := 9;
    port[iobase + 6] := 192; {Master Reset}
    port[iobase + 6] := 11;
    port[iobase + 6] := 82;  {Select Baud Rate Generator}
    port[iobase + 6] := 14;
    port[iobase + 6] := 3;   {Turn Baud Rate Generator ON}
    setbaud(fast);
    port[iobase + 6] := 15;
    port[iobase + 6] := 0;   {Disable External/Status Int}
    port[iobase + 6] := 1;
    port[iobase + 6] := 0;   {Disable all other Interrupts}
    port[iobase + 6] := 3;
    port[iobase + 6] := 193; {8 bits/char, enable receive}
    port[iobase + 6] := 4;
    port[iobase + 6] := 68;  {x16 clock, 1 stop, no parity}
    port[iobase + 6] := 5;
    port[iobase + 6] := 234; {enable xmit, raise RTS & DTR}
    port[iobase + 4] := 0;   {Port B initialization:}
    port[iobase + 4] := 15;
    port[iobase + 4] := 0;   {Disable External/Status Int}
    port[iobase + 4] := 1;
    port[iobase + 4] := 0;   {Disable all other Interrupts}
  end;

procedure clearmodem;        (* Modem Dependent *)

{Sets modem for auto-answer, CTS line as carrier detect, no command echo}

  var buffer: line;
      loop  : byte;
      ch    : char;

  begin
    buffer := 'ATS0=1 V0 Q1';
    for loop := 1 to length(buffer) do begin
      ch := buffer[loop];
      xmitchar(ch);
      delay(50);
    end;
    xmitchar(#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
    clearSIO;
    clearmodem;
  end;

function badframe: boolean;

{Indicates Framing Error on serial I/O chip - return false if not available.}

  begin
    port[iobase + 6] := 1;
    badframe := (port[iobase + 6] and 64) = 64;
  end;

procedure dropRTS;

{ Lowers RS-232 RTS line - used to inhibit auto-answer
   and to cause modem to hang up }

  begin
    port[iobase + 6] := 5;
    port[iobase + 6] := 232;
  end;

procedure raiseRTS;

(* Raises RTS line to enable auto-answer *)

  begin
    port[iobase + 6] := 5;
    port[iobase + 6] := 234;
  end;

procedure setlocal;

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

  begin
    dropRTS; {Inhibits auto-answer}
    local := true;
  end;

procedure clearlocal;

{Clears local flag and allows modem auto-answer}

  begin
    raiseRTS; {Enables Auto-answer}
    local := false;
  end;

procedure unload;

{Halts Kaypro disk drives - normally they run for about 15 secs.}

  begin
  end;

procedure dispcaller;

{Displays caller's name on protected 25th line of host CRT;
 Replace with empty procedure if not desired.}

  begin
  end;

procedure hangup;

{Signals modem to hang up - in this case by dropping RTS until CTS drops}

  begin
    if cts then lineout('--- Disconnected ---' + cr + lf);
    dropRTS;
    if local then clearlocal else repeat until not cts;
    raiseRTS;
  end;

procedure flush;

  var junk: char;
      loop: byte;

  begin
    for loop := 1 to 3 do junk := recvchar;
  end;

{Real-time clock support begins here - this routine is called
 even if there is NO clock, so leave it and set clockin accordingly}

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: integer;
    tempint: integer;
    temp1: byte;

  const monthmask = $000F;
        daymask = $001F;
        minutemask = $003F;
        secondmask = $001F;
  type  dtstr = string[8];
        Register        = Record
                          AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
                          End;
  var  tstr : dtstr;

  function getdate : dtstr;

  var
    allregs : register;
    month, day,
    year    : string[2];
    i       : integer;
    tstr    : dtstr;

  begin
     allregs.ax := $2A * 256;
     MsDos(allregs);
     str((allregs.dx div 256):2,month);
     str((allregs.dx mod 256):2,day);
     str((allregs.cx - 1900):2,year);
     tstr := month + '/' + day + '/' + year;
     for i := 1 to 8 do
       if tstr[i] = ' ' then
         tstr[i] := '0';
     getdate := tstr;
  end;  {getdate}

  function gettime : dtstr;

  var
   allregs : register;
   hour, minute,
   second  : string[2];
   i       : integer;
   tstr    : dtstr;

  begin
     allregs.ax := $2C * 256;
     MsDos(allregs);
     str((allregs.cx div 256):2,hour);
     str((allregs.cx mod 256):2,minute);
     str((allregs.dx div 256):2,second);
     tstr := hour + ':' + minute + ':' + second;
     for i := 1 to 8 do
       if tstr[i] = ' ' then
         tstr[i] := '0';
     gettime := tstr;
  end;  {gettime}

  begin
    val(copy(getdate,1,2),tempint,temp);
    month := lo(tempint);
    val(copy(getdate,4,2),tempint,temp);
    date := lo(tempint);
    val(copy(gettime,1,2),tempint,temp);
    hour := lo(tempint);
    val(copy(gettime,4,2),tempint,temp);
    min := lo(tempint);
    val(copy(gettime,7,2),tempint,temp);
    sec := lo(tempint);
  end;