home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBBS / ECO_COMM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-26  |  28.5 KB  |  778 lines
  1. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 65520, 0, 655360}
  3. unit eco_comm;
  4.  
  5. interface
  6.  
  7. uses
  8.   dos;
  9.  
  10.  
  11.   {- standard baudrates:                                                     -}
  12.   {- 50, 75, 110, 134 (134.5), 150, 300, 600, 1200, 1800, 2000, 2400, 3600,  -}
  13.   {- 4800, 7200, 9600, 19200, 38400, 57600, 115200                           -}
  14.  
  15.  
  16.   function opencom            {- open a comport for communication            -}
  17.     (nr         : byte;       {- internal portnumber: 0-7                    -}
  18.      address    : word;       {- port address in hex: 000-3f8                -}
  19.      irqnum     : byte;       {- port irq number: 0-7  (255 for no irq)      -}
  20.      baudrate   : longint;    {- baudrate: (see table)                       -}
  21.      paritybit  : char;       {- parity  : 'O','E' or 'N'                    -}
  22.      databits   : byte;       {- databits: 5-8                               -}
  23.      stopbits   : byte;       {- stopbits: 1-2                               -}
  24.      buffersize : word;       {- size of input buffer: 0-65535               -}
  25.      handshake  : boolean)    {- true to use hardware handshake              -}
  26.        : boolean;             {- returns true if ok                          -}
  27.  
  28.   procedure closecom          {- close a open comport                        -}
  29.     (nr : byte);              {- internal portnumber: 0-7                    -}
  30.  
  31.   procedure resetcom          {- reset a open comport incl. buffer           -}
  32.     (nr : byte);              {- internal portnumber: 0-7                    -}
  33.  
  34.   procedure comsettings       {- change settings for a open comport          -}
  35.     (nr        : byte;        {- internal portnumber: 0-7                    -}
  36.      baudrate  : longint;     {- baudrate: (see table)                       -}
  37.      paritybit : char;        {- parity  : 'O','E' or 'N'                    -}
  38.      databits  : byte;        {- databits: 5-8                               -}
  39.      stopbits  : byte;        {- stopbits: 1-2                               -}
  40.      handshake : boolean);    {- true to use hardware handshake              -}
  41.  
  42.   function comaddress         {- return the address for a comport (bios)     -}
  43.     (comport : byte)          {- comport: 1-8                                -}
  44.       : word;                 {- address found for comport (0 if none)       -}
  45.  
  46.   function writecom           {- writes a character to a port                -}
  47.     (nr : byte;               {- internal portnumber: 0-7                    -}
  48.      ch : char)               {- character to be written to port             -}
  49.       : boolean;              {- true if character send                      -}
  50.  
  51.   function writecomstring     {- writes a string to a port                   -}
  52.     (nr : byte;               {- internal portnumber: 0-7                    -}
  53.      st : string)             {- string to be written to port                -}
  54.       : boolean;              {- true if string send                         -}
  55.  
  56.   function checkcom           {- check if any character is arrived           -}
  57.     (nr : byte;               {- internal portnumber: 0-7                    -}
  58.      var ch : char)           {- character arrived                           -}
  59.       : boolean;              {- returns true and character if any           -}
  60.  
  61.   function comerror           {- returns status of the last operation        -}
  62.       : integer;              {- 0 = ok                                      -}
  63.                               {- 1 = not enough memory                       -}
  64.                               {- 2 = port not open                           -}
  65.                               {- 3 = port already used once                  -}
  66.                               {- 4 = selected irq already used once          -}
  67.                               {- 5 = invalid port                            -}
  68.                               {- 6 = timeout                                 -}
  69.                               {- 7 = port failed loopback test               -}
  70.                               {- 8 = port failed irq test                    -}
  71.  
  72.   function testcom            {- performs a loopback and irq test on a port  -}
  73.     (nr : byte)               {- internal port number: 0-7                   -}
  74.       : boolean;              {- true if port test ok                        -}
  75.                               {- note: this test is performed during opencom -}
  76.                               {- if enabled (testcom is by default enabled   -}
  77.                               {- during opencom, but can be disabled with    -}
  78.                               {- the disabletestcom rutine)                  -}
  79.  
  80.   procedure enabletestcom;    {- enable testcom during openport (default on) -}
  81.  
  82.   procedure disabletestcom;   {- disable testcom during openport             -}
  83.  
  84.   function comused            {- check whether or not a port is open         -}
  85.     (nr : byte)               {- internal port number: 0-7                   -}
  86.       : boolean;              {- true if port is open and in use             -}
  87.                               {- note: this rutine can not test whether or   -}
  88.                               {- not a comport is used by another application-}
  89.  
  90.   function irqused            {- check whether or not an irq is used         -}
  91.     (irqnum : byte)           {- irq number: 0-7                             -}
  92.       : boolean;              {- true if irq is used                         -}
  93.                               {- note: this rutine can not test whether or   -}
  94.                               {- not an irq is used by another application   -}
  95.  
  96.   function irqinuse           {- test irq in use on the pic                  -}
  97.     (irqnum : byte)           {- irq number: 0-7                             -}
  98.       : boolean;              {- true if irq is used                         -}
  99.  
  100.   procedure setirqpriority    {- set the irq priority level on the pic       -}
  101.     (irqnum : byte);          {- irq number: 0-7                             -}
  102.                               {- the irqnum specified will get the highest   -}
  103.                               {- priority, the following irq number will then-}
  104.                               {- have the next highest priotity and so on    -}
  105.  
  106.   procedure clearbuffer       {- clear the input buffer for a open port      -}
  107.     (nr : byte);              {- internal port number: 0-7                   -}
  108.  
  109.  
  110.  
  111.  
  112.  
  113. implementation
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120. type
  121.   buffer = array[1..65535] of byte;  {- dummy type for interrupt buffer      -}
  122.  
  123.   portrec = record                   {- portdata type                        -}
  124.     inuse   : boolean;               {- true if port is used                 -}
  125.     addr    : word;                  {- selected address                     -}
  126.     irq     : byte;                  {- selected irq number                  -}
  127.     oldirq  : byte;                  {- status of irq before initcom         -}
  128.     hshake  : boolean;               {- hardware handshake on/off            -}
  129.  
  130.     buf     : ^buffer;               {- pointer to allocated buffer          -}
  131.     bufsize : word;                  {- size of allocated buffer             -}
  132.     oldvec  : pointer;               {- saved old interrupt vector           -}
  133.  
  134.     baud    : longint;               {- selected baudrate                    -}
  135.     parity  : char;                  {- selected parity                      -}
  136.     databit : byte;                  {- selected number of databits          -}
  137.     stopbit : byte;                  {- selected number of stopbits          -}
  138.  
  139.     inptr   : word;                  {- pointer to buffer input index        -}
  140.     outptr  : word;                  {- pointer to buffer output index       -}
  141.  
  142.     reg0    : byte;                  {- saved uart register 0                -}
  143.     reg1    : array[1..2] of byte;   {- saved uart register 1's              -}
  144.     reg2    : byte;                  {- saved uart register 2                -}
  145.     reg3    : byte;                  {- saved uart register 3                -}
  146.     reg4    : byte;                  {- saved uart register 4                -}
  147.     reg6    : byte;                  {- saved uart register 6                -}
  148.   end;
  149.  
  150. var
  151.   comresult   : integer;                    {- last error (call comerror)    -}
  152.   exitchainp  : pointer;                    {- saved exitproc pointer        -}
  153.   oldport21   : byte;                       {- saved pic status              -}
  154.   ports       : array[0..7] of portrec;     {- the 8 ports supported         -}
  155.  
  156. const
  157.   pic = $20;                                {- pic control address           -}
  158.   eoi = $20;                                {- pic control byte              -}
  159.   testcomenabled : boolean = true;          {- test port during opencom      -}
  160.  
  161. procedure disableinterrupts;                {- disable interrupt             -}
  162.   begin
  163.     inline($fa);                            {- cli (clear interruptflag)     -}
  164.   end;
  165.  
  166. procedure enableinterrupts;                 {- enable interrupts             -}
  167.   begin
  168.     inline($fb);                            {- sti (set interrupt flag)      -}
  169.   end;
  170.  
  171. procedure port0int; interrupt;                   {- interrupt rutine port 0  -}
  172.  
  173.   begin
  174.     with ports[0] do
  175.       begin
  176.         buf^[inptr] := port[addr];                {- read data from port     -}
  177.         inc(inptr);                               {- count one step forward.. }
  178.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  179.       end;
  180.     port[pic] := eoi;                             {- send eoi to pic         -}
  181.   end;
  182.  
  183. procedure port1int; interrupt;                    {- interrupt rutine port 1 -}
  184.  
  185.   begin
  186.     with ports[1] do
  187.       begin
  188.         buf^[inptr] := port[addr];                {- read data from port     -}
  189.         inc(inptr);                               {- count one step forward.. }
  190.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  191.       end;
  192.     port[pic] := eoi;                             {- send eoi to pic         -}
  193.   end;
  194.  
  195. procedure port2int; interrupt;                    {- interrupt rutine port 2 -}
  196.  
  197.   begin
  198.     with ports[2] do
  199.       begin
  200.         buf^[inptr] := port[addr];                {- read data from port     -}
  201.         inc(inptr);                               {- count one step forward.. }
  202.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  203.       end;
  204.     port[pic] := eoi;                             {- send eoi to pic         -}
  205.   end;
  206.  
  207. procedure port3int; interrupt;                    {- interrupt rutine port 3 -}
  208.  
  209.   begin
  210.     with ports[3] do
  211.       begin
  212.         buf^[inptr] := port[addr];                {- read data from port     -}
  213.         inc(inptr);                               {- count one step forward.. }
  214.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  215.       end;
  216.     port[pic] := eoi;                             {- send eoi to pic         -}
  217.   end;
  218.  
  219. procedure port4int; interrupt;                    {- interrupt rutine port 4 -}
  220.  
  221.   begin
  222.     with ports[4] do
  223.       begin
  224.         buf^[inptr] := port[addr];                {- read data from port     -}
  225.         inc(inptr);                               {- count one step forward.. }
  226.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  227.       end;
  228.     port[pic] := eoi;                             {- send eoi to pic         -}
  229.   end;
  230.  
  231. procedure port5int; interrupt;                    {- interrupt rutine port 5 -}
  232.  
  233.   begin
  234.     with ports[5] do
  235.       begin
  236.         buf^[inptr] := port[addr];                {- read data from port     -}
  237.         inc(inptr);                               {- count one step forward.. }
  238.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  239.       end;
  240.     port[pic] := eoi;                             {- send eoi to pic         -}
  241.   end;
  242.  
  243.  
  244.  
  245.  
  246. procedure port6int; interrupt;                    {- interrupt rutine port 6 -}
  247.  
  248.   begin
  249.     with ports[6] do
  250.       begin
  251.         buf^[inptr] := port[addr];                {- read data from port     -}
  252.         inc(inptr);                               {- count one step forward.. }
  253.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  254.       end;
  255.     port[pic] := eoi;                             {- send eoi to pic         -}
  256.   end;
  257.  
  258. procedure port7int; interrupt;                    {- interrupt rutine port 7 -}
  259.  
  260.   begin
  261.     with ports[7] do
  262.       begin
  263.         buf^[inptr] := port[addr];                {- read data from port     -}
  264.         inc(inptr);                               {- count one step forward.. }
  265.         if inptr > bufsize then inptr := 1;       {  .. in buffer            -}
  266.       end;
  267.     port[pic] := eoi;                             {- send eoi to pic         -}
  268.   end;
  269.  
  270. procedure initport(nr : byte; savestatus : boolean);   {- port initialize    -}
  271.  
  272. var
  273.   divider  : word;                                {- baudrate divider number -}
  274.   ctrlbits : byte;                                {- uart control byte       -}
  275.  
  276.   begin
  277.     with ports[nr] do
  278.       begin
  279.         divider := 115200 div baud;                 {- calc baudrate divider -}
  280.  
  281.         ctrlbits := databit - 5;                    {- insert databits       -}
  282.  
  283.         if parity <> 'N' then
  284.           begin
  285.             ctrlbits := ctrlbits or $08;            {- insert parity enable  -}
  286.             if parity = 'E' then                    {- enable even parity    -}
  287.               ctrlbits := ctrlbits or $10;
  288.           end;
  289.  
  290.         if stopbit = 2 then
  291.           ctrlbits := ctrlbits or $04;              {- insert stopbits       -}
  292.  
  293.         if savestatus then reg3 := port[addr + $03];    {- save register 3   -}
  294.         port[addr + $03] := $80;                        {- baudrate change   -}
  295.  
  296.         if savestatus then reg0 := port[addr + $00];    {- save lo baud      -}
  297.         port[addr + $00] := lo(divider);                {- set lo baud       -}
  298.  
  299.         if savestatus then reg1[2] := port[addr + $01]; {- save hi baud      -}
  300.         port[addr + $01] := hi(divider);                {- set hi baud       -}
  301.  
  302.         port[addr + $03] := ctrlbits;                   {- set control reg.  -}
  303.         if savestatus then reg6 := port[addr + $06];    {- save register 6   -}
  304.       end;
  305.   end;
  306.  
  307. function irqused(irqnum : byte) : boolean;
  308.  
  309. var
  310.   count : byte;
  311.   found : boolean;
  312.  
  313.   begin
  314.     found := false;                                 {- irq not found         -}
  315.     count := 0;                                     {- start with port 0     -}
  316.  
  317.     while (count <= 7) and not found do             {- count the 8 ports     -}
  318.       with ports[count] do
  319.         begin
  320.           if inuse then
  321.             found := irqnum = irq;                  {- check irq match       -}
  322.           inc(count);                               {- next port             -}
  323.         end;
  324.  
  325.     irqused := found;                               {- return irq found      -}
  326.   end;
  327.  
  328. procedure enabletestcom;
  329.   begin
  330.     testcomenabled := true;
  331.   end;
  332.  
  333. procedure disabletestcom;
  334.   begin
  335.     testcomenabled := false;
  336.   end;
  337.  
  338.  
  339.  
  340.  
  341. function testcom(nr : byte) : boolean;
  342.  
  343. var
  344.   oldreg0   : byte;
  345.   oldreg1   : byte;
  346.   oldreg4   : byte;
  347.   oldreg5   : byte;
  348.   oldreg6   : byte;
  349.   oldinptr  : word;
  350.   oldoutptr : word;
  351.   timeout   : integer;
  352.  
  353.   begin
  354.     testcom := false;
  355.  
  356.     with ports[nr] do
  357.       begin
  358.         if inuse then
  359.           begin
  360.             oldinptr  := inptr;
  361.             oldoutptr := outptr;
  362.             oldreg1 := port[addr + $01];
  363.             oldreg4 := port[addr + $04];
  364.             oldreg5 := port[addr + $05];
  365.             oldreg6 := port[addr + $06];
  366.  
  367.             port[addr + $05] := $00;
  368.             port[addr + $04] := port[addr + $04] or $10;
  369.  
  370.             oldreg0 := port[addr + $00];
  371.             outptr  := inptr;
  372.  
  373.             timeout := maxint;
  374.             port[addr + $00] := oldreg0;
  375.  
  376.             while (port[addr + $05] and $01 = $00) and (timeout <> 0) do
  377.               dec(timeout);
  378.  
  379.             if timeout <> 0 then
  380.               begin
  381.                 if port[addr + $00] = oldreg0 then
  382.                   begin
  383.                     if irq in [0..7] then
  384.                       begin
  385.                         timeout := maxint;
  386.                         outptr := inptr;
  387.  
  388.                         port[addr + $01] := $08;
  389.                         port[addr + $04] := $08;
  390.                         port[addr + $06] := port[addr + $06] or $01;
  391.  
  392.                         while (inptr = outptr) and (timeout <> 0) do
  393.                           dec(timeout);
  394.  
  395.                         port[addr + $01] := oldreg1;
  396.  
  397.                         if (inptr <> outptr) then
  398.                           testcom := true
  399.                         else
  400.                           comresult := 8;
  401.                       end
  402.                     else
  403.                       testcom := true;
  404.                   end
  405.                 else
  406.                   comresult := 7;            {- loopback test failed -}
  407.               end
  408.             else
  409.               comresult := 6;                {- timeout -}
  410.  
  411.             port[addr + $04] := oldreg4;
  412.             port[addr + $05] := oldreg5;
  413.             port[addr + $06] := oldreg6;
  414.  
  415.             for timeout := 1 to maxint do;
  416.             if port[addr + $00] = 0 then;
  417.  
  418.             inptr  := oldinptr;
  419.             outptr := oldoutptr;
  420.           end
  421.         else
  422.           comresult := 2;                    {- port not open -}
  423.       end;
  424.   end;
  425.  
  426. procedure closecom(nr : byte);
  427.  
  428.   begin
  429.     with ports[nr] do
  430.       begin
  431.         if inuse then
  432.           begin
  433.             inuse := false;
  434.  
  435.             if irq <> 255 then                          {- if interrupt used -}
  436.               begin
  437.                 freemem(buf,bufsize);                   {- deallocate buffer -}
  438.                 disableinterrupts;
  439.                 port[$21] := port[$21] or ($01 shl irq) and oldirq; {-restore-}
  440.                 port[addr + $04] := reg4;               {- disable uart out2 -}
  441.                 port[addr + $01] := reg1[1];            {- disable uart int. -}
  442.                 setintvec($08+irq,oldvec);              {- restore int.vector-}
  443.                 enableinterrupts;
  444.               end;
  445.  
  446.             port[addr + $03] := $80;                    {- uart baud set     -}
  447.             port[addr + $00] := reg0;                   {- reset lo baud     -}
  448.             port[addr + $01] := reg1[2];                {- reset hi baud     -}
  449.             port[addr + $03] := reg3;                   {- restore uart ctrl.-}
  450.             port[addr + $06] := reg6;                   {- restore uart reg6 -}
  451.           end
  452.         else
  453.           comresult := 2;                               {- port not in use   -}
  454.       end;
  455.   end;
  456.  
  457.  
  458.  
  459.  
  460. function opencom
  461.  (nr : byte; address  : word; irqnum : byte; baudrate : longint;
  462.   paritybit : char; databits, stopbits : byte; buffersize : word;
  463.   handshake : boolean) : boolean;
  464.  
  465. var
  466.   intvec : pointer;
  467.   olderr : integer;
  468.  
  469.   begin
  470.     opencom := false;
  471.  
  472.     if (irqnum = 255) or
  473.     ((irqnum in [0..7]) and (maxavail >= longint(buffersize))
  474.     and not irqused(irqnum)) then
  475.       with ports[nr] do
  476.         begin
  477.           if not inuse and (address <= $3f8) then
  478.             begin
  479.               inuse   := true;                    {- port now in use         -}
  480.  
  481.               addr    := address;                 {- save parameters         -}
  482.               irq     := irqnum;
  483.               hshake  := handshake;
  484.               bufsize := buffersize;
  485.               baud    := baudrate;
  486.               parity  := paritybit;
  487.               databit := databits;
  488.               stopbit := stopbits;
  489.  
  490.               inptr   := 1;                       {- reset inputpointer      -}
  491.               outptr  := 1;                       {- reset outputpointer     -}
  492.  
  493.               if (irq in [0..7]) and (bufsize > 0) then
  494.                 begin
  495.                   getmem(buf,bufsize);            {- allocate buffer         -}
  496.                   getintvec($08+irq,oldvec);      {- save interrupt vector   -}
  497.  
  498.                   case nr of                      {- find the interrupt proc.-}
  499.                     0 : intvec := @port0int;
  500.                     1 : intvec := @port1int;
  501.                     2 : intvec := @port2int;
  502.                     3 : intvec := @port3int;
  503.                     4 : intvec := @port4int;
  504.                     5 : intvec := @port5int;
  505.                     6 : intvec := @port6int;
  506.                     7 : intvec := @port7int;
  507.                   end;
  508.  
  509.                   reg1[1] := port[addr + $01];    {- save register 1         -}
  510.                   reg4    := port[addr + $04];    {- save register 4         -}
  511.                   oldirq  := port[$21] or not ($01 shl irq);  {- save pic irq-}
  512.  
  513.                   disableinterrupts;              {- disable interrupts      -}
  514.                   setintvec($08+irq,intvec);      {- set the interrupt vector-}
  515.                   port[addr + $04] := $08;        {- enable out2 on port     -}
  516.                   port[addr + $01] := $01;        {- set port data avail.int.-}
  517.                   port[$21] := port[$21] and not ($01 shl irq); {- enable irq-}
  518.                   enableinterrupts;               {- enable interrupts again -}
  519.                 end;
  520.  
  521.               initport(nr,true);                  {- initialize port         -}
  522.  
  523.               if testcomenabled then
  524.                 begin
  525.                   if not testcom(nr) then
  526.                     begin
  527.                       olderr := comresult;
  528.                       closecom(nr);
  529.                       comresult := olderr;
  530.                     end
  531.                   else
  532.                     opencom := true;
  533.                 end
  534.               else
  535.                 opencom := true;
  536.  
  537.               if port[addr + $00] = 0 then;  {- remove any pending character -}
  538.               if port[addr + $05] = 0 then;  {- reset line status register   -}
  539.  
  540.               port[addr + $04] := port[addr + $04] or $01;     {- enable dtr -}
  541.             end
  542.           else if inuse then
  543.             comresult := 3                        {- port already in use     -}
  544.           else if (address > $3f8) then
  545.             comresult := 5;                       {- invalid port address    -}
  546.         end
  547.     else if (maxavail >= buffersize) then         {- not enough memory       -}
  548.       comresult := 1
  549.     else if irqused(irqnum) then                  {- irq already used        -}
  550.       comresult := 4;
  551.   end;
  552.  
  553. procedure resetcom(nr : byte);
  554.  
  555.   begin
  556.     with ports[nr] do
  557.       begin
  558.         if inuse then                        {- is port defined ?            -}
  559.           begin
  560.             inptr  := 1;                     {- reset buffer pointers        -}
  561.             outptr := 1;
  562.             initport(nr,false);              {- reinitialize the port        -}
  563.  
  564.             if port[addr + $00] = 0 then;    {- remove any pending character -}
  565.             if port[addr + $05] = 0 then;    {- reset line status register   -}
  566.           end
  567.         else
  568.           comresult := 2;                    {- port not open                -}
  569.       end;
  570.   end;
  571.  
  572. procedure comsettings(nr : byte; baudrate : longint; paritybit : char;
  573.   databits, stopbits : byte; handshake : boolean);
  574.  
  575.   begin
  576.     with ports[nr] do
  577.       begin
  578.         if inuse then                                     {- is port in use  -}
  579.           begin
  580.             baud    := baudrate;                          {- save parameters -}
  581.             parity  := paritybit;
  582.             databit := databits;
  583.             stopbit := stopbits;
  584.             hshake  := handshake;
  585.  
  586.             initport(nr,false);                           {- reinit port     -}
  587.           end
  588.         else
  589.           comresult := 2;                                 {- port not in use -}
  590.       end;
  591.   end;
  592.  
  593.  
  594.  
  595.  
  596. function comaddress(comport : byte) : word;
  597.  
  598.   begin
  599.     if comport in [1..8] then
  600.       comaddress := memw[$40:(pred(comport) shl 1)]       {- bios data table -}
  601.     else
  602.       comresult := 5;                                     {- invalid port    -}
  603.   end;
  604.  
  605. function writecom(nr : byte; ch : char) : boolean;
  606.  
  607. var
  608.   count : integer;
  609.  
  610.   begin
  611.     writecom := true;
  612.  
  613.     with ports[nr] do
  614.       if inuse then
  615.         begin
  616.           while port[addr + $05] and $20 = $00 do;   {- wait until char send -}
  617.  
  618.           if not hshake then
  619.             port[addr] := ord(ch)                    {- send char to port    -}
  620.           else
  621.             begin
  622.               port[addr + $04] := $0b;               {- out2, dtr, rts       -}
  623.               count := maxint;
  624.  
  625.               while (port[addr + $06] and $10 = 0) and (count <> 0) do
  626.                 dec(count);                          {- wait for cts         -}
  627.  
  628.               if count <> 0 then                     {- if not timeout       -}
  629.                 port[addr] := ord(ch)                {- send char to port    -}
  630.               else
  631.                 begin
  632.                   comresult := 6;                    {- timeout error        -}
  633.                   writecom  := false;
  634.                 end;
  635.             end;
  636.         end
  637.       else
  638.         begin
  639.           comresult := 2;                            {- port not in use      -}
  640.           writecom  := false;
  641.         end;
  642.   end;
  643.  
  644. function writecomstring(nr : byte; st : string) : boolean;
  645.  
  646. var
  647.   ok : boolean;
  648.   count : byte;
  649.  
  650.   begin
  651.     if length(st) > 0 then                           {- any chars to send ?  -}
  652.       begin
  653.         ok    := true;
  654.         count := 1;
  655.         while (count <= length(st)) and ok do        {- count chars          -}
  656.           begin
  657.             ok := writecom(nr,st[count]);            {- send char            -}
  658.             inc(count);                              {- next character       -}
  659.           end;
  660.         writecomstring := ok;                        {- return status        -}
  661.       end;
  662.   end;
  663.  
  664. function checkcom(nr : byte; var ch : char) : boolean;
  665.  
  666.   begin
  667.     with ports[nr] do
  668.       begin
  669.         if inptr <> outptr then                      {- any char in buffer ? -}
  670.           begin
  671.             ch := chr(buf^[outptr]);                 {- get char from buffer -}
  672.             inc(outptr);                             {- count outpointer up  -}
  673.             if outptr > bufsize then outptr := 1;
  674.             checkcom := true;
  675.           end
  676.         else
  677.           checkcom := false;                         {- no char in buffer    -}
  678.       end;
  679.   end;
  680.  
  681.  
  682.  
  683. function comerror : integer;
  684.  
  685.   begin
  686.     comerror := comresult;                           {- return last error    -}
  687.     comresult := 0;
  688.   end;
  689.  
  690. function comused(nr : byte) : boolean;
  691.  
  692.   begin
  693.     comused := ports[nr].inuse;                      {- return used status   -}
  694.   end;
  695.  
  696. function irqinuse(irqnum : byte) : boolean;
  697.  
  698. var
  699.   irqon : byte;
  700.   mask  : byte;
  701.  
  702.   begin
  703.     irqinuse := false;
  704.  
  705.     if irqnum in [0..7] then
  706.       begin
  707.         irqon := port[$21];         {-1111 0100-}
  708.         mask  := ($01 shl irqnum);
  709.         irqinuse := irqon or not mask = not mask;
  710.       end;
  711.   end;
  712.  
  713. procedure setirqpriority(irqnum : byte);
  714.  
  715.   begin
  716.     if irqnum in [0..7] then
  717.       begin
  718.         if irqnum > 0 then dec(irqnum)
  719.         else irqnum := 7;
  720.  
  721.         disableinterrupts;
  722.         port[pic] := $c0 + irqnum;
  723.         enableinterrupts;
  724.       end;
  725.   end;
  726.  
  727. procedure clearbuffer(nr : byte);
  728.  
  729.   begin
  730.     with ports[nr] do
  731.       if inuse and (bufsize > 0) then
  732.         begin
  733.           outptr := inptr;
  734.         end;
  735.   end;
  736.  
  737. procedure deinit;
  738.  
  739. var
  740.   count : byte;
  741.  
  742.   begin
  743.     for count := 0 to 7 do closecom(count);          {- close open ports     -}
  744.  
  745.     disableinterrupts;
  746.     port[$21] := oldport21;                          {- restore pic status   -}
  747.     port[$20] := $c7;                                {- irq0 1. priority     -}
  748.     enableinterrupts;
  749.  
  750.     exitproc := exitchainp;                          {- restore exitproc     -}
  751.   end;
  752.  
  753. procedure init;
  754.  
  755. var
  756.   count : byte;
  757.  
  758.   begin
  759.     comresult  := 0;
  760.     exitchainp := exitproc;                          {- save exitproc        -}
  761.     exitproc   := @deinit;                           {- set exitproc         -}
  762.  
  763.     for count := 0 to 7 do
  764.       ports[count].inuse := false;                   {- no ports open        -}
  765.  
  766.     oldport21 := port[$21];                          {- save pic status      -}
  767.   end;
  768.  
  769. {*****************************************************************************}
  770.  
  771. begin
  772.   init;
  773. end.
  774.  
  775. etasync v.1.04, 9/4 1992 et-soft
  776. turbo pascal unit with support for up to 8 serial ports.
  777.  
  778.