home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / BBS / TV803.MCH < prev    next >
Text File  |  2000-06-30  |  8KB  |  261 lines
  1. { ROS.MCH - Remote Operating System Machine Dependent Routines }
  2.  
  3. { File:        TV803.MCH
  4.   Description: This driver set is designed to support the Televideo 803.
  5.   Date:        4/27/87
  6.   Author:      Darrell Pittman
  7. }
  8.  
  9. {** System routines **}
  10.  
  11. procedure putstat(st: StrStd);
  12. { Display 'st' on status line }
  13.   const
  14.     status_line  = 25;
  15.     last_line    = 24;
  16.   begin
  17.     GotoXY( 1, status_line );
  18.     LowVideo;
  19.     writeln( st );
  20.     HighVideo;
  21.     GotoXY( 1, last_line );
  22.   end;
  23.  
  24. {** Remote channel routines **}
  25.  
  26. const
  27.  
  28.   BASE      = $20;                  {base address of Z80 STI}
  29.   DATA      = $2F;                  {data register}
  30.   RSTAT     = $2D;                  {receiver status register}
  31.   TSTAT     = $2E;                  {transmitter status register}
  32.   CTRL      = $2C;                  {control register}
  33.   GPIP      = $21;                  {general purpose I/O interrupt}
  34.   PVR       = $28;                  {pointer vector register}
  35.   IDR       = $20;                  {indirect data register}
  36.   IMRB      = $26;                  {interrupt mask}
  37.   IMRA      = $25;                  {interrupt mask a}
  38.   TABCR     = $29;                  {timer A and B data register}
  39.   TBDR      = $2A;                  {timer B data register}
  40.   TADR      = $2B;                  {timer A data register}
  41.  
  42.   { masks for GPIP port }
  43.   GPIP_NOCARRIER = $01;             { bit 0 set if no carrier }
  44.   GPIP_DTRHI  = $00;                { set DTR high }
  45.   GPIP_DTRLOW = $20;                { set DTR low  }
  46.  
  47.   { masks for TSTAT port}
  48.   TSTAT_TRDY= $80;                  {bit 7 set if transmitter ready}
  49.  
  50.   { masks for RSTAT port}
  51.   RSTAT_RRDY= $80;                  {bit 7 set if receiver ready}
  52.  
  53.   IERB      = $04;                  {interrupt enable register B}
  54.   IERA      = $05;                  {interrupt enable register A}
  55.   DDR       = $06;                  {data direction register}
  56.  
  57.   EOS       = '$';                  {end of string}
  58.  
  59.   {baud rate constants                           }
  60.   {  ...clock tick counters for the TADR register}
  61.   BD75      = $80;
  62.   BD150     = $40;
  63.   BD300     = $20;
  64.   BD600     = $10;
  65.   BD1200    = $08;
  66.   BD2400    = $04;
  67.   BD4800    = $02;
  68.   BD9600    = $01;
  69.  
  70. var
  71.   cr3       : byte;                 {byte to save bits-parity-stop.        }
  72.   mask      : byte;                 {masks input chars according to parity }
  73.  
  74. procedure cr3on( mask : byte );
  75.   begin
  76.     cr3 := cr3 or mask;
  77.     port[CTRL] := cr3;
  78.   end;
  79.  
  80. procedure cr3off( mask : byte );
  81.   begin
  82.     cr3 := cr3 and (not mask);
  83.     port[CTRL] := cr3;
  84.   end;
  85.  
  86. procedure ch_setparity( code : byte );
  87. { set parity.  "code" must be either 0 (no parity), 1 (odd), or 2 (even)}
  88.   begin
  89.     case code of
  90.       0:   cr3off( $04 );
  91.       1:   begin
  92.              cr3off( $02 );
  93.              cr3on(  $04 );
  94.            end;
  95.       2:   begin
  96.              cr3on( $02 );
  97.              cr3on( $04 );
  98.            end;
  99.       else writeln('ch_setparity>  Attempt to assign ', code, ' parity.  Ignored.');
  100.     end;
  101.   end;
  102.  
  103. procedure ch_setwordlength( bits : byte );
  104. { set number of data bits.  "bits" must be 7 or 8}
  105.   begin
  106.     case bits of
  107.       7:   begin
  108.              cr3off( $40 );
  109.              cr3on(  $20 );
  110.              mask := $7F;
  111.            end;
  112.       8:   begin
  113.              cr3off( $60 );
  114.              mask := $FF;
  115.            end;
  116.       else writeln('ch_setwordlength>  Attempt to assign ', bits, ' data bits.  Ignored.');
  117.     end;
  118.   end;
  119.  
  120. procedure ch_setstopbits( bits : byte );
  121. { set number of stop bits.  "bits" must be either 1 or 2 }
  122.   begin
  123.     case bits of
  124.       1:   cr3off( $10 );
  125.       2:   cr3on(  $10 );
  126.       else writeln( 'ch_setstopbits> Attempt to assign ', bits, 'stop bits.  Ignored.');
  127.     end;
  128.   end;
  129.  
  130. procedure ch_init;
  131. { Initialize the remote channel }
  132.   begin
  133.  
  134.     port[PVR]  := ( IERB or $60 );  {clear interrupt enables}
  135.     port[IDR]  := $10;              {send through indirect register}
  136.     port[PVR]  := ( IERA or $60 );
  137.     port[IDR]  := $00;              {clear second set}
  138.  
  139.     port[IMRA] := $DE;              {permit only timer A interrupt}
  140.     port[IMRB] := $30;              {permit only timers C & D}
  141.  
  142.     port[PVR]  := ( DDR or  $60 );  {set data direction register}
  143.     port[IDR]  := $24;              {set direction 0=in 1=out}
  144.  
  145.     cr3        := $AE;              {save in "cr3".  Will be overridden}
  146.     port[CTRL] := cr3;              {set x16 clock, and other unneeded stuff}
  147.     ch_setwordlength( 8 );          {set to 8-bit data length}
  148.     ch_setparity( 0 );              {set to no parity}
  149.     ch_setstopbits( 1 );            {set number of stop bits)
  150.  
  151.     port[RSTAT] := $01;             {enable receiver}
  152.     port[TSTAT] := $01;             {enable transmitter}
  153.  
  154.     port[GPIP]  := $84;             {set RTS}
  155.  
  156.   end;
  157.  
  158. procedure ch_on;
  159. { Turn on remote channel (usually by enabling DTR) }
  160.   begin
  161.     port[GPIP] := GPIP_DTRHI;
  162.     delay(250);
  163.   end;
  164.  
  165. procedure ch_off;
  166. { Turn off remote channel (usually by disabling DTR) }
  167.   begin
  168.     port[GPIP] := GPIP_DTRLOW;
  169.     delay(250)
  170.   end;
  171.  
  172. function ch_carck: boolean;
  173. { Check to see if carrier is present }
  174.   begin
  175.     ch_carck := (port[GPIP] and GPIP_NOCARRIER) = 0;
  176.   end;
  177.  
  178. function ch_inprdy: boolean;
  179. { Check for ready to input from port }
  180.   begin
  181.     ch_inprdy := ( port[RSTAT] and RSTAT_RRDY ) <> 0;
  182.   end;
  183.  
  184. function ch_inp: byte;
  185. { Input a byte from port - no wait - assumed ready }
  186.   begin
  187.     ch_inp := port[DATA] and mask;
  188.   end;
  189.  
  190. function ch_outrdy : boolean;
  191. { Check for ready to output to port}
  192.   begin
  193.     ch_outrdy := ( port[TSTAT] and TSTAT_TRDY ) <> 0;
  194.   end;
  195.  
  196. procedure ch_out(bt: byte);
  197. { Output a byte to port - wait until ready }
  198.   begin
  199.  
  200.     repeat
  201.     until ch_outrdy;                 {wait until transmitter is ready}
  202.  
  203.     port[DATA] := bt;                {...then output}
  204.  
  205.   end;
  206.  
  207. procedure ch_set(r: integer);
  208. { Set the bps rate }
  209.  
  210.   procedure setbrx( r : integer; code : byte );
  211.   {called when supportability of requested baud rate establised}
  212.   {sets global baud rate indicator "rate"                      }
  213.     begin
  214.  
  215.       rate := r;                         {save new baud rate setting}
  216.  
  217.       port[RSTAT] := $00;                {off receiver}
  218.       port[TSTAT] := $00;                {off transmitter}
  219.       port[TABCR] := $00;                {off counters A & B}
  220.  
  221.       port[TADR]  := code;               {set channel A data register}
  222.       port[TABCR] := $11;                {  ... on both counters}
  223.  
  224.       port[RSTAT] := $01;                {on receiver}
  225.       port[TSTAT] := $01;                {on transmitter}
  226.  
  227.     end;
  228.  
  229.   begin
  230.     case r of
  231.         75: setbrx( r, BD75   );
  232.        150: setbrx( r, BD150  );
  233.        300: setbrx( r, BD300  );
  234.        600: setbrx( r, BD600  );
  235.       1200: setbrx( r, BD1200 );
  236.       2400: setbrx( r, BD2400 );
  237.       4800: setbrx( r, BD4800 );
  238.       9600: setbrx( r, BD9600 );
  239.       else  writeln( 'ch_set> Unsupported baud rate ', r, ' ignored.' + BEL);
  240.     end;
  241.   end;
  242.  
  243. procedure system_init;
  244. { Initialization to be done once when ROS first starts }
  245.   begin
  246.     ch_off;        {drop DTR}
  247.     delay(1000);
  248.     ch_on;         {raise DTR}
  249.     delay(1000);
  250.   end;
  251.  
  252. procedure system_de_init;
  253. { De-initialization to be done once when ROS terminates }
  254.   begin
  255.     ch_off;        {drop DTR}
  256.     delay(1000);
  257.     ch_on;         {raise DTR}
  258.     putstat('');   {clear status line}
  259.   end;
  260.  
  261.