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