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

Text File | 1986-12-21 | 17.3 KB | 535 lines

{This is an expanded overlay file for IBM machines and compatibles
 using the addresses corresponding to COM1:. It works on an IBM XT
 using a Hayes Internal Modem (for sure!). The modem initialization
 is for a Hayes Smartmodem. - Clarence Rudd CompuServe Id 73055,1740}

const
  iodata    = $3f8;

(******************** Interupt handler *******************************)
  CONST
    irq4       = $30;                         { Interrupt vector address for }
                                              { COM1.                        }
    eoi        = $20;                         {                              }
    ComPort1   = $03F8;                       { Port address of COM1.        }
                                              { Offset to add  for           }
    intenreg   = 1;                           {   Interrupt enable register  }
    intidreg   = 2;                           {   Interrupt id register      }
    linectrl   = 3;                           {   Line control register      }
    modemctrl  = 4;                           {   Modem control register     }
    linestat   = 5;                           {   Line status register       }
    modemstat  = 6;                           {   Modem status register      }
    buffsize   = 2048;                        { Size of the ring buffer      }

  TYPE                                        { Type declarations            }
    bytechar   = record case boolean of
                   true :(o:byte);
                   false:(c:char)
                 end;

    regrec     = record
                   ax,bx,cx,dx,bp,di,si,ds,es,flags : integer;
                 end;

  VAR
    segment      : integer absolute cseg:$00A0;  { Address for storing DS    }
    intbuffer    : array [0..buffsize] of bytechar;    { Ring buffer         }
    oldvecseg,                                { Segment of DOS set           }
    oldvecoff,                                { Offset of DOS set com int.   }
    head,                                     { Index to the head of the     }
                                              { ring buffer.                 }
    tail,                                     { Tail index of the ring buff  }
    i            : integer;                   { Counter                      }
    ch,                                       { Temperary character buffer   }
    tbyte,
    lbyte        : byte;
    showok       : boolean;
    registers    : regrec;                    { Registers used in DOS call   }

{----------------------------------------------------------------------------
 This is the interrupt handler for ComPort1.
 Notice  the restoration of the DS register through a move to the AX from
 address CS:00A0.  The absolute variable "segment" is initialized at the
 begining of the program to contain the value of "DSEG".  The inline statments
 should replace the current ones in the Turbo reference manual.
----------------------------------------------------------------------------}

  PROCEDURE IntHandler;

    BEGIN
      inline( $50            { push ax        }
             /$53            { push bx        }
             /$51            { push cx        }
             /$52            { push dx        }    { Save all the registers }
             /$57            { push di        }
             /$56            { push si        }
             /$06            { push es        }
             /$1E            { push ds        }
             /$2E            { cs:            }
             /$A1 /$A0 /$00  { mov ax, [00A0] }    { Get the Current data    }
             /$50            { push ax        }    { segment                 }
             /$1F            { pop ds         } ); { Restore the DS register }
      tbyte := port[ ComPort1 ];               { Get the character in the port}
      lbyte := port[ ComPort1 + linestat ];    { Get the status of the port   }
      If ( head < buffsize ) then             { Check bounds of the ring     }
        head := head + 1                      { buffer,  and if smaller then }
      else                                    { increment by one otherwise   }
        head := 0;                            { set to the first element     }
      intbuffer[ head ].o := tbyte;           { Load the buffer w/ the char. }
      port[$20] := $20;                       {                              }
      inline( $1F            { pop ds         }
             /$07            { pop es         }
             /$5E            { pop si         }
             /$5F            { pop di         }
             /$5A            { pop dx         }
             /$59            { pop cx         }   { Restore all registers  }
             /$5B            { pop bx         }
             /$58            { pop ax         }
             /$5D            { pop     bp     }   { Reset the stack to its }
             /$89 /$EC       { mov     sp,bp  }   { proper position        }
             /$5D            { pop     bp     }
             /$CF );         { iret           }   { Return                 }
    END;

{-------------------------------------------------------------------------
      The procedure IntOn sets up the interrupt handler vectors,  and
 communication protocal.
-------------------------------------------------------------------------}

  PROCEDURE IntOn;

    CONST
      bits5=0;
      bits6=1;
      bits7=2;
      bits8=3;
      stopbit1=0;                             { These are constants used     }
      stopbit2=4;                             { to define parity, stop bits, }
      noparity=0;                             { data bits, etc.              }
      parity=8;
      evenparity=16;
      dtrtrue=1;
      rtstrue=2;
      bit3true=8;

    VAR
      tbyte   : byte;                         { Temperary byte buffer        }
      i       : integer;                      { counter                      }

    BEGIN
      head:=0;                                { Initialize the ring buffer   }
      tail:=0;                                { indexes                      }
      tbyte := port[ ComPort1 ];              { Read the ports to clear any  }
      tbyte := port[ ComPort1 + linestat ];   { error conditions             }
      port[ ComPort1 + linectrl ] := bits7 + stopbit1 + noparity;
      port[ ComPort1 + intenreg ] := 1;       { Enable com port interrupts   }
      tbyte := port[$21];                     {                              }
      with registers do
        begin
          ax:=$2500;                          { Load the function number for }
                                              { redefining an interrupt      }
          ds:=cseg;                           { Get and set the segment and  }
          dx:=ofs(IntHandler);                { offset of the handler        }
        end;
      oldvecoff:=memw[0000:irq4];             { Save the segment and offset  }
      oldvecseg:=memw[0000:irq4+2];           { of the DOS interrupt handler }
      registers.ax:=registers.ax+$0c;         { Use the COM1: interrupt    }
      intr($21,registers);                    { Call DOS to reset INT 0C     }
      port[$21]:=tbyte and $ef;               {                              }
      inline($fb);                            { Enable interrupts            }
    END;

{-----------------------------------------------------------------------------
      This procedure restores the original system values to what they
 were before the interrupt handler was set into action.
-----------------------------------------------------------------------------}

  PROCEDURE IntOff;

    VAR
      tbyte:byte;

    BEGIN
      inline($FA);  { CLI }                   { Disable interrupts           }
      tbyte:=port[$21];                       {                              }
      port[ComPort1+intenreg]:=0;              { Disable COM interrupts       }
      port[$21]:=tbyte or $10;            {                              }
      memw[0000:irq4]:=oldvecoff;         { Restore the DOS interrupt    }
      memw[0000:irq4+2]:=oldvecseg;       { handler                      }
    END;
{---------------------------------------------------------------------------
      When the interrupt routine is called because of a com port interrupt
 the head index is incremented by one,  but does not increment the tail
 index.  This causes the two indexes to be unequal.
 --------------------------------------------------------------------------}

(****************** End of interupt handler ******************)


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[$3fd] and 32) > 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[iodata] := 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.}

  begin
    cts := ((port[$3fe] and 128) = 128) 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 (head<>tail);;
  end;


{-----------------------------------------------------------------------------
      If the ring buffer indexes are not equal then recvchar returns the
 char from either the COM1: or COM2: port.  The character is read from the
 ring buffer and is stored in the FUNCTION result.
-----------------------------------------------------------------------------}
function recvchar: char;
{Returns character from serial input port,
  REGARDLESS of the status of inready.}
    begin
      If ( head <> tail ) then           { Check for ring buffer character   }
        begin
          If ( tail < buffsize ) then    { Check the limits of the ring      }
            tail := tail + 1             { and set tail accordingly          }
          else
            tail := 0;
          recvchar := intbuffer[tail].c;  { Get the character                 }
        end
      else recvchar := #0;
    end;

procedure setbaud(speed: rate);
{For changing the hardware baud rate setting}

  begin
    port[$3fb] := 131;
    case speed of
      slow: begin
              port[$3f8] := $80;
              port[$3f9] := 1;
            end;
      fast: begin
              port[$3f8] := $60;
              port[$3f9] := $0;
            end;
    end;
    port[$3fb] := 3;
    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[$3fb] := 3;
    port[$3f9] := 0;
    port[$3fc] := 11;
  end;

procedure SETmodem;        (* Modem Dependent *)
{Sets modem for auto-answer, CTS line as carrier detect, no command echo}

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

  begin
    buffer := 'ATS0=1 S2=255 S7=30 Q1 E0  ';
    writeln('Setting modem for BBS operation');
    for loop := 1 to length(buffer) do begin
      ch := buffer[loop];
      xmitchar(ch);
      t := recvchar;
      if t in [' '..'~'] then write(t);
      delay(100);
    end;
    xmitchar(#13);
    writeln;
    write('Delaying...');
    delay(1000); {Delays while modem digests initialization codes}
    writeln;
  end;




procedure RESETmodem;        (* Modem Dependent *)
{Sets modem for normal command mode}

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

  begin
    buffer := 'ATS0=0 S2=43 Q0 E1  ';
    writeln('Re-setting modem for normal use');
    for loop := 1 to length(buffer) do begin
      ch := buffer[loop];
      xmitchar(ch);
      t := recvchar;
      if t in [' '..'~'] then write(t);
      delay(100);
    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;
    head := 0;
    tail := 0;
    segment := dseg;                { segment is an absolute variable used  }
                                    { by the interrupt routine to restore   }
                                    { the DS register to point to the DSEG  }
    IntOn;                          { Set up the interrupt routine          }
    setbaud(fast);
    SETmodem;
  end;

procedure ResetSystem;
  begin
    ReSetModem;  { prevent modem from answering call while system down }
    IntOff;      { turn off the interupts }
    if D_Dos then
      begin
        Time_Share(True);
        Set_Low;
      end;
     window(1,1,80,25); { return screen to normal}
  end;


function badframe: boolean;
{Indicates Framing Error on serial I/O chip - return false if not available.}

  begin
  end;

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

  begin
    port[$3fc] := 8;
  end;

procedure raiseRTS;
(* Raises RTS line to enable auto-answer *)

  begin
    port[$3fc] := 11;
  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.}
  var
    x, y : integer;

  begin
    x := wherex;
    y := wherey;
    window(1,1,80,25);
    textcolor(LightGreen);
    gotoxy(10,25);
    write(caller);
    if clockin then write(' called at ',timeon);
    clreol;
    textcolor(Green);
    window(1,1,80,24);
    gotoxy(x,y);
  end;

procedure hangup;
{Signals modem to hang up - in this case by lowering RTS line for 500 msec.}

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

procedure flush_input;

  begin
    head := 0;
    Tail := 0;
  end;

procedure CallBack(buffer: longname);        (* Modem Dependent *)
{has modem place call }

  var loop  : byte;
      ch,t    : char;

  begin
    delay(1000);
    flush_input;
    for loop := 1 to length(buffer) do begin
      ch := buffer[loop];
      xmitchar(ch);
      t := recvchar;
      if t in [' '..'~'] then write(t);
      delay(100);
    end;
    xmitchar(#13);
    loop := 0;
    repeat
      loop := loop + 1;
      delay(1000);
    until (loop = 60) or 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}

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;