home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / communic / term / comm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-12  |  15.4 KB  |  544 lines
  1.  
  2. Unit Comm;
  3.  
  4. Interface
  5.  
  6. uses Crt,Dos;
  7.  
  8. Procedure Comm_setbaud(newrate : Longint);
  9. Function Comm_getbaud: Longint;
  10. Procedure Comm_SetDirect(Newrate : Longint);
  11. procedure Comm_setBios(newrate : longint);
  12. Function Comm_init(Baud : Longint;ThePort : Byte): Boolean;
  13. Procedure Comm_deinit;
  14. Procedure Comm_dtr_on;
  15. Procedure Comm_dtr_off;
  16. Function Comm_Tx_ready : boolean;
  17. Function Comm_Carrier : boolean;
  18. Function Comm_Rx_ready : boolean;
  19. Function Comm_Rx : byte;
  20. Procedure Comm_Tx(ch : byte);
  21. Procedure Comm_FlushOut;
  22. Procedure Comm_ClearOut;
  23. Procedure Comm_ClearIn;
  24. Procedure Comm_SendBreak;
  25. Procedure Comm_Cts_Rts(OnOff : Boolean);
  26.  
  27. Var
  28.    CanUseFossil : Boolean;
  29.  
  30. IMPLEMENTATION
  31.  
  32. CONST
  33.   MaxPhysPort    = 7 ;
  34.   BufferSize     = 8192;
  35.   BufferMax      = 8191;
  36.  
  37.   CommInterrupt  = $14 ;
  38.   I8088_IMR      = $21 ; { port address of the Interrupt Mask Register }
  39.  
  40.   { register offsets from base of IBM 8250 UART }
  41.   IBM_UART_THR         = $00 ;
  42.   IBM_UART_RBR         = $00 ;
  43.   IBM_UART_IER         = $01 ;
  44.   IBM_UART_IIR         = $02 ;
  45.   IBM_UART_LCR         = $03 ;
  46.   IBM_UART_MCR         = $04 ;
  47.   IBM_UART_LSR         = $05 ;
  48.   IBM_UART_MSR         = $06 ;
  49.  
  50.   PortTable      : ARRAY [0..MaxPhysPort] OF RECORD
  51.     Base : word ;
  52.     IRQ  : byte
  53.     END  { PortTable record } = ( (Base : $3f8 ;  IRQ : 4),
  54.                                   (Base : $2f8 ;  IRQ : 3),
  55.                                   (Base : $3e8 ;  IRQ : 4),
  56.                                   (Base : $2e8 ;  IRQ : 3),
  57.                                   (Base : 0 ;  IRQ : 0),
  58.                                   (Base : 0 ;  IRQ : 0),
  59.                                   (Base : 0 ;  IRQ : 0),
  60.                                   (Base : 0 ;  IRQ : 0) ) ;
  61.  
  62. Var
  63.   BIOS_Ports              : byte ;
  64.   ExitSave                : pointer ;
  65.   OriginalVector          : pointer ;
  66.   IsOpen,OverFlow         : BOOLEAN ;
  67.   Base                    : word ;       { base for open port }
  68.   IRQ                     : byte ;       { irq  for open port }
  69.   Buffer                  : ARRAY [0..BufferMax] OF byte ;
  70.   BufferHead              : word ;       { Location in Buffer to put next char }
  71.   BufferTail              : word ;       { Location in Buffer to get next char }
  72.   BufferNewTail           : word ;
  73.   Regs                    : registers;
  74.   UsedPort,
  75.   Status,RxWord                  : word;
  76.   UseFossil                      : Boolean;
  77.   Old_IER,Old_IIR,Old_LCR,
  78.   Old_MCR,Old_IMR                :byte;
  79.   Cts_Rts_on                     : Boolean;
  80.  
  81. procedure Comm_setBios(newrate : longint);
  82. var
  83.   BaudRate    : Byte;
  84.   Temp0       : Integer;
  85.  
  86.   begin
  87.    Temp0 := NewRate Div 10;
  88.    case Temp0 of
  89.        30         : baudrate := $43;
  90.        60         : baudrate := $63;
  91.        120        : baudrate := $83;
  92.        240        : baudrate := $a3;
  93.        480        : baudrate := $c3;
  94.        960        : baudrate := $e3;
  95.        1920       : baudrate := $03;
  96.        3840       : baudrate := $23;
  97.    end;
  98.      regs.ah := 0;
  99.      regs.al := baudrate;
  100.      regs.dx := usedport;
  101.      Intr($14,regs);
  102. end;
  103.  
  104.  
  105. Procedure Comm_SetDirect(Newrate : Longint);
  106. Var
  107.    i,j,k        : word;
  108.    temp       : longint;
  109.  
  110.   begin
  111.      temp := 115200;
  112.      Temp := temp div Newrate;
  113.      Move(Temp,j,2);
  114.      k := port[ibm_Uart_Lcr + base];
  115.      port[ibm_Uart_Lcr + base] := $80;
  116.      Port[Ibm_uart_thr + base] := lo(j);
  117.      Port[Ibm_uart_ier + base]:= hi(j);
  118.      Port[Ibm_Uart_Lcr + base] := $3;
  119.   end;
  120.  
  121. procedure Comm_setbaud(newrate : longint);
  122.  
  123.   begin
  124.    If UseFossil then Comm_SetBios(NewRate) else
  125.       Comm_SetDirect(newrate);
  126.   end;
  127.  
  128. Function Comm_getbaud: Longint;
  129. Var
  130.    i,j,k      : word;
  131.    temp       : longint;
  132.  
  133.   begin
  134.     k := port[ibm_Uart_Lcr + base];
  135.     port[ibm_Uart_Lcr + base] := k or $80;
  136.      i := Port[Ibm_uart_thr + base];
  137.      j := Port[Ibm_uart_ier + base];
  138.      j := j * $100;
  139.      j := j + i;
  140.     Port [Ibm_Uart_Lcr + base] := k;
  141.        temp := 115200;
  142.        temp := temp div j;
  143.      Comm_GetBaud := temp;
  144.   end;
  145.  
  146. function Comm_Carrier : boolean;
  147. begin
  148.  
  149. Inline
  150.     ($B4/$03/            { Mov ah,3       }
  151.      $8b/$16/UsedPort/   { Mov Dx,Usedport}
  152.      $cd/$14/            { Int 14         }
  153.      $a3/Status);        { Mov Status,Ax  }
  154.      Comm_carrier := ((Status and 128) <> 0);
  155. end;
  156.  
  157.  
  158. PROCEDURE DisableInterrupts ;   inline( $FA {cli} ) ;
  159. PROCEDURE EnableInterrupts ;    inline( $FB {sti} ) ;
  160.  
  161. {---------------------------------------------------------------------------}
  162. {                      ISR - Interrupt Service Routine                      }
  163. {---------------------------------------------------------------------------}
  164.  
  165. PROCEDURE ISR ; INTERRUPT ;
  166. { Interrupt Service Routine }
  167. { Invoked when the USART has received a byte of data from the comm line }
  168. { More mods by MFD 10th May 1992 for 16550's FIFO's                     }
  169. BEGIN { ISR }
  170.   inline(
  171.     $FB/                                { sti                           }
  172.     {Start:                                                             }
  173.     { get the incoming character                                        }
  174.     { Buffer[BufferHead] := chr(port[base + ibm_uart_rbr]);             }
  175.     $8B/$16/Base/                       { mov dx,Base                   }
  176.     $EC/                                { in al,dx                      }
  177.     $8B/$1E/BufferHead/                 { mov bx,BufferHead             }
  178.     $88/$87/Buffer/                     { mov Buffer[bx],al             }
  179.     { BufferNewHead := succ(BufferHead);                                }
  180.     $43/                                { inc bx                        }
  181.     { if BufferNewHead > BufferMax then BufferNewHead := 0 ;            }
  182.     $81/$FB/BufferMax/                  { cmp bx,BufferMax              }
  183.     $7E/$02/                            { jle l001                      }
  184.     $33/$DB/                            { xor bx,bx                     }
  185.     { if BufferNewHead = BufferTail then Overflow := true               }
  186.     {L001:                                                              }
  187.     $3B/$1E/BufferTail/                 { cmp bx,BufferTail             }
  188.     $75/$07/                            { jne L002                      }
  189.     $C6/$06/Overflow/$01/               { mov overflow,1                }
  190.     $EB/$0E/                            { jmp short L003                }
  191.     { ELSE BEGIN                                                        }
  192.     {   BufferHead := BufferNewHead;                                    }
  193.     {   Async_BufferUsed := succ(Async_BufferUsed);                     }
  194.     {   IF Async_BufferUsed > Async_MaxBufferUsed then                  }
  195.     {     Async_MaxBufferUsed := Async_BufferUsed                       }
  196.     {   END ;                                                           }
  197.     {L002:                                                              }
  198.     $89/$1E/BufferHead/                 { mov BufferHead,bx             }
  199.     $83/$C2/$05/                        { Add dx,5                      }
  200.     { Check FIFO - And process if more bytes.                           }
  201.     $EC/                                { In al,dx                      }
  202.     $24/$20/                            { And al,$20                    }
  203.     $3C/$20/                            { cmp al,$20                    }
  204.     $75/$CF/                            { jnz start:                    }
  205.     {L003:                                                              }
  206.     $FA/                                { cli                           }
  207.     { issue non-specific EOI                                            }
  208.     { port[$20] := $20 ;                                                }
  209.     $B0/$20/                            { mov al,20h                    }
  210.     $E6/$20                             { out 20h,al                    }
  211.     )
  212.   END { ISR } ;
  213.  
  214. PROCEDURE Async_Close ;
  215.  
  216. { reset the interrupt system when USART interrupts no longer needed }
  217.  
  218.  
  219. BEGIN { Async_Close }
  220.  
  221. if IsOpen then
  222.   begin
  223.     DisableInterrupts;
  224.     port[I8088_IMR] := (port[I8088_IMR] or (1 shl IRQ));
  225.     port[Base + IBM_UART_IER] := old_IER;
  226.     EnableInterrupts ;
  227.     port[Base + IBM_UART_MCR] := Old_Mcr;
  228.     port[Base + IBM_UART_LCR] := Old_lcr;
  229.     SetIntVec( IRQ + 8, OriginalVector ) ;
  230.     IsOpen := False;
  231.     End;
  232. End;
  233.  
  234. Function init_fossil(Baud : longint;ThePort : Byte): Boolean;
  235.  
  236. begin
  237.      usedPort := ThePort - 1;
  238.      regs.ah := $4;
  239.      regs.dx := usedport;
  240.      intr($14,regs);
  241.      if regs.ax <> $1954 then Init_fossil := False
  242.         Else
  243.           begin
  244.             Init_Fossil := true;
  245.             UseFossil := True;
  246.             Comm_SetBaud(Baud);
  247.           end;
  248. end;
  249.  
  250. Function Async_Open(Baud : Longint; LogicalPortNum: byte): boolean;
  251.  
  252. VAR
  253.     i,oldIIR : byte ;
  254.     Fifos,Portthere  : Boolean;
  255.  
  256. BEGIN { Async_Open }
  257.   IF NOT IsOpen THEN
  258.     BEGIN
  259.       BufferHead       := 0 ;
  260.       BufferTail       := 0 ;
  261.       Overflow         := FALSE;
  262.       UsedPort   := PRED(LogicalPortNum);
  263.       fifos := false;
  264.       IsOpen := false;
  265.      If PortTable[UsedPort].Base <> 0 then
  266.        BEGIN
  267.           Base := PortTable[usedPort].Base ;
  268.           IRQ  := PortTable[usedPort].IRQ ;
  269.           Old_ier := port[Base + IBM_UART_IER];
  270.           Old_Mcr := port[Base + IBM_UART_MCR];
  271.           Old_Lcr := port[Base + IBM_UART_LCR];
  272.           Port[Base + Ibm_Uart_Lcr] := $75;
  273.           PortThere := (Port[Base + Ibm_Uart_Lcr] = $75);
  274.           Port[Base + Ibm_Uart_Lcr] := $3;
  275.           If PortThere Then
  276.              begin
  277.                 Comm_SetDirect(Baud);
  278.                 port[IBM_UART_MCR + Base] := $0b; { Turn on RTS/DTR     }
  279.                 OldIIR := Port[base+Ibm_Uart_IIR];
  280.                 Port[base + Ibm_Uart_IIR] := 1;            {check for Fifos!}
  281.                 Fifos := (port[base + Ibm_uart_IIR] And $c0 = $c0);
  282.                 If Not Fifos then Port[base + Ibm_Uart_IIR] := OldIIR;
  283.                 GetIntVec(IRQ + 8,OriginalVector);
  284.                 SetIntVec(IRQ + 8,@ISR);
  285.                 DisableInterrupts ; { --- ENTER CRITICAL REGION -------------------- }
  286.                 port[I8088_IMR] := (port[I8088_IMR] and ((1 shl IRQ) xor $FF)) ;
  287.                 port[IBM_UART_IER + Base] := $01; { enable data ready interrupt }
  288.                 EnableInterrupts ;  { --- EXIT CRITICAL REGION --------------------- }
  289.                 IsOpen := TRUE
  290.              end;
  291.        END;
  292.     END;
  293.    Async_Open := IsOpen
  294.   END { Async_Open } ;
  295.  
  296.  
  297. {$F+}
  298. PROCEDURE TerminateUnit ; {$F-}
  299.  
  300. BEGIN { TerminateUnit }
  301.   Async_Close ;
  302.   ExitProc := ExitSave
  303.   END { TerminateUnit } ;
  304.  
  305. Function Comm_init(Baud : Longint;ThePort : Byte): Boolean;
  306.  
  307.  begin
  308.   UseFossil := False;
  309.   If not IsOpen then
  310.    begin
  311.      if (canusefossil) and (Init_Fossil(baud,ThePort)) then
  312.       begin
  313.        Comm_Init := True;
  314.        IsOpen := True;
  315.        Base := PortTable[usedPort].Base ;
  316.        end
  317.     else
  318.       Begin
  319.         If Async_Open(Baud,ThePort) then
  320.           Begin
  321.             Comm_Init := true;
  322.             IsOpen := True;
  323.           End
  324.         else
  325.          Comm_Init := False;
  326.       End;
  327.    End;
  328.  End;
  329.  
  330. Function Comm_Tx_ready : boolean;
  331.  
  332. Var Ahigh  : Byte;
  333.     Cts,Thr   : boolean;
  334. begin
  335.  
  336.  If useFossil then
  337.    begin
  338.    Inline
  339.     ($B4/$03/            { Mov ah,3       }
  340.      $8b/$16/UsedPort/   { Mov Dx,Usedport}
  341.      $cd/$14/            { Int 14         }
  342.      $a3/Status);        { Mov Status,Ax  }
  343.      Comm_tx_ready := ((Status and $2000) <> 0);
  344.    End
  345.  Else
  346.    Begin
  347.        Thr := ((port [IBM_UART_LSR + Base] and $20) <> 0);
  348.        Cts := (port[ibm_uart_msr +base] and $10 <> 0);
  349.        If (Cts_Rts_On and Comm_Carrier) then
  350.          Comm_Tx_Ready := THR and Cts
  351.        else
  352.          Comm_Tx_ready := Thr;
  353.    end;
  354.  end;
  355.  
  356. Function Comm_Rx_ready : boolean;
  357. Var
  358.   AHigh : Byte;
  359.  
  360.  Begin
  361.      if UseFossil Then
  362.        Begin
  363.         Inline
  364.         ($B4/$03/            { Mov ah,3 }
  365.          $8b/$16/UsedPort/   { Mov Dx,[Usedport]}
  366.          $cd/$14/            { Int 14}
  367.          $a3/Status);        { Mov [Status],Al   }
  368.          Comm_Rx_ready := ((Status and $100) <> 0);
  369.        end
  370.      Else
  371.          Comm_Rx_ready := (Bufferhead <> BufferTail);
  372.  End;
  373.  
  374. Procedure Comm_deinit;
  375.    begin
  376.      If IsOpen then
  377.         Begin
  378.            If UseFossil then
  379.            Begin
  380.              regs.ah := $5;
  381.              regs.dx := usedport;
  382.              intr($14,regs);
  383.            end
  384.            else Async_Close;
  385.            IsOpen := False;
  386.         end;
  387.    End;
  388.  
  389. Function Comm_Rx: byte;
  390.  Begin
  391.        If UseFossil then
  392.         Begin
  393.              Inline
  394.              ($B4/$02/            { Mov ah,3 }
  395.               $8b/$16/UsedPort/   { Mov Dx,[Usedport]}
  396.               $cd/$14/            { Int 14}
  397.               $a3/RXWord);        { Mov [Status],Al   }
  398.               Comm_Rx := lo(RXWord);
  399.          end
  400.           else
  401.          Begin
  402.                Comm_Rx         := Buffer[BufferTail] ;
  403.                BufferTail := (SUCC( BufferTail ) MOD BufferSize) ;
  404.          end;
  405.  end;
  406.  
  407. Procedure Comm_Tx(ch : byte);
  408.   Begin
  409.     Repeat
  410.      Until Comm_Tx_ready;
  411.     If UseFossil then
  412.        Begin
  413.            regs.ah := $01;
  414.            regs.al := ch;
  415.            regs.dx := usedport;
  416.            intr($14,regs);
  417.        End
  418.     else
  419.      port[IBM_uart_thr + base] := ch;
  420.   end;
  421.  
  422. Procedure Comm_FlushOut;
  423.  Begin
  424.    If Usefossil then
  425.     begin
  426.         regs.Ah := $8;
  427.         Regs.dx := usedport;
  428.         Intr($14,regs);
  429.     end;
  430.  end;
  431.  
  432.  
  433. Procedure Comm_ClearOut;
  434.   Begin
  435.    If UseFossil Then
  436.       Begin
  437.          Regs.Ah := $9;
  438.          Regs.Dx := usedport;
  439.          Intr($14,regs);
  440.       End;
  441.   end;
  442.  
  443. Procedure Comm_ClearIn;
  444.   Begin
  445.    If UseFossil then
  446.     Begin
  447.       Regs.Ah := $0a;
  448.       Regs.Dx := usedport;
  449.       Intr($14,Regs);
  450.     end
  451.    else
  452.     Begin
  453.       BufferHead := 0;
  454.       BufferTail := 0;
  455.       OverFlow   := False;
  456.     End;
  457.   End;
  458.  
  459. Procedure Comm_SendBreak;
  460.  
  461. Var
  462.    I,j : Byte;
  463.  Begin
  464.    If UseFossil then
  465.      Begin
  466.       Regs.AX := $1a01;
  467.       Regs.Dx := UsedPort;
  468.       Intr($14,regs);
  469.       Delay(100);
  470.       Regs.Ax := $1a00;
  471.       Regs.Dx := UsedPort;
  472.       Intr($14,regs);
  473.      end
  474.    else
  475.      Begin
  476.       I := port[IBM_UART_LCR + Base];
  477.       J := i;
  478.       I := I And $7f;
  479.       I := I or $40;
  480.       Port[IBM_UART_LCR + Base] := I;
  481.       delay(100);
  482.       port[IBM_UART_LCR + Base] := j;
  483.      End;
  484.   End;
  485.  
  486. Procedure Comm_dtr_on;
  487.  
  488. Var    i      : Byte;
  489.  
  490. begin
  491.      If UseFossil then
  492.       Begin
  493.         regs.ah := $06;
  494.         regs.al := $01;
  495.         regs.dx := usedport;
  496.         intr($14,regs);
  497.       end
  498.      else
  499.       Port [IBM_UART_MCR + Base] := $0b;
  500. End;
  501.  
  502. Procedure Comm_dtr_off;
  503. Var
  504.    I     : Byte;
  505.  
  506. begin
  507.    if UseFossil then
  508.      begin
  509.         regs.ah := $06;
  510.         regs.al := $00;
  511.         regs.dx := Usedport;
  512.         intr($14,regs);
  513.      end
  514.     else
  515.      Port[IBM_Uart_MCR + Base] := $0a;
  516. end;
  517.  
  518. Procedure Comm_Cts_Rts(OnOff : Boolean);
  519.  
  520. begin
  521.   if UseFossil then
  522.     begin
  523.      Regs.dx := USedPort;
  524.      If OnOff then regs.al := 2 else Regs.al := 0;
  525.      Regs.ah := $0f;
  526.      Intr($14,regs);
  527.     end
  528.   else
  529.     Cts_Rts_On := OnOff;
  530. end;
  531.  
  532.  
  533. BEGIN { InitializeUnit }
  534.   ExitSave := ExitProc ;
  535.   ExitProc := @TerminateUnit ;
  536.   IsOpen   := FALSE ;
  537.   Overflow := FALSE ;
  538.   CanUseFossil := True;
  539.   Cts_rts_on := True;
  540.   Bios_Ports := 4;
  541. end.
  542.  
  543.  
  544.