home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / packet / kam300 / kam-io.pas < prev    next >
Pascal/Delphi Source File  |  1988-04-06  |  16KB  |  531 lines
  1. { global declarations }
  2.  
  3. const
  4.   UART_THR = $00;    { offset from base of UART Registers for IBM PC }
  5.   UART_RBR = $00;
  6.   UART_IER = $01;
  7.   UART_IIR = $02;
  8.   UART_LCR = $03;
  9.   UART_MCR = $04;
  10.   UART_LSR = $05;
  11.   UART_MSR = $06;
  12.  
  13.   I8088_IMR = $21;   { port address of the Interrupt Mask Register }
  14.  
  15.   COM1_Base = $03F8;  { port addresses for the UART }
  16.   COM2_Base = $02F8;
  17.  
  18.   COM1_Irq = 4;  { Interrupt line for the UART }
  19.   COM2_Irq = 3;
  20.  
  21.   Async_Buffer_Max = $0FFF;
  22.  
  23. var
  24.   Async_Buffer       : Array[0..Async_Buffer_Max] of char;
  25.   Async_Open_Flag    : Boolean;   { true if Open but no Close }
  26.   Async_Port         : Integer;   { current Open port number (1 or 2) }
  27.   Async_Base         : Integer;   { base for current open port }
  28.   Async_Irq          : Integer;   { irq for current open port }
  29.  
  30.   Async_Buffer_Overflow : Boolean;  { True if buffer overflow has happened }
  31.   Async_Buffer_Used     : Integer;
  32.   Async_MaxBufferUsed   : Integer;
  33.  
  34.     { Async_Buffer is empty if Head = Tail }
  35.   Async_Buffer_Head  : Integer;   { Locn in Async_Buffer to put next char }
  36.   Async_Buffer_Tail  : Integer;   { Locn in Async_Buffer to get next char }
  37.   Async_Buffer_NewTail : Integer;
  38.  
  39. const
  40.   Async_Num_Bauds = 8;
  41.   Async_Baud_Table : array [1..Async_Num_Bauds] of record
  42.                                                      Baud, Bits : integer
  43.                                                    end
  44.                    = ((Baud:110;  Bits:$00),
  45.                       (Baud:150;  Bits:$20),
  46.                       (Baud:300;  Bits:$40),
  47.                       (Baud:600;  Bits:$60),
  48.                       (Baud:1200; Bits:$80),
  49.                       (Baud:2400; Bits:$A0),
  50.                       (Baud:4800; Bits:$C0),
  51.                       (Baud:9600; Bits:$E0));
  52.  
  53. {----------------------------------------------------------------------}
  54. { Issue Interrupt $14 to initialize the UART                           }
  55. { See the IBM PC Technical Reference Manual for the format of ComParm  }
  56. {----------------------------------------------------------------------}
  57.  
  58. procedure BIOS_RS232_Init(ComPort, ComParm : Integer);
  59. var
  60.   Regs : Registers;
  61. begin
  62.   with Regs do
  63.     begin
  64.       ax := ComParm AND $00FF;  { AH=0; AL=ComParm }
  65.       dx := ComPort;
  66.       Intr($14, Regs)
  67.     end
  68. end; { BIOS_RS232_Init }
  69.  
  70. {----------------------------------------------------------------------}
  71. { call DOS to set an interrupt vector                                  }
  72. {----------------------------------------------------------------------}
  73.  
  74. procedure DOS_Set_Intrpt(v, s, o : integer);
  75. var
  76.   Regs : Registers;
  77. begin
  78.   with Regs do
  79.     begin
  80.       ax := $2500 + (v AND $00FF);
  81.       ds := s;
  82.       dx := o;
  83.       MsDos(Regs)
  84.     end
  85. end; { DOS_Set_Intrpt }
  86.  
  87. {----------------------------------------------------------------------}
  88. {                                                                      }
  89. {  ASYNCISR.INC - Interrupt Service Routine                            }
  90. { Invoked when the UART has received a byte of data from the           }
  91. {  communication line                                                  }
  92. {                                                                      }
  93. {----------------------------------------------------------------------}
  94.  
  95. procedure Async_Isr;
  96. interrupt;
  97. begin
  98.  
  99.   Inline(
  100.     $FB/                           { STI }
  101.       { get the incoming character }
  102.       { Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); }
  103.     $8B/$16/Async_Base/            { MOV DX,Async_Base }
  104.     $EC/                           { IN AL,DX }
  105.     $8B/$1E/Async_Buffer_Head/     { MOV BX,Async_Buffer_Head }
  106.     $88/$87/Async_Buffer/          { MOV Async_Buffer[BX],AL }
  107.       { Async_Buffer_NewHead := Async_Buffer_Head + 1; }
  108.     $43/                           { INC BX }
  109.       { if Async_Buffer_NewHead > Async_Buffer_Max then
  110.           Async_Buffer_NewHead := 0; }
  111.     $81/$FB/Async_Buffer_Max/      { CMP BX,Async_Buffer_Max }
  112.     $7E/$02/                       { JLE L001 }
  113.     $33/$DB/                       { XOR BX,BX }
  114.       { if Async_Buffer_NewHead = Async_Buffer_Tail then
  115.           Async_Buffer_Overflow := TRUE
  116.         else }
  117. {L001:}
  118.     $3B/$1E/Async_Buffer_Tail/     { CMP BX,Async_Buffer_Tail }
  119.     $75/$08/                       { JNE L002 }
  120.     $C6/$06/Async_Buffer_Overflow/$01/ { MOV Async_Buffer_Overflow,1 }
  121.     $90/                           { NOP generated by assembler for some reason }
  122.     $EB/$16/                       { JMP SHORT L003 }
  123.       { begin
  124.           Async_Buffer_Head := Async_Buffer_NewHead;
  125.           Async_Buffer_Used := Async_Buffer_Used + 1;
  126.           if Async_Buffer_Used > Async_MaxBufferUsed then
  127.             Async_MaxBufferUsed := Async_Buffer_Used
  128.         end; }
  129. {L002:}
  130.     $89/$1E/Async_Buffer_Head/     { MOV Async_Buffer_Head,BX }
  131.     $FF/$06/Async_Buffer_Used/     { INC Async_Buffer_Used }
  132.     $8B/$1E/Async_Buffer_Used/     { MOV BX,Async_Buffer_Used }
  133.     $3B/$1E/Async_MaxBufferUsed/   { CMP BX,Async_MaxBufferUsed }
  134.     $7E/$04/                       { JLE L003 }
  135.     $89/$1E/Async_MaxBufferUsed/   { MOV Async_MaxBufferUsed,BX }
  136. {L003:}
  137.       { disable interrupts }
  138.     $FA/                           { CLI }
  139.       { Port[$20] := $20; }  { use non-specific EOI }
  140.     $B0/$20/                       { MOV AL,20h }
  141.     $E6/$20 )                      { OUT 20h,AL }
  142. end; { Async_Isr }
  143.  
  144. {----------------------------------------------------------------------}
  145. {      Async_Init                                                      }
  146. {      Performs initialization.                                        }
  147. {----------------------------------------------------------------------}
  148.  
  149. procedure Async_Init;
  150. begin
  151.   Async_Open_Flag := FALSE;
  152.   Async_Buffer_Overflow := FALSE;
  153.   Async_Buffer_Used := 0;
  154.   Async_MaxBufferUsed := 0;
  155. end; { Async_Init }
  156.  
  157. {----------------------------------------------------------------------}
  158. { Async_Close                                                          }
  159. { Turn off the COM port interrupts.                                    }
  160. { reset the interrupt system when UART interrupts no longer needed     }
  161. {----------------------------------------------------------------------}
  162.  
  163. procedure Async_Close;
  164. var
  165.   i, m : Integer;
  166. begin
  167.   if Async_Open_Flag then          { disable the IRQ on the 8259 }
  168.     begin
  169.       Inline($FA);                 { disable interrupts }
  170.       i := Port[I8088_IMR];        { get the interrupt mask register }
  171.       m := 1 shl Async_Irq;        { set mask to turn off interrupt }
  172.       Port[I8088_IMR] := i OR m;
  173.                                    { disable the 8250 data ready interrupt }
  174.       Port[UART_IER + Async_Base] := 0;
  175.                                    { disable OUT2 on the 8250 }
  176.       Port[UART_MCR + Async_Base] := 0;
  177.       Inline($FB);                 { enable interrupts }
  178.       Async_Open_Flag := FALSE     { so we know the port is closed }
  179.     end
  180. end; { Async_Close }
  181.  
  182. {----------------------------------------------------------------------}
  183. {      Async_Open(Port, Baud : Integer;                                }
  184. {               Parity : Char;                                         }
  185. {               WordSize, StpBits : Integer) : Boolean                 }
  186. {      Sets up interrupt vector, initialies the COM port for           }
  187. {      processing, sets pointers to the buffer.  Returns FALSE if COM  }
  188. {      port not installed.                                             }
  189. {----------------------------------------------------------------------}
  190.  
  191. function Async_Open(ComPort       : Integer;
  192.                     BaudRate      : Integer;
  193.                     Parity        : Char;
  194.                     WordSize      : Integer;
  195.                     StopBits      : Integer): boolean;
  196. var
  197.   ComParm : Integer;
  198.   i, m : Integer;
  199. begin
  200.   if Async_Open_Flag then Async_Close;
  201.  
  202.   if ComPort = 2 then
  203.     begin
  204.       Async_Port := 2;
  205.       Async_Base := COM2_Base;
  206.       Async_Irq  := COM2_Irq
  207.     end
  208.   else
  209.     begin
  210.       Async_Port := 1;  { default to COM1 }
  211.       Async_Base := COM1_Base;
  212.       Async_Irq  := COM1_Irq
  213.     end;
  214.  
  215.   if (Port[UART_IIR + Async_Base] AND $00F8) <> 0
  216.   then
  217.     Async_Open := FALSE
  218.   else
  219.     begin
  220.  
  221.       Async_Buffer_Head := 0;
  222.       Async_Buffer_Tail := 0;
  223.       Async_Buffer_Overflow := FALSE;
  224.  
  225.   { Build the ComParm for RS232_Init }
  226.   { See Technical Reference Manual for description }
  227.  
  228.       ComParm := $0000;
  229.  
  230.   { Set up the bits for the baud rate }
  231.       i := 0;
  232.       repeat
  233.         i := i + 1
  234.       until (Async_Baud_Table[i].Baud = BaudRate) OR (i = Async_Num_Bauds);
  235.       ComParm := ComParm OR Async_Baud_Table[i].Bits;
  236.  
  237.       if Parity in ['E', 'e'] then ComParm := ComParm OR $0018
  238.       else if Parity in ['O', 'o'] then ComParm := ComParm OR $0008
  239.       else ComParm := ComParm OR $0000;  { default to No parity }
  240.  
  241.       if WordSize = 7
  242.         then ComParm := ComParm OR $0002
  243.         else ComParm := ComParm OR $0003;  { default to 8 data bits }
  244.  
  245.       if StopBits = 2
  246.         then ComParm := ComParm OR $0004
  247.         else ComParm := ComParm OR $0000;  { default to 1 stop bit }
  248.  
  249.   { use the BIOS COM port initialization routine to save typing the code }
  250.       BIOS_RS232_Init(Async_Port - 1, ComParm);
  251.  
  252.       DOS_Set_Intrpt(Async_Irq + 8, CSeg, Ofs(Async_Isr));
  253.  
  254.   { read the RBR and reset any possible pending error conditions }
  255.   { first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }
  256.  
  257.       Inline($FA);  { disable interrupts }
  258.  
  259.       Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] AND $7F;
  260.   { read the Line Status Register to reset any errors it indicates }
  261.       i := Port[UART_LSR + Async_Base];
  262.   { read the Receiver Buffer Register in case it contains a character }
  263.       i := Port[UART_RBR + Async_Base];
  264.  
  265.   { enable the irq on the 8259 controller }
  266.       i := Port[I8088_IMR];  { get the interrupt mask register }
  267.       m := (1 shl Async_Irq) XOR $00FF;
  268.       Port[I8088_IMR] := i AND m;
  269.  
  270.   { enable the data ready interrupt on the 8250 }
  271.       Port[UART_IER + Async_Base] := $01; { enable data ready interrupt }
  272.  
  273.   { enable OUT2 on 8250 }
  274.       i := Port[UART_MCR + Async_Base];
  275.       Port[UART_MCR + Async_Base] := i OR $08;
  276.  
  277.       Inline($FB); { enable interrupts }
  278.       Async_Open_Flag := TRUE;  { bug fix by Scott Herr }
  279.       Async_Open := TRUE;
  280.   end;
  281. end; { Async_Open }
  282.  
  283. {----------------------------------------------------------------------}
  284. {      Transmits the character.                                        }
  285. {----------------------------------------------------------------------}
  286.  
  287. procedure kam_out(C : char);
  288. var
  289.   i, m, counter : Integer;
  290. begin
  291.   Port[UART_MCR + Async_Base] := $0B; { turn on OUT2, DTR, and RTS }
  292.  
  293.   { wait for CTS }
  294.   counter := MaxInt;
  295.   while (counter <> 0) AND ((Port[UART_MSR + Async_Base] AND $10) = 0) do
  296.     counter := counter - 1;
  297.  
  298.   { wait for Transmit Hold Register Empty (THRE) }
  299.   if counter <> 0 then  counter := MaxInt;
  300.   while (counter <> 0) AND ((Port[UART_LSR + Async_Base] AND $20) = 0) do
  301.     counter := counter - 1;
  302.  
  303.   if counter <> 0 then
  304.     begin
  305.       { send the character }
  306.       Inline($FA); { disable interrupts }
  307.       Port[UART_THR + Async_Base] := Ord(C);
  308.       Inline($FB) { enable interrupts }
  309.     end
  310.   else
  311.     begin
  312.       Async_close;
  313.       restore_entry_screen;
  314.       writeln('COM',xmt_port:1,' has timed out.');
  315.       writeln('Check KAM for power on and/or proper operation.');
  316.       halt;
  317.     end;
  318. end;
  319.  
  320. {----------------------------------------------------------------------}
  321. {      Remove Character From Interrupt Driven Buffer                   }
  322. {----------------------------------------------------------------------}
  323.  
  324. function kam_in: char;
  325. begin
  326.   kam_in := Async_Buffer[Async_Buffer_Tail];
  327.   Async_Buffer_Tail := (Async_Buffer_Tail + 1) AND Async_Buffer_Max;
  328.   Async_Buffer_Used := Async_Buffer_Used - 1;
  329. end;
  330.  
  331. {----------------------------------------------------------------------}
  332. {      If a character is available, returns TRUE and moves the         }
  333. {        character from the buffer to the parameter                    }
  334. {      Otherwise, returns FALSE                                        }
  335. {----------------------------------------------------------------------}
  336.  
  337. function char_ready:boolean;
  338. begin
  339.   if (Async_Buffer_Head = Async_Buffer_Tail)
  340.     then char_ready := FALSE
  341.     else char_ready := TRUE;
  342. end;
  343.  
  344. procedure clear_buffer;
  345. var c : char;
  346. begin
  347.   delay(25);
  348.   while char_ready do
  349.   begin
  350.     c := kam_in;
  351.     if (mode = CW) then delay(15);
  352.   end;
  353. end;
  354.  
  355. procedure kam_cmd(s : msg_type);
  356. var i : integer;
  357. begin
  358.   for i := 1 to length(s) do
  359.     kam_out(s[i]);
  360.   delay(50);
  361. end;
  362.  
  363. procedure kam_cmd_CR(s : msg_type);
  364. begin
  365.   kam_cmd(s + #13);
  366. end;
  367.  
  368. procedure xmt_mode;
  369. begin
  370.   xmt_ON := TRUE;
  371.   last_char_sent := #00;
  372.   kam_cmd(^C'T');
  373.   clear_buffer;
  374.   case mode of
  375.     CW : ;
  376.     RTTY, ASCII : if xmt_on_delay > 0 then
  377.                     delay(xmt_on_delay * 100);
  378.   end;
  379. end;
  380.  
  381. procedure cw_status;
  382. var  status_str : string[7];
  383.      i : integer;
  384. begin
  385.   status_str := '        ';
  386.   repeat
  387.     for i := 1 to 6 do
  388.       status_str[i] := status_str[i + 1];
  389.     delay(15);
  390.     repeat until char_ready;
  391.     status_str[7] := kam_in;
  392.   until (status_str[1] = '-');
  393.   if (status_str[7] = '-') then
  394.     rcv_wpm := copy(status_str,5,2);
  395. end;
  396.  
  397. procedure rcv_stat;
  398. begin
  399.   kam_cmd(^C'R');
  400.   case mode of
  401.     ASCII : clear_buffer;
  402.     RTTY  : clear_buffer;
  403.     CW    : cw_status;
  404.   end;
  405. end;
  406.  
  407. procedure rcv_mode;
  408. begin
  409.   xmt_ON := FALSE;
  410.   rcv_stat;
  411. end;
  412.  
  413.  
  414. procedure set_rtty_baud;
  415. begin
  416.   kam_cmd(^C'R');
  417.   kam_cmd(^C + chr(49+baud));
  418.   clear_buffer;
  419.   if xmt_ON then xmt_mode;
  420. end;
  421.  
  422. procedure mod_rtty_invert;
  423. begin
  424.   kam_cmd(^C'R');
  425.   kam_cmd(^C'I');
  426.   invert := NOT invert;
  427.   clear_buffer;
  428.   if xmt_ON then xmt_mode;
  429. end;
  430.  
  431. procedure set_rtty_shift;
  432. begin
  433.   kam_cmd(^C'R');
  434.   kam_cmd(^C'S');
  435.   clear_buffer;
  436.   if xmt_on then xmt_mode;
  437. end;
  438.  
  439. procedure cw_mode;
  440. begin
  441.   mode := CW;
  442.   kam_cmd_CR('CW ' + xmt_wpm);
  443.   cw_status;
  444. end;
  445.  
  446. procedure kam_xmt_wpm;
  447. begin
  448.   kam_cmd(^C'X');
  449.   clear_buffer;
  450.   cw_mode;
  451.   if xmt_ON then
  452.     kam_cmd(^C'T');
  453. end;
  454.  
  455. procedure rtty_mode;
  456. begin
  457.   baud := 0;
  458.   mode := RTTY;
  459.   kam_cmd_CR('RB ' + baud_rate[baud] );  clear_buffer;
  460.   kam_cmd_CR('SH ' + rtty_shift[shift]); clear_buffer;
  461.   kam_cmd_CR('INVERT OFF');              clear_buffer;
  462.   kam_cmd_CR('CRAdd ON');                clear_buffer;
  463.   kam_cmd_CR('LF ON');                   clear_buffer;
  464.   kam_cmd_CR('DIDdle ON');               clear_buffer;
  465.   kam_cmd_CR('R');                       clear_buffer;
  466. end;
  467.  
  468. procedure ascii_mode;
  469. begin
  470.   baud := 5;
  471.   mode := ASCII;
  472.   kam_cmd_CR('ASCB ' + baud_rate[baud] ); clear_buffer;
  473.   kam_cmd_CR('INVERT OFF');               clear_buffer;
  474.   kam_cmd_CR('CRAdd ON');                 clear_buffer;
  475.   kam_cmd_CR('LF ON');                    clear_buffer;
  476.   kam_cmd_CR('A');                        clear_buffer;
  477. end;
  478.  
  479. procedure select_mode;
  480. begin
  481.   aux_color;
  482.   frame(28,10,53,16);
  483.   window(29,11,52,15);
  484.   clrscr;
  485.   writeln(' Select     <1>  CW');
  486.   writeln('            <2>  RTTY');
  487.   writeln('            <3>  ASCII');
  488.   writeln;
  489.     write('          ....');
  490.   repeat key := readkey until key in ['1'..'3'];
  491.   case key of
  492.     '1' : cw_mode;
  493.     '2' : rtty_mode;
  494.     '3' : ascii_mode;
  495.   end;
  496. end;
  497.  
  498. procedure new_mode;
  499. begin
  500.   kam_cmd(^C'X');
  501.   clear_buffer;
  502.   save_screen;
  503.   select_mode;
  504.   restore_screen;
  505. end;
  506.  
  507. procedure init_interface;
  508. begin
  509.   Async_Init;
  510.   if (Async_Open(xmt_port, kam_baud_rate, 'N', 8, 1) = FALSE) then
  511.   begin
  512.     restore_entry_screen;
  513.     Writeln('COM',xmt_port:1,' not installed.');
  514.     halt;
  515.   end;
  516.   writeln('Initializing KAM interface');
  517.   kam_cmd_CR('XOFF 0'); clear_buffer;
  518.   kam_cmd_CR('XON 0');  clear_buffer;
  519.   kam_cmd_CR('E OFF');  clear_buffer;
  520.   kam_cmd_CR('XM ON');  clear_buffer;
  521.   select_mode;
  522. end;
  523.  
  524. procedure reset_kam;
  525. begin
  526.   kam_cmd(^C'X');
  527.   clear_buffer;
  528.   Async_close;
  529. end;
  530.  
  531.