home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / c / caty16.zip / CATYCOMM.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-07  |  16KB  |  400 lines
  1. UNIT CATYCOMM; (* Interrupt driven Serial Comm - D. J. Wilke 1/12/91 *)
  2.  
  3. INTERFACE
  4.  
  5. USES CRT, DOS, CATYGLO, CATYUTIL, CATYDISP;
  6.  
  7. PROCEDURE EnableInterrupts;
  8. PROCEDURE CommExitProc;
  9. PROCEDURE SetupSerialPort(Rate : WORD; ComPort : INTEGER;
  10.           ComVec : WORD; ComBase,IRQM : INTEGER; Fun : CHAR);
  11. FUNCTION RInStat : Boolean;
  12. FUNCTION TInStat : Boolean;
  13. PROCEDURE FlushRBuffer;
  14. PROCEDURE FlushTBuffer;
  15. FUNCTION RInChar : Char;
  16. FUNCTION TInChar : Char;
  17. PROCEDURE OutChar(Ch : Char; ComBase : INTEGER);
  18. PROCEDURE NoComm;
  19. PROCEDURE BadEcho;
  20. PROCEDURE SendTString(TStr : String86);
  21. PROCEDURE SendRString(Inst : STRING5; SUS : INTEGER);
  22. PROCEDURE WhatWasThat(Param : String5; Col,Row : INTEGER);
  23. PROCEDURE CatSend(Param : String5; StatusUpdateSize : INTEGER);
  24. PROCEDURE TurnCatOn;
  25. PROCEDURE TurnCatOff;
  26.  
  27. IMPLEMENTATION
  28.  
  29. USES CATYINST;
  30.  
  31. (*═══════════════════════════════════════════════════════════════════════*)
  32. PROCEDURE EnableInterrupts;
  33. BEGIN
  34.    INLINE($FB);                              (* Int Service Routine *)
  35. END; (* EnableInterrupts *)
  36.  
  37. (*═══════════════════════════════════════════════════════════════════════*)
  38. PROCEDURE RIncoming(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word);
  39. INTERRUPT;
  40.  
  41. VAR
  42.    RBR : INTEGER;
  43.  
  44. BEGIN
  45.    EnableInterrupts;                         (* Enable ints during ISR: *)
  46.    RBR               := RComBase;            (* 8250 Receive Buffer Reg *)
  47.    IF RLastSaved >= 1023 THEN                (* Make 1K circ buffer *)
  48.       RLastSaved     := 0
  49.    ELSE Inc(RLastSaved);
  50.    RBuffer[RLastSaved] := Char(Port[RBR]);   (* Read incoming character *)
  51.    Port[OCW2]        := $20;                 (* Send EOI byte to 8259 *)
  52. END; (* RIncoming *)
  53.  
  54. (*═══════════════════════════════════════════════════════════════════════*)
  55. PROCEDURE TIncoming(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word);
  56. INTERRUPT;
  57.  
  58. VAR
  59.    RBR : INTEGER;
  60.  
  61. BEGIN
  62.    EnableInterrupts;                         (* Enable ints during ISR: *)
  63.    RBR               := TComBase;            (* 8250 Receive Buffer Reg *)
  64.    IF TLastSaved >= 1023 THEN                (* Make 1K circ buffer *)
  65.       TLastSaved     := 0
  66.    ELSE Inc(TLastSaved);
  67.    TBuffer[TLastSaved] := Char(Port[RBR]);   (* Read incoming character *)
  68.    Port[OCW2]        := $20;                 (* Send EOI byte to 8259 *)
  69. END; (* TIncoming *)
  70.  
  71. (*═══════════════════════════════════════════════════════════════════════*)
  72. {$F+}
  73. PROCEDURE CommExitProc;
  74.  
  75. VAR
  76.    ComBase    : WORD;
  77.    RBR,IER,
  78.    IRQM,MCR   : INTEGER;
  79.  
  80. BEGIN
  81.    ComBase    := RComBase;
  82.    IRQM       := RIRQM;
  83.    RBR        := ComBase;                    (* 8250 Receive Buffer Reg *)
  84.    IER        := ComBase + 1;                (* 8250 Int Enable Reg *)
  85.    MCR        := ComBase + 4;                (* 8250 Modem Control Reg *)
  86.    Port[IER]  := 0;                          (* Disable ints at 8250 *)
  87.    Port[OCW1] := Port[OCW1] OR IRQM;         (* Disable IRQ_ at 8259 *)
  88.    Port[MCR]  := 0;                          (* Bring the comm line down *)
  89.    ComBase    := TComBase;
  90.    IRQM       := TIRQM;
  91.    RBR        := ComBase;                    (* 8250 Receive Buffer Reg *)
  92.    IER        := ComBase + 1;                (* 8250 Int Enable Reg *)
  93.    MCR        := ComBase + 4;                (* 8250 Modem Control Reg *)
  94.    Port[IER]  := 0;                          (* Disable ints at 8250 *)
  95.    Port[OCW1] := Port[OCW1] OR IRQM;         (* Disable IRQ_ at 8259 *)
  96.    Port[MCR]  := 0;                          (* Bring the comm line down *)
  97.    SETINTVEC(RComVec,OldRComVec);            (* Restore prev saved Rvect *)
  98.    IF TNC THEN
  99.       SETINTVEC(TComVec,OldTComVec);         (* Restore prev saved Tvect *)
  100. END; (* CommExitProc *)
  101. {$F-}
  102.  
  103. (*═══════════════════════════════════════════════════════════════════════*)
  104. PROCEDURE SetupSerialPort(Rate         : WORD;
  105.                           ComPort      : INTEGER;
  106.                           ComVec       : WORD;
  107.                           ComBase,IRQM : INTEGER;
  108.                           Fun          : CHAR);
  109.  
  110. VAR
  111.    RBR,THR,DLL,DLM,
  112.    IER,IIR,LCR,MCR,
  113.    LSR,MSR : INTEGER;
  114.    Divisor : WORD;
  115.  
  116. BEGIN
  117.    RBR        := ComBase;                    (* 8250 Receive Buffer Reg *)
  118.    THR        := ComBase;                    (* 8250 Transm Holding Reg *)
  119.    DLL        := ComBase;                    (* 8250 Divisor Latch LSB *)
  120.    DLM        := ComBase +1;                 (* 8250 Divisor Latch MSB *)
  121.    IER        := ComBase +1;                 (* 8250 Int Enable Reg *)
  122.    IIR        := ComBase +2;                 (* 8250 Int Ident Reg *)
  123.    LCR        := ComBase +3;                 (* 8250 Line Control Reg *)
  124.    MCR        := ComBase +4;                 (* 8250 Modem Control Reg *)
  125.    LSR        := ComBase +5;                 (* 8250 Line Status Reg *)
  126.    MSR        := ComBase +6;                 (* 8250 Modem Status Reg *)
  127.    Divisor    := Rate;                       (* Baud rate *)
  128.    RLastRead  := 0;                          (* Init circ buf pointers *)
  129.    TLastRead  := 0;
  130.    RLastSaved := 0;
  131.    TLastSaved := 0;
  132.    Port[IER]  := 0;                          (* Disable ints during setup *)
  133.    IF Fun = 'R' THEN
  134.       GETINTVEC(RComVec,OldRComVec);         (* Save old radio IRQ vector *)
  135.    IF Fun = 'T' THEN
  136.       GETINTVEC(TComVec,OldTComVec);         (* Save old TNC IRQ vector *)
  137.    ExitProc   := @CommExitProc;              (* Hook exit proc into chain *)
  138.    IF Fun = 'R' THEN
  139.       SETINTVEC(RComVec,@RIncoming);         (* Radio ISR addr in vec tbl *)
  140.    IF Fun = 'T' THEN
  141.       SETINTVEC(TComVec,@TIncoming);         (* TNC ISR addr in vec tbl *)
  142.    Port[LCR]  := Port[LCR] OR DLAB;          (* Set up 8250 for baud rate *)
  143.    Port[DLL]  := Lo(Divisor);                (* Set baud rate divisor *)
  144.    Port[DLM]  := Hi(Divisor);
  145.    IF Fun = 'R' THEN
  146.       Port[LCR]  := RDataBits OR RStopBits;  (* Set Radio word len/stop *)
  147.    IF Fun = 'T' THEN
  148.       Port[LCR] := TDataBits OR TStopBits;   (* Set TNC word len/stop *)
  149.    Port[LCR]  := Port[LCR] OR RParity;       (* Set Radio parity *)
  150.    IF TNC THEN
  151.       Port[LCR] := Port[LCR] OR TParity;     (* Set TNC parity *)
  152.    Port[MCR]  := DTR OR RTS OR OUT2;         (* Enable DTR/RTS/adapter *)
  153.    Port[OCW1] := Port[OCW1] AND (NOT IRQM);  (* Turn on 8259 IRQ_ ints *)
  154.    Clearit    := Port[RBR];                  (* Clear garbage from RBR *)
  155.    Clearit    := Port[LSR];                  (* Clear garbage from LSR *)
  156.    Port[IER]  := $01;                        (* Enable int on rcd char *)
  157. END; (* SetupSerialPort *)
  158.  
  159. (*═══════════════════════════════════════════════════════════════════════*)
  160. FUNCTION RInStat : Boolean;
  161.  
  162. BEGIN
  163.    IF RLastSaved <> RLastRead THEN           (* Radio buffer status flag *)
  164.       RInStat   := True
  165.    ELSE RInStat := False;
  166. END; (* FUNCTION RInStat *)
  167.  
  168. (*═══════════════════════════════════════════════════════════════════════*)
  169. FUNCTION TInStat : Boolean;
  170.  
  171. BEGIN
  172.    IF TLastSaved <> TLastRead THEN           (* TNC buffer status flag *)
  173.       TInStat   := True
  174.    ELSE TInStat := False;
  175. END; (* FUNCTION TInStat *)
  176.  
  177. (*═══════════════════════════════════════════════════════════════════════*)
  178. PROCEDURE FlushRBuffer;
  179.  
  180. VAR
  181.    RBR : INTEGER;
  182.  
  183. BEGIN
  184.    RBR        := RComBase;                   (* 8250 Receive Buffer Reg *)
  185.    RLastRead  := 0;
  186.    RLastSaved := 0;
  187.    Clearit    := Port[RBR];                  (* Clear garbage from RBR *)
  188.    FILLCHAR(RBuffer,SIZEOF(RBuffer),0);
  189. END; (* FlushRBuffer *)
  190.  
  191. (*═══════════════════════════════════════════════════════════════════════*)
  192. PROCEDURE FlushTBuffer;
  193.  
  194. VAR
  195.    RBR : INTEGER;
  196.  
  197. BEGIN
  198.    RBR        := TComBase;                   (* 8250 Receive Buffer Reg *)
  199.    TLastRead  := 0;
  200.    TLastSaved := 0;
  201.    Clearit    := Port[RBR];                  (* Clear garbage from RBR *)
  202.    FILLCHAR(TBuffer,SIZEOF(TBuffer),0);
  203. END; (* FlushTBuffer *)
  204.  
  205. (*═══════════════════════════════════════════════════════════════════════*)
  206. FUNCTION RInChar : Char;                     (* Nxt chr fr radio buf *)
  207.  
  208. BEGIN
  209.    IF RLastRead >= 1023 THEN                 (* End of buffer? *)
  210.       RLastRead   := 0                       (* Yes, wrap it *)
  211.    ELSE RLastRead := Succ(RLastRead);        (* No, bump pointer *)
  212.    RInChar := RBuffer[RLastRead];            (* Return w/char *)
  213. END; (* RInChar *)
  214.  
  215. (*═══════════════════════════════════════════════════════════════════════*)
  216. FUNCTION TInChar : Char;                     (* Nxt chr fr TNC buf *)
  217.  
  218. BEGIN
  219.    IF TLastRead >= 1023 THEN                 (* End of buffer? *)
  220.       TLastRead   := 0                       (* Yes, wrap it *)
  221.    ELSE TLastRead := Succ(TLastRead);        (* No, bump pointer *)
  222.    TInChar := TBuffer[TLastRead];            (* Return w/char *)
  223. END; (* TInChar *)
  224.  
  225. (*═══════════════════════════════════════════════════════════════════════*)
  226. PROCEDURE OutChar(Ch : Char; ComBase : INTEGER);(* Send chr to comm port *)
  227.  
  228. VAR
  229.    THR : INTEGER;
  230.  
  231. BEGIN
  232.    THR := ComBase;                           (* 8250 xmit Hld Reg *)
  233.    Port[THR] := Byte(Ch)                     (* Put char into THR *)
  234. END; (* OutChar *)
  235.  
  236. (*═══════════════════════════════════════════════════════════════════════*)
  237. PROCEDURE NoComm;
  238. (* 'UUUUU' means input buffer did not receive data from radio *)
  239.  
  240. BEGIN;
  241.  
  242.    WINDOW(2,6,79,23);
  243.    ErrorAlarm(ComErr,0,7);                   (* Issue com port error *)
  244.    Warble(3000,2400);
  245.    FlushRBuffer;                             (* Clear buffer of trash *)
  246.    PromptLine('M');                          (* Put up Main Menu msg *)
  247.    WINDOW(2,6,79,23);
  248.    CLRSCR;
  249.    PromptLine('K');                          (* Put up FK line *)
  250.    ClockFlag := TRUE;                        (* Reinstate RTC *)
  251.    MainMenu;
  252. END; (* NoComm *)
  253.  
  254. (*═══════════════════════════════════════════════════════════════════════*)
  255. PROCEDURE BadEcho;
  256. (* Got invalid or no Echo from 767, show command error *)
  257.  
  258. BEGIN;
  259.    WINDOW(2,6,79,23);
  260.    ErrorAlarm(CmdErr,0,7);                   (* Issue command error *)
  261.    Warble(3000,2400);
  262.    GOTOXY(31,9);  WRITE('Inst:');
  263.    GOTOXY(31,10); WRITE('Echo:');
  264.    WhatWasThat(Inst,38,9);
  265.    WhatWasThat(Echo,38,10);
  266.    FlushRBuffer;                             (* Clear buffer of trash *)
  267.    PromptLine('M');                          (* Put up Main Menu msg *)
  268.    WINDOW(2,6,79,23);
  269.    CLRSCR;
  270.    PromptLine('K');                          (* Put up FK line *)
  271.    ClockFlag := TRUE;                        (* Reinstate RTC *)
  272.    MainMenu;
  273. END; (* BadEcho *)
  274.  
  275. (*═══════════════════════════════════════════════════════════════════════*)
  276. PROCEDURE SendTString(TStr : String86);
  277. (* Send command to TNC w/intercharacter delay *)
  278.  
  279. BEGIN
  280.    FOR Index := 1 to LENGTH(TStr) DO BEGIN
  281.       OutChar(TStr[Index],TComBase);
  282.       DELAY(TICD);                             (* Intercharacter delay *)
  283.    END;
  284.    OutChar(CHR(13),TComBase);
  285.    Peep(1000);
  286. END; (* SendTString *)
  287.  
  288. (*═══════════════════════════════════════════════════════════════════════*)
  289. PROCEDURE SendRString(Inst : STRING5; SUS : INTEGER);
  290. (* Send command to RADIO w/intercharacter and end-of-string delays *)
  291.  
  292. VAR
  293.    RESD : INTEGER;
  294.  
  295. BEGIN
  296.    RESD := SUS * 15;
  297.    ScreenWrite('Inst'+CHR(16)+'     ',69,4,31); (* Show Inst activity *)
  298.    FOR Index := 1 to LENGTH(Inst) DO BEGIN
  299.       OutChar(Inst[Index],RComBase);
  300.       DELAY(RICD);                            (* Intercharacter delay *)
  301.    END;
  302.    ScreenWrite('      ',69,4,31);
  303.    DELAY(RESD);                               (* Yaesu takes 5 to 20 ms *)
  304. END; (* SendRString *)
  305.  
  306. (*═══════════════════════════════════════════════════════════════════════*)
  307. PROCEDURE WhatWasThat(Param : String5; Col,Row : INTEGER);
  308. (* Display Instruction/Echo as sent from computer/FT-767 *)
  309.  
  310. VAR
  311.    MSN,Result : INTEGER;
  312.  
  313. BEGIN (* WhatWasThat *)
  314.    TEXTCOLOR(SFG); TEXTBACKGROUND(DBG);      (* Returned status colors *)
  315.    GOTOXY(Col,Row);
  316.    FOR Index := 1 TO LENGTH(Param) DO BEGIN
  317.       VAL(Param[Index],MSN,Result);
  318.       WriteHex(ORD(Param[Index]));
  319.       WRITE(' ');                            (* Disp as BCD Hex values *)
  320.    END;
  321. END; (* WhatWasThat *)
  322.  
  323. (*═══════════════════════════════════════════════════════════════════════*)
  324. PROCEDURE CatSend(Param : String5; StatusUpdateSize : INTEGER);
  325. (* Send Instruction string to 767, get Echo & send ACKnowledge *)
  326.  
  327. VAR
  328.    Temp      : STRING[86];
  329.    Ch        : STRING;
  330.    Try       : INTEGER;
  331.  
  332. BEGIN (* CatSend *)
  333.    FlushRBuffer;
  334.    Inst      := Param;                       (* Inform Global variable *)
  335.    Echo      := 'UUUUU';                     (* Flush last echo *)
  336.    ClockFlag := FALSE;                       (* No clock during Comm *)
  337.    EchoValid := FALSE;
  338.    Ch        := '  ';
  339.    Try       := 0;
  340.    IF Main THEN
  341.       ScreenWrite('   ',71,3,31);            (* Show clock suspense *)
  342.    IF Test OR OneWay THEN BEGIN
  343.       FOR Index := 1 TO 5 DO                 (* All are 5 bytes long *)
  344.       Echo[Index] := Inst[Index];            (* Simulate 767 echo *)
  345.       EchoValid := TRUE;
  346.    END (* IF Test *)
  347.    ELSE REPEAT
  348.       Echo := 'UUUUU';                       (* Flush last echo *)
  349.       SendRString(Param,15);                 (* Send Instruction to 767 *)
  350.       FOR Index := 1 TO 5 DO                 (* Get 5 char echo fr 767 *)
  351.          IF RInStat THEN Echo[Index] := RInChar; (* The REAL echo *)
  352.       ScreenWrite('     ',74,4,31);          (* To clean up *)
  353.       IF Echo = Inst THEN BEGIN
  354.          ScreenWrite(CHR(17)+'Echo',74,4,31); (* Show Echo activity *)
  355.          DELAY(25);                          (* To see activity *)
  356.          EchoValid := TRUE;                  (* Everything OK *)
  357.       END (* IF Echo *)
  358.       ELSE BEGIN                             (* Everything's not OK *)
  359.          Try  := Try +1;                     (* Bump attempt counter *)
  360.          STR(Try:2,Ch);
  361.          ScreenWrite('Try'+Ch,74,4,31);      (* Show Try # *)
  362.          FlushRBuffer;
  363.          DELAY(25);                          (* To see activity *)
  364.       END; (* ELSE *)
  365.    UNTIL (EchoValid) OR (Try >= 3);          (* Try three times... *)
  366.    IF NOT EchoValid THEN
  367.       IF Echo = 'UUUUU' THEN NoComm          (* Check comm port *)
  368.       ELSE BadEcho;                          (* Echo is corrupted *)
  369.       (* If Test was TRUE, UPDATE.DAT had provided a simulated Update *)
  370.    IF NOT Test THEN BEGIN
  371.       (* Echo was a match, send ACK string *)
  372.       SendRString(AckString,StatusUpdateSize); (* 767 executes the cmd *)
  373.       FOR Index := 1 TO StatusUpdateSize DO
  374.       Lifo[Index] := RInChar;                (* Get real Update fr 767 *)
  375.       (* Update stream from 767 is sent last byte first *)
  376.       Temp := Fifo(Lifo);                    (* Convert LIFO to FIFO *)
  377.       Update := Temp;
  378.    END; (* IF NOT Test *)
  379.    ClockFlag := TRUE;                        (* Reinstate RTC *)
  380. END; (* CatSend *)
  381.  
  382. (*═══════════════════════════════════════════════════════════════════════*)
  383. PROCEDURE TurnCatOn; (* Activate Computer Aided Tuning system *)
  384.  
  385. BEGIN (* TurnCatOn *)
  386.    CatSend(CatOn,86);                        (* Turn on the CAT *)
  387.    ScreenWrite('CAT: ',65,4,30);             (* Update status panel *)
  388. END; (* TurnCatOn *)
  389.  
  390. (*═══════════════════════════════════════════════════════════════════════*)
  391. PROCEDURE TurnCatOff; (* Deactivate Computer Aided Tuning system *)
  392.  
  393. BEGIN (* TurnCatOff *)
  394.    CatSend(CatOff,86);                       (* Put out the CAT *)
  395.    ScreenWrite('CAT: ',65,4,30);             (* Update status panel *)
  396.    ScreenWrite(' Inactive ',69,4,31);        (* Update status panel *)
  397. END; (* TurnCatOff *)
  398.  
  399. END. (* UNIT CATYCOMM *)
  400.