home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / tpdoskermit.zip / async.pas next >
Pascal/Delphi Source File  |  1991-04-18  |  14KB  |  505 lines
  1. $R-,S-,I-,D+,T+,F-,V+,B-,N-,L+ 
  2. UNIT ASYNC;
  3.  
  4. INTERFACE
  5.  
  6. Uses Delays;
  7.  
  8. (**************************** ASYNC.PAS *********************************)
  9. (*                                                                      *)
  10. (*     Modul for bruk av 1,2,3 el. 4 COM-porter samtidig, med interrupt *)
  11. (*     bde ved sending og mottak og uavhengige ring-buffere opptil     *)
  12. (*     64k for hver retning og port.                                    *)
  13. (*                                                                      *)
  14. (*     Oslo, November 1987 Terje Mathisen, Norsk Hydro                  *)
  15. (*                                                                      *)
  16. (**************************** ASYNC.PRO *********************************)
  17.  
  18. CONST RX_int     = 1;
  19.       TX_int     = 2;
  20.       RLS_int    = 4;
  21.       MODEM_int  = 8;
  22.       SumOf_int  =15;
  23. TYPE
  24.   ComPortType = 1..4;
  25.   ParityType = (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity);
  26.  
  27.   RS_IntSet = 0..SumOf_int;
  28.   RS_BufPtrType  = ^RS_BufferType;
  29.   RS_BufferType = RECORD
  30.               ICadr, IntNr     : WORD;
  31.  
  32.               oldModemContrReg : BYTE;
  33.               oldLevel  : BYTE;
  34.               oldVector : Pointer;
  35.  
  36.               xin : Pointer;
  37.               xout, SizeX, LimitX    : WORD;
  38.  
  39.               Tin : WORD;
  40.               Tout : Pointer;
  41.               SizeT, SendFirst : WORD;
  42.  
  43.               ShowXoffPtr : Pointer;
  44.               Toggle_Xoff, RLS_user, MODEM_user : Pointer;
  45.  
  46.               Ctrl_P    : BYTE;  {0 - > default, 1..4 -> NOTIS}
  47.  
  48.               UseTint, HostXoff : BOOLEAN;
  49.               Bufferfilled : BYTE;
  50.  
  51.               AutoXoff, AltXoff : BOOLEAN;
  52.               Xoff1C, Xoff2C, Xon1C, Xon2C     : CHAR;
  53.  
  54.               Line_Status, MODEM_status : BYTE;
  55.               WaitTX : BOOLEAN;
  56.               Int_Mask : BYTE;
  57.               oldIntEnableReg : BYTE;
  58.             END;
  59.  
  60. VAR
  61.   RS_BufPtr : ARRAY [ComPortType] OF RS_BufPtrType;
  62.   RS_TimeOut : WORD;
  63.  
  64.   RS_Buffer : ARRAY [ComPortType] OF RS_BufferType; { Must be in data-seg! }
  65.  
  66.   PROCEDURE RS_MakeBuffer(Rsize,Tsize,IOaddr,SWint:WORD; com : WORD);
  67.  
  68.   PROCEDURE RS_Init (baudRate : LongInt;
  69.                   NbrOfBits,           { 5|6|7|8 }
  70.                   StopBits: WORD;      { 1|2 }
  71.                   Parity: ParityType;
  72.             { (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity) }
  73.                   VAR result: BOOLEAN;
  74.                   com: ComPortType); { 1..4 }
  75.  
  76.   PROCEDURE RS_Stop(com: ComPortType);
  77.  
  78.   PROCEDURE RS_Start(rs_int: RS_IntSet; com: ComPortType);
  79.  
  80.   PROCEDURE RS_BusyRead(VAR ch:CHAR;VAR done : BOOLEAN; com : WORD);
  81.  
  82.   PROCEDURE RS_ReadBlock(VAR buf;max:WORD;VAR bytes:WORD;com : WORD);
  83.  
  84.   PROCEDURE RS_Write(ch: CHAR;VAR done : BOOLEAN; com: WORD );
  85.  
  86.   PROCEDURE RS_WriteBlock(VAR buf;len: WORD;VAR bytes:WORD; com: WORD);
  87.  
  88.   FUNCTION RS_GetChar(VAR ch : CHAR; com : WORD): BOOLEAN;
  89.  
  90.   FUNCTION RS_Avail(com : WORD): WORD;
  91.  
  92.   FUNCTION RS_Room(com : WORD): WORD;
  93.  
  94.   PROCEDURE RS_Enable(com : WORD);
  95.  
  96.   PROCEDURE RS_WriteFirst(ch:CHAR;com:WORD);
  97.  
  98.   PROCEDURE RS_ClrBuffer(com: WORD);
  99.  
  100.   PROCEDURE RS_Set_TX_Int(rs_int : RS_IntSet; com : WORD);
  101.  
  102.   FUNCTION RS_Empty(com : WORD) : BOOLEAN;
  103.  
  104.   PROCEDURE RS_Break(ms : WORD;com : WORD);
  105.  
  106.   PROCEDURE RS_StopLink(com : WORD);
  107.  
  108.   PROCEDURE RS_StartLink(com : WORD);
  109.  
  110.   PROCEDURE RS_StopAll;
  111.  
  112. IMPLEMENTATION
  113.  
  114. CONST
  115.   LineContrReg    = 3; { to specify format of transmitted data }
  116.   LowBaudRateDiv  = 0; { lower byte of divisor to select baud rate }
  117.   HighBaudRateDiv = 1; { higher byte of divisor }
  118.   LineStatusReg   = 5; { holds status info on the data transfer }
  119.   ReceiverReg     = 0; { received CHAR is in this register }
  120.   TransmitReg     = 0; { CHAR to send is put in this reg }
  121.   IntEnableReg    = 1; { to enable the selected interrupt }
  122.   IntIdentReg     = 2;
  123.   ModemContrReg   = 4; { controls the interface to a modem }
  124.  
  125.     PROCEDURE GetAlignMem(VAR p : Pointer; size : WORD);
  126.     VAR temp : ^BYTE;
  127.     BEGIN
  128.       REPEAT
  129.         GetMem(p,size);
  130.         IF Ofs(p^) = 0 THEN Exit;
  131.         FreeMem(p,size);
  132.         New(temp);
  133.       UNTIL FALSE;
  134.     END;
  135.  
  136.   PROCEDURE RS_MakeBuffer(Rsize, Tsize, IOaddr, SWint, com: WORD);
  137.   CONST PortTab : ARRAY [ComPortType] OF WORD = ($3F8,$2F8,$3E8,$2E8);
  138.         IntTab  : ARRAY [ComPortType] OF BYTE = (12,11,12,11);
  139.   VAR c, c0, c1 : WORD;
  140.   BEGIN
  141.     IF Rsize + Tsize > MemAvail - $100 THEN BEGIN
  142.       Halt(1);
  143.     END;
  144.     IF com = 0 THEN BEGIN
  145.       c0 := 1; c1 := 4;
  146.     END
  147.     ELSE BEGIN
  148.       IF com > 4 THEN Halt(1);
  149.       c0 := com; c1 := com;
  150.     END;
  151.     FOR c := c0 TO c1 DO WITH RS_Buffer[c] DO BEGIN
  152.       IF (com = 0) AND (c > 1) THEN
  153.         RS_Buffer[c] := RS_Buffer[1]
  154.       ELSE BEGIN
  155.         IF Rsize > 0 THEN BEGIN
  156.           GetAlignMem(xin,Rsize);
  157.           SizeX := Rsize;
  158.           LimitX := Rsize DIV 8;
  159.         END;
  160.  
  161.         IF Tsize > 0 THEN BEGIN
  162.           GetAlignMem(Tout,Tsize);
  163.           SizeT := Tsize;
  164.         END;
  165.       END;
  166.  
  167.       IF IOaddr = 0 THEN
  168.         ICadr := PortTab[c]
  169.       ELSE
  170.         ICadr := IOaddr;
  171.  
  172.       IF SWint = 0 THEN
  173.         IntNr := IntTab[c]
  174.       ELSE
  175.         IntNr := SWint;
  176.  
  177. {                       Disse variablene er nullstilt allerede!
  178.       xin := 0;
  179.       xout := 0;
  180.       SendFirst := 0;
  181.       tin := 0;
  182.       tout := 0;
  183.       Ctrl_P := 0;
  184.       UseTint := FALSE;
  185.       Sending := FALSE;
  186.       Receiving := FALSE;
  187.       HostXoff := FALSE;
  188.       BufferFilled := 0;
  189.       AltXoff  := FALSE;
  190.       ShowXoffPtr := NIL;
  191.       Toggle_Xoff := 0;
  192.       RLS_user := 0;
  193.       MODEM_user := 0;
  194. }
  195.                                        {Default to use XON/XOFF!}
  196.       AutoXoff := TRUE;
  197.       Xoff1C   := ^S;
  198.       Xon1C    := ^Q;
  199.     END;
  200.   END;
  201.  
  202.   PROCEDURE RS_Init (baudRate  : LongInt;
  203.                   NbrOfBits,           { 5|6|7|8 }
  204.                   StopBits: WORD;      { 1|2 }
  205.                   Parity: ParityType;
  206.             { (No_Parity, Even_Parity, Odd_Parity, Zero_Parity, One_Parity) }
  207.                   VAR result: BOOLEAN;
  208.                   com: ComPortType); { 1..4 }
  209.   CONST ParityTab : ARRAY [ParityType] OF BYTE = (0,$18,$08,$38,$28);
  210.     VAR divisor : WORD;
  211.         parameters: BYTE;
  212.  
  213.   BEGIN (* Init *)
  214.     result := FALSE;
  215.  
  216.     WITH RS_Buffer[com] DO BEGIN
  217.       IF Xin = NIL THEN BEGIN          {No buffer allocated!}
  218.         Halt(1);
  219.       END;
  220.  
  221.     (* load the divisor of the baud rate generator: *)
  222.       IF baudrate < 1 THEN Exit;
  223.       divisor := (115200 + (baudrate DIV 2)) DIV baudrate;
  224.       Port[ICadr+LineContrReg] := $80;
  225.       Port[ICadr+HighBaudRateDiv] := Hi(divisor);
  226.       Port[ICadr+LowBaudRateDiv]  := Lo(divisor);
  227.  
  228.         (* prepare the parameters: *)
  229.       parameters := ParityTab[Parity];
  230.  
  231.       IF stopBits = 2 THEN
  232.         parameters := parameters + 4
  233.       ELSE IF stopBits <> 1 THEN Exit;
  234.  
  235.       IF (nbrOfBits < 5) OR (nbrOfBits > 8) THEN Exit;
  236.       Port[ICadr+LineContrReg] := parameters + (nbrOfBits - 5);
  237.  
  238.         (* Disable Interrupts: *)
  239.       Port[ICadr+IntEnableReg] := 0;
  240.       result := TRUE;
  241.     END;
  242.   END                                  { Init };
  243.  
  244.     CONST
  245.       I8259ContrWord1 = $21;  (* Interrupt controller,
  246.                                  Operation Control Word 1 *)
  247.  
  248. (************************* ASSEMBLER ROUTINES FOR MAX SPEED ****************)
  249.  
  250.     PROCEDURE RS_Com1Int;                            EXTERNAL;
  251.  
  252.     PROCEDURE RS_Com2Int;                            EXTERNAL;
  253.  
  254.     PROCEDURE RS_Com3Int;                            EXTERNAL;
  255.  
  256.     PROCEDURE RS_Com4Int;                            EXTERNAL;
  257.  
  258.     PROCEDURE RS_BusyRead(VAR ch:CHAR;VAR done : BOOLEAN;
  259.               com : WORD);                    EXTERNAL;
  260.  
  261.     PROCEDURE RS_ReadBlock(VAR buf;max:WORD;
  262.               VAR bytes : WORD;com : WORD);EXTERNAL;
  263.  
  264.     PROCEDURE RS_Write(ch: CHAR;VAR done : BOOLEAN;
  265.               com: WORD );                    EXTERNAL;
  266.  
  267.     PROCEDURE RS_WriteBlock(VAR buf;len: WORD;
  268.               VAR bytes : WORD; com: WORD);EXTERNAL;
  269.  
  270.     FUNCTION RS_GetChar(VAR ch : CHAR;
  271.              com : WORD): BOOLEAN;            EXTERNAL;
  272.  
  273.     FUNCTION RS_Avail(com : WORD): WORD;   EXTERNAL;
  274.  
  275.     FUNCTION RS_Room(com : WORD): WORD;    EXTERNAL;
  276.  
  277.     PROCEDURE RS_Enable(com : WORD);          EXTERNAL;
  278.  
  279.     PROCEDURE RS_WriteFirst(ch:CHAR;com:WORD);EXTERNAL;
  280.  
  281.   {$L ASYNC.OBJ}
  282.  
  283. (***************************************************************************)
  284.  
  285. VAR vect_tab : ARRAY [0..255] OF Pointer ABSOLUTE 0:0;
  286.  
  287. PROCEDURE Disable; Inline($FA);
  288.  
  289. PROCEDURE Enable; Inline($FB);
  290.  
  291. PROCEDURE GetVector(vnr : WORD; VAR vector : Pointer);
  292. BEGIN
  293.   vector := vect_tab[vnr];
  294. END;                                   {GetVector}
  295.  
  296. PROCEDURE SetVector(vnr : WORD; vector : Pointer);
  297. BEGIN
  298.   Disable;
  299.     vect_tab[vnr] := vector;
  300.   Enable;
  301. END;                                   {PutVector}
  302.  
  303. PROCEDURE RS_Start(rs_int : RS_IntSet; com: ComPortType);
  304. VAR
  305.   adr : Pointer;
  306.   mask, tempSet : BYTE;
  307.   dummy : WORD;
  308.   ch : CHAR;
  309.   ok : BOOLEAN;
  310. BEGIN
  311.   WITH RS_Buffer[com] DO
  312.     IF OldVector = NIL THEN BEGIN
  313.  
  314.       (* enable interrupts in the interrupt controller (8259): *)
  315.       tempSet := Port[I8259ContrWord1];
  316.       (* set the interrupt vector *)
  317.  
  318.       GetVector(IntNr,OldVector);
  319.       CASE com OF
  320.         1 : adr := @RS_Com1int;
  321.         2 : adr := @RS_Com2int;
  322.         3 : adr := @RS_Com3int;
  323.         4 : adr := @RS_Com4int;
  324.       END;
  325.       SetVector(IntNr,adr);
  326.  
  327.       mask := 1 Shl (IntNr - 8);
  328.       oldLevel := tempSet AND mask;
  329.  
  330.       DISABLE;
  331.       Port[I8259ContrWord1] := tempSet AND NOT mask;
  332.  
  333.       dummy  :=  Port[ICadr+IntIdentReg] +
  334.                  Port[ICadr+LineStatusReg] +
  335.                  Port[ICadr+ModemContrReg] +
  336.                  Port[ICadr+ReceiverReg];    (* clear the controller *)
  337.  
  338.       WORD(xin)    := 0;
  339.       xout         := 0;
  340.  
  341.       SendFirst    := 0;
  342.       tin          := 0;
  343.       WORD(tout)   := 0;
  344.  
  345.       HostXoff     := FALSE;
  346.       WaitTX       := FALSE;
  347.       AutoXoff     := TRUE;      
  348.       BufferFilled := 0;
  349.       Line_Status  := 0;
  350.       MODEM_Status := 0;
  351.  
  352.       tempSet := Port[ICadr+ModemContrReg];
  353.       oldModemContrReg := tempSet AND 11;    { DTR and RTS }
  354.  
  355.       Port[ICadr+ModemContrReg] := tempSet OR 11;
  356.  
  357.       Int_Mask := rs_int;
  358.       oldIntEnableReg := Port[ICadr+IntEnableReg];
  359.       Port[ICadr+IntEnableReg] := rs_int;
  360.       UseTint := (TX_int AND rs_int) <> 0;
  361.  
  362.       ENABLE;
  363.  
  364.     END;
  365.     dummy := 50;
  366.     REPEAT
  367.       RS_BusyRead(ch,ok,com);               { Remove pending int's }
  368.       Dec(dummy);
  369.     UNTIL NOT ok OR (dummy = 0);
  370. END                                {RS_Start};
  371.  
  372. PROCEDURE RS_Stop(com: ComPortType);
  373. BEGIN
  374.   WITH RS_Buffer[com] DO
  375.     IF OldVector <> NIL THEN BEGIN
  376.       DISABLE;
  377.  
  378.     (* restore old mask in 8259: *)
  379.       Port[I8259ContrWord1] := Port[I8259ContrWord1] OR oldLevel;
  380.  
  381.     (* disable interrupts in 8250: *)
  382.       Port[ICadr+IntEnableReg] := oldIntEnableReg;
  383.     (* restore modem control register in 8250: *)
  384.       Port[ICadr+ModemContrReg] :=
  385.          (Port[ICadr+ModemContrReg] AND 244) OR oldModemContrReg;
  386.       ENABLE;
  387.  
  388.     (* restore the old interrupt vector *)
  389.       SetVector(IntNr,OldVector);
  390.       OldVector := NIL;
  391.     END;
  392. END                                {RS_Stop};
  393. (*
  394. PROCEDURE RS_Read(VAR ch: CHAR;com: WORD );
  395. VAR done : BOOLEAN;
  396. BEGIN
  397.   REPEAT
  398.     RS_BusyRead (ch, done, com);
  399.   UNTIL done;
  400. END                                {RS_Read};
  401. *)
  402. PROCEDURE RS_ClrBuffer(com: WORD);
  403. BEGIN
  404.   WITH RS_Buffer[com] DO BEGIN
  405.     Disable;
  406.     WORD(xin) := 0;
  407.     xout := 0;
  408.     tin := 0;
  409.     WORD(tout) := 0;
  410.     SendFirst := 0;
  411.     Enable;
  412.   END;
  413. END;                               {ClrBuffer}
  414.  
  415. PROCEDURE RS_Set_TX_Int(rs_int : RS_IntSet; com : WORD);
  416. BEGIN
  417.   WITH RS_Buffer[com] DO BEGIN
  418.     Disable;
  419.     tin := 0;
  420.     WORD(tout) := 0;
  421.     SendFirst := 0;
  422.     Int_Mask := rs_int;
  423.     Port[ICadr+IntEnableReg] := rs_int;
  424.     UseTint := (TX_int AND rs_int) <> 0;
  425.     Enable;
  426.   END;
  427. END;                               {RS_Set_TX_Int}
  428.  
  429. FUNCTION RS_Empty(com : WORD) : BOOLEAN;
  430. VAR ch : CHAR;
  431.     ok : BOOLEAN;
  432. BEGIN
  433.   WITH RS_Buffer[com] DO
  434.     RS_Empty := WORD(xin) = xout;
  435. END;                                 {EmptyBuffer}
  436.  
  437. PROCEDURE RS_Break(ms : WORD;com : WORD);
  438. VAR oldreg : BYTE;
  439. BEGIN
  440.   WITH RS_Buffer[com] DO BEGIN
  441.     WaitTX := TRUE;
  442.     WHILE Port[ICadr+LineStatusReg] AND 32 = 0 DO ; { wait for no traffic }
  443.     oldreg := Port[ICadr+LineContrReg];
  444.     Port[ICadr+LineContrReg]:= oldreg OR 64;
  445.     Delay(ms);
  446.     Port[ICadr+LineContrReg] := OldReg;
  447.     Delay(250);
  448.     WaitTX := FALSE;
  449.     IF NOT HostXoff THEN RS_Enable(com);
  450.   END;
  451. END;                                 {RS_Break}
  452.  
  453. PROCEDURE RS_StopLink(com : WORD);
  454. VAR bf : BYTE;
  455. BEGIN
  456.   WITH RS_Buffer[com] DO
  457.     IF AutoXoff THEN BEGIN
  458.       Disable;
  459.       bf := BufferFilled;
  460.       BufferFilled := BufferFilled OR 2;
  461.       Enable;
  462.       IF bf = 0 THEN BEGIN
  463.         RS_WriteFirst(Xoff1C,com);
  464.         Delay(10);
  465.       END;
  466.     END;
  467. END;
  468.  
  469. PROCEDURE RS_StartLink(com : WORD);
  470. VAR bf : BYTE;
  471. BEGIN
  472.   WITH RS_Buffer[com] DO
  473.     IF AutoXoff THEN BEGIN
  474.       Disable;
  475.       BufferFilled := BufferFilled AND 253;
  476.       bf := BufferFilled;
  477.       Enable;
  478.       IF bf = 0 THEN BEGIN
  479.         RS_WriteFirst(Xon1C,com);
  480.       END;
  481.     END;
  482. END;
  483.  
  484. VAR SaveExit : Pointer;
  485.  
  486. PROCEDURE RS_StopAll;
  487. BEGIN
  488.   RS_Stop(1);
  489.   RS_Stop(2);
  490.   RS_Stop(3);
  491.   RS_Stop(4);
  492.   ExitProc := SaveExit;
  493. END;
  494.  
  495. BEGIN
  496.   FillChar(RS_Buffer,SizeOf(RS_Buffer),#0);
  497.   RS_BufPtr[1] := Addr(RS_Buffer[1]);
  498.   RS_BufPtr[2] := Addr(RS_Buffer[2]);
  499.   RS_BufPtr[3] := Addr(RS_Buffer[3]);
  500.   RS_BufPtr[4] := Addr(RS_Buffer[4]);
  501.   RS_TimeOut := 0;
  502.   SaveExit := ExitProc;
  503.   ExitProc := @RS_StopAll;
  504. END.
  505.