{ PICSPCW.MCH - Pascal Integrated Communications System machine dependent code}

{ Adapted from ROS system file: }
{ ROSMCH.INC - Remote Operating System Machine Dependent Routines }

{** System routines **}

const
  CPMv         =  $30;  { CP/M Version for this machine }
  MCHv         =    1;  { PCW Identifier }
  TPA_DSK      = $0050; { Where PICSPCW.COM resides and OVERLAYS, too }

function system_init:char;
{ Initialization to be done once when ROS first starts }
{ Returns drive whre program resides on }
var
  v,m          : byte;
begin    { system_init }
  ClrScr;
  writeln('Michael Hildebrand BULLETIN BOARD SYSTEM -- fuer PCW 8xxx');
  m:=succ(MCHv);
  v:=BDOS(Vers);
  if NOT (v < CPMv) then
     inline (
               $2a/$01/$00/            { ld    hl,(1)       ; BIOS Basis laden }
               $01/$57/$00/            { ld    bc,3*(30-1)  ; XBIOS offset     }
               $09/                    { add   hl,bc        ; Adresse XBIOS    }
               $22/*+3/                { ld    (XBIOS+1),hl ; Speichern        }
                                       {XBIOS:                                 }
               $cd/$00/$00/            { call  $-$          ; XBIOS aufrufen   }
               $e3/$00/                { dw    00e3h        ; Version laden    }
               $32/m                   { ld    (m),a        ; Seichern         }
            );
  if (v < CPMV) OR (m <> MCHV) then
  begin
    writeln(BEL,'Dieses BBS System benoetigt eine PCW 8xxx Maschine');
    halt;
  end;
  delay(1000);
  if mem[TPA_DSK]=0 then system_init:=chr(BDOS(getdrive)+ord('A'))
                    else system_init:=chr(mem[TPA_DSK]+ord(pred('A')));
end;
	
procedure system_de_init;
{ De-initialization to be done once when ROS terminates }
begin
  ClrScr;
  write('<<<  M.H. B. B. S.  >>>  ---  Programm wurde korrekt beendet.');
end;

procedure putstat(st: StrStd);
{ Display 'st' on status line }
const
  status_line  =  1;                    { Line used for system status }
  last_line    = 31;                    { Last line on screen }
var
  i            : integer;
begin
  GotoXY(1, status_line);
  ClrEol;
  LowVideo;
  write(st);
  for i := 1 to (90-length(st)) do write(' ');
  HighVideo;
  GotoXY(1, last_line)
end;

{** Remote channel routines **}

const

{ Port locations }

  DataPort     = $E0;                         { Data port }
  StatusPort   = $E1;                         { Status 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       = $00;                         { 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          = $70;                         { Parity, overrun and framing error }

procedure ch_init;
{ Initialize the remote channel }
const
  SIOini       = 8;
  sio_init     : array[1..SIOini] of byte = (0, RESCHN,
                                             4, WRREG4,
                                             1, WRREG1,
                                             3, WRREG3);
var
  i            : integer;
begin
  for i := 1 to SIOini 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 on 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 on a XBIOS call }
var
  intrate      : byte;
begin
  rate := r;
  case rate of
     300: intrate:=6;
    1200: intrate:=8;
    2400: intrate:=10;
  end;
  inline (
           $2a/$01/$00/       { ld      hl,(1)          ; OS Adresse laden  }
           $01/$57/$00/       { ld      bc,3*(30-1)     ; XBIOS Offset      }
           $09/               { add     hl,bc           ; Adresse berechnen }
           $22/*+8/           { ld      (XBIOS+1),hl    ; Eintragen         }
           $3a/intrate/       { ld      a,(intrate)     ; Baudrate laden    }
           $6f/               { ld      l,a             ; In Register       }
           $67/               { ld      h,a                                 }
                              {XBIOS:                                       }
           $cd/$00/$00/       { call    $-$             ; XBIOS Aufruf      }
           $b9/$00            { dw      00b9h           ; Baudrate setzen   }
         );
end;