home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / bbs / turbobbs.ark / MACHDEP.180 < prev    next >
Text File  |  1986-12-20  |  8KB  |  283 lines

  1. (**************************************************************************)
  2. (* This is a temporary machdep.inc for the SB-180 computer.  It is a bit  *)
  3. (* quick and dirty, but it works.  Original by Robert Maxwell, conversion *)
  4. (* by Alan Cairns.  Any questions to TurboBBS or get me on Frog Hollow.   *)
  5. (* If you have a reluctant modem, it may be advisable to include a call to*)
  6. (* Clearmodem in the main program near the end to make sure that you go   *)
  7. (* back to a ready state.                                                 *)
  8. (*                                                                        *)
  9. (* Version 1.0 completed and put in the public domain 19 April 1986       *)
  10. (**************************************************************************)
  11.  
  12.  const
  13.   cntla0    = $00;    {control channel a - generates RTS*, data parameters}
  14.   cntlb0    = $02;    {control channel b - baud rate, CTS*}
  15.   stat0     = $04;    {ASCI status register for channel 0}
  16.   tdr0      = $06;    {Transmit data}
  17.   rdr0      = $08;    {Receive data}
  18.  
  19.  
  20. procedure lineout(message: line); forward;
  21.  {lineout is in IO.INC - don't change this declaration!}
  22.  
  23. procedure clearstatus;
  24.  
  25. {Resets latching status flags on SIO chip -
  26.  replace with empty procedure if not needed}
  27.  
  28.   begin
  29.     port[cntla0] := $64; {sets EFR bit =0}
  30.   end;
  31.  
  32. function outready: boolean;
  33.  
  34. {Returns true if serial output port is
  35.  ready to transmit a new character}
  36.  
  37.   begin
  38.     clearstatus;
  39.     outready := ((port[stat0] shr 1) and 1) = 1;  {TDRE bit 1, stat0}
  40.   end;
  41.  
  42. procedure xmitchar(ch: char);
  43.  
  44. {Transmits ch when serial output port is ready,
  45.    unless we're in the local mode.}
  46.  
  47.   begin
  48.     if not local then begin
  49.       repeat until outready;
  50.       port[tdr0] := ord(ch);
  51.     end;
  52.   end;
  53.  
  54. function cts: boolean;
  55.  
  56. {This function returns true if a carrier tone is present on the modem
  57.  and is frequently checked to see if the caller is still present.
  58.  It always returns "true" in the local mode.  In this adaptation for
  59.  the SB-180 with a Hayes Smartmodem I have used DCD as carrier detect,
  60.  but cts occurs so often throughout the program that I am keeping the
  61.  function name.  Option switch #6 must be up for this file to work    AJC}
  62.  
  63.   begin
  64.     clearstatus;
  65.     cts := (((port[stat0] shr 2) and 1) = 0) or local;
  66.     cts := (((port[stat0] shr 2) and 1) = 0) or local;
  67.  
  68.  {reads the dcd bit in stat0. In some circumstances it is necessary to
  69.   read the register twice for an accurate result}
  70.  
  71. end;
  72.  
  73. function inready: boolean;
  74.  
  75. {Returns true if we've got a character received
  76.  from the serial port or keyboard.}
  77. {Reads the RDRF bit in stat0}
  78.  
  79.   begin
  80.    clearstatus;
  81.    inready := keypressed or ((port[stat0]shr 7) and 1 = 1);
  82.   end;
  83.  
  84. function recvchar: char;
  85.  
  86. {Returns character from serial input port,
  87.   REGARDLESS of the status of inready.}
  88.  
  89.   begin
  90.     recvchar := chr(port[rdr0]);
  91.   end;
  92.  
  93. procedure setbaud(speed: rate);
  94.  
  95. {For changing the hardware baud rate setting}
  96. {From the Hitachi HD64180 manual, table 2.10.2     AJC}
  97.   begin
  98.     case speed of
  99.       slow: port[cntlb0] := $0D;     { 300 baud}
  100.       fast: port[cntlb0] := $0B;     {1200 baud}
  101.     end;
  102.     baud := speed;
  103.   end;
  104.  
  105. procedure clearSIO;
  106.  
  107. { Initializes serial I/O chip - an on-chip usart in this case.
  108.   sets up for 8 bits, no parity and one stop bit on both
  109.   transmit and receive, and allows character transmission
  110.   with CTS low. Also sets RTS line high. }
  111.  
  112.   begin
  113.     port[cntla0] := $74;   {sets RTS high}
  114.   end;
  115.  
  116. procedure clearmodem;
  117. {Sets modem for auto-answer, DCD line (switch six up)as carrier detect,
  118. no command echo.  The direct aproach here is the only one that works
  119. reliably.  I've tried the xmitchar route, and it works occasionally -
  120. very unreliable.             AJC}
  121.  
  122.   begin
  123.     write(aux,'ATS0=1',#13);
  124.     delay(500);
  125.     write(aux,'S0=1',#13);
  126.     delay(500);
  127.     write(aux,'M0 Q1 ',#13);
  128.     writeln;
  129.     write('Delaying...');
  130.     delay(1000); {Delays while modem digests initialization codes}
  131.     writeln;
  132.   end;
  133.  
  134. procedure setup;
  135.  
  136. {Hardware initializion for system to start BBS program}
  137.  
  138.   begin
  139.     setbaud(fast);
  140.     clearSIO;
  141.     clearmodem;
  142.   end;
  143.  
  144. function badframe: boolean;
  145.  
  146. {Indicates Framing Error on serial I/O chip - return false if not available.}
  147. {Reads PE bit in stat0      AJC}
  148.   begin
  149.     badframe := (port[stat0] and $ef) = 1;
  150.   end;
  151.  
  152. procedure dropRTS;
  153.  
  154. {Since the only way to control the Hayes modem on my system without
  155. crossing pins 6 and 8 on the cable is by direct order to the modem I
  156. have written these two procedures accordingly.  For consistency I have
  157. retained the names            AJC   }
  158.  
  159.   begin
  160.        write(aux,'ATS0=0',#13);
  161.        delay(1000);
  162.   end;
  163.  
  164.  
  165. procedure setlocal;
  166.  
  167. {Sets local flag true and inhibits modem auto-answer}
  168.  
  169.   begin
  170.     setbaud(fast);
  171.     dropRTS; {Inhibits Hayes auto-answer}
  172.     local := true;
  173.   end;
  174.  
  175. procedure clearlocal;
  176.  
  177. {Clears local flag and allows modem auto-answer}
  178.  
  179.   begin
  180.     setbaud(fast);
  181.     clearmodem;
  182.     local := false;
  183.   end;
  184.  
  185. procedure unload;
  186.  
  187. {Halts Kaypro disk drives - normally they run for about 15 secs. This is
  188. not a problem, as I am running the system on the RAM disk.  It would be
  189. simple to implement for 180 by programming the CSIO ports as in the Hitachi
  190. manual                  AJC}
  191.  
  192.   begin
  193.   end;
  194.  
  195. procedure dispcaller;
  196.  
  197. {Displays caller's name on protected 25th line of host CRT;
  198.  Replace with empty procedure if not desired.  On my Qume terminal I
  199. cannot do this.  I need a relatively difficult procedure to set up a
  200. status line and enable normal scrolling.  I'll get round to this later. AJC}
  201.  
  202.   begin
  203.   end;
  204.  
  205. procedure hangup;
  206.  
  207. {Signals modem to hang up - in this case by using Hayes controls.}
  208.  
  209.   begin
  210.     if cts then lineout('--- Disconnected ---' + cr + lf);
  211.     delay(2000);
  212.     write(aux,'+++');
  213.     delay(2000);
  214.     write(aux,'ATH',#13);
  215.     if local then clearlocal else repeat until not cts;
  216.   end;
  217.  
  218. {Real-time clock support begins here - this routine is called
  219.  even if there is NO clock, so leave it and set clockin accordingly}
  220. {I have no clock, but might be able to fake it with the timer utility
  221. that comes with the SB 180.  Another project for later.  AJC}
  222. const
  223.   rtca    = $20;  {Kaypro 4/84 and (modified) Kaypro 2/84 }
  224.   rtcs    = $22;  {real-time clock control registers: will}
  225.   rtcd    = $24;  {differ significantly on other hardware.}
  226.  
  227. procedure clock(var month,date,hour,min,sec: byte);
  228.  
  229. {Returns with month in range 1(Jan)..12(Dec),
  230.  date in 1..length of month, hour in 0..23 (24-hr clock),
  231.  minute and second in 0..59}
  232.  
  233.   var
  234.     temp: byte;
  235.  
  236.   function bcd_to_dec(bcd: byte): byte;
  237.  
  238.   {Converts 2-digit/byte BCD to decimal}
  239.  
  240.     begin
  241.       bcd_to_dec := (bcd and 15) + 10 * (bcd div 16);
  242.     end;
  243.  
  244.   function inport(loc: byte): byte;
  245.  
  246.   {Reads Kaypro clock port data from register loc}
  247.  
  248.     begin
  249.       port[rtca] := loc;
  250.       inport := bcd_to_dec(port[rtcd]);
  251.     end;
  252.  
  253.   procedure setupclock;
  254.  
  255.   {Sets Kaypro internal I/O port to address clock}
  256.  
  257.     var
  258.       junk: byte;
  259.  
  260.     begin
  261.       port[rtcs] := $CF;
  262.       port[rtcs] := $E0;
  263.       port[rtcs] := $03;
  264.       junk := inport($14);
  265.     end;
  266.  
  267.   begin
  268.     if clockin then begin
  269.       setupclock;
  270.       repeat
  271.         sec   := inport(2);
  272.         min   := inport(3);
  273.         hour  := inport(4);
  274.         date  := inport(6);
  275.         month := inport(7);
  276.         temp  := inport(2);
  277.       until temp = sec; {Make sure clock hasn't changed during reading}
  278.     end;
  279.   end;
  280. t(7);
  281.         temp  := inport(2);
  282.       until temp = sec; {Make sure clock hasn't changed during reading}
  283.     end;