home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / INTERR.ZIP / INTERR.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  24.4 KB  |  549 lines
  1. {----------------------------------------------------------------------------
  2.       Interr is a program written to demonstrate the use of both
  3.  interrupt routines and com port communication.  There are some inline
  4.  instructions that are used in the interrupt routine that do not appear in
  5.  the Turbo manual.  This is because the Turbo manual contains incomplete
  6.  inline coding.  When making your own interrupt handlers be sure to save
  7.  all registers,  as has been done in this example.  There is also a
  8.  restoration of the DS register in the handler.  When an interrupt occurs
  9.  all segment registers are set to the code segment of the interrupt routine
  10.  this disallows the use of global variables,  because of a destroyed DS
  11.  register.  To counter act this affect,  the DS is restored via an absolute
  12.  variable "segment".
  13.  
  14. SOURCE 'DUMTRM.PAS' FROM DL 1
  15.  
  16. Written by,
  17.   Jim McCarthy
  18.   Technical Support
  19.   Borland International
  20.  
  21.   and
  22.   Andy Batony
  23.   Teleware Incorporated
  24.  
  25.   MODIFIED FOR XON/XOFF SUPPORT, fixed transmitt bug, added
  26.   queue handling code and other support functions.
  27.  
  28.   Gary Miller
  29.   Perception Technology Corp.
  30.  
  31. -----------------------------------------------------------------------------}
  32.  
  33.   CONST
  34.     irq4       = $30;                         { Interrupt vector address for }
  35.                                               { COM1.                        }
  36.     irq3       = $2C;                         { Vector for COM2.             }
  37.     com1base   = $03F8;                       { Port address of COM1.        }
  38.     com2base   = $02F8;                       { Port address of COM2.        }
  39.                                               { Offset to add to com#base for}
  40.     intenreg   = 1;                           {   Interrupt enable register  }
  41.     intidreg   = 2;                           {   Interrupt id register      }
  42.     linectrl   = 3;                           {   Line control register      }
  43.     modemctrl  = 4;                           {   Modem control register     }
  44.     linestat   = 5;                           {   Line status register       }
  45.     modemstat  = 6;                           {   Modem status register      }
  46.     eoi = $20;                                { End of interrupt command     }
  47.     queue_size=1024;                          { queue size, set to any value }
  48.     max_queue_depth=768;                      { critical point for xoff      }
  49.     Xoff=$13;                                 { xoff byte                    }
  50.     Xon=$11;                                  { xon byte                     }
  51.     CXon=#$11;                                { xon character                }
  52.     CXoff=#$13;                               { xoff character               }
  53.     MaxWait=200;                              { maximum wait while xoffed    }
  54.  
  55.   TYPE                                        { Type declarations            }
  56.     ratetype   = (rate300,rate1200,rate4800,rate9600);
  57.     bitsperchartype = (_8bits,_7bits,_6bits,_5bits,Nobits);
  58.     paritytype = (even,odd,none,whoknows);
  59.     stopbittype = (onestopbit,twostopbit,nostopbit);
  60.     comtype    = (com1,com2);
  61.     Busy       = Array [comtype] of boolean;
  62.     bytechar   = record case boolean of
  63.                    true :(b:byte);
  64.                    false:(c:char)
  65.                  end;
  66.  
  67.     queue_value = bytechar;
  68.     queue_type  = record
  69.                     f,r       :  integer;  { front, rear pointers }
  70.                     DepthFlag :  boolean;  { true if input XOFFed }
  71.                     err       :  boolean;  { queue error, full ect }
  72.                     data      :  array [0..queue_size] of queue_value;
  73.                   end;
  74.  
  75.     regrec     = record
  76.                    ax,bx,cx,dx,bp,di,si,ds,es,flags : integer;
  77.                  end;
  78.     Str255     = String[255];
  79.  
  80.  
  81.   VAR
  82.     segment      : integer absolute cseg:$00A0;  { Address for storing DS    }
  83.     com1vecseg,                               { Segment of DOS set           }
  84.     com1vecoff,                               { Offset of DOS set com int.   }
  85.     com2vecseg,                               { Segment of DOS set           }
  86.     com2vecoff,                               { Offset of DOS set com int.   }
  87.     comport      : integer;                   { Comport address              }
  88.     tbyte,
  89.     lbyte        : integer;                   { global var for interrupt     }
  90.     comp         : comtype;                   { Used to specify which comport}
  91.     registers    : regrec;                    { Registers used in DOS call   }
  92.     ComBusy      : Busy;                      { Comport trans busy flags     }
  93.     GPPqueue,
  94.     com1queue,
  95.     com2queue    :  queue_type;               { input queue                  }
  96.     OutputXoffed :  array [comtype] of boolean;{XOFFed flag                  }
  97.     com1_OverRun,
  98.     com2_OverRun :  boolean;                  { Queue overrun flags          }
  99.  
  100. {----------------------------------------------------------------------------
  101.       This is the interrupt handler for the COM1 or COM2 comports.  Notice
  102.  the restoration of the DS register through a move to the AX from address
  103.  CS:00A0.  The absolute variable "segment" is initialized at the begining
  104.  of the program to contain the value of "DSEG".  The inline statments should
  105.  replace the current ones in the Turbo reference manual.
  106. ----------------------------------------------------------------------------}
  107.  
  108.   PROCEDURE IntCOM1_Handler;
  109.  
  110.     BEGIN
  111.       inline( $50            { push ax        }
  112.              /$53            { push bx        }
  113.              /$51            { push cx        }
  114.              /$52            { push dx        }    { Save all the registers }
  115.              /$57            { push di        }
  116.              /$56            { push si        }
  117.              /$06            { push es        }
  118.              /$1E            { push ds        }
  119.              /$2E            { cs:            }
  120.              /$A1 /$A0 /$00  { mov ax, [00A0] }    { Get the Current data    }
  121.              /$50            { push ax        }    { segment                 }
  122.              /$1F            { pop ds         } ); { Restore the DS register }
  123.       lbyte := port[ com1base + intidreg ];    { Get Interrupt ID             }
  124.       lbyte := ( lbyte shr 1 ) and $03;        { Isolate ID bits              }
  125.       If lbyte = 1 then                        { Check for Transmit done      }
  126.         ComBusy[com1]:=false                   { Clear busy flag              }
  127.       else                                     {                              }
  128.       If lbyte = 2 then                        { Check for Received Data      }
  129.         begin                                  { process the data             }
  130.           tbyte := port[ com1base ];           { Get the character in the port}
  131.           lbyte := port[ com1base + linestat ];{ Get the status of the port   }
  132.           If (tbyte=Xon) or (tbyte=Xoff) then
  133.             begin
  134.               If tbyte=Xon then OutputXoffed[com1]:=false
  135.               else              OutputXoffed[com1]:=true;
  136.             end
  137.           else
  138.           If ((com1queue.r+1) mod queue_size)=com1queue.f then
  139.             COM1_OverRun:=true
  140.           else
  141.             begin
  142.               com1queue.r:=(com1queue.r+1) mod queue_size;
  143.               com1queue.data[com1queue.r].b:=tbyte;
  144.               if not com1queue.DepthFlag then
  145.                 if ((com1queue.r-com1queue.f) mod queue_size) >= max_queue_depth then
  146.                   begin
  147.                     repeat
  148.                       tbyte:=port[com1base+linestat];
  149.                     Until (tbyte and $20)=$20;
  150.                     port[com1base]:=Xoff;     { Output the character         }
  151.                     com1queue.DepthFlag:=true;
  152.                   end;
  153.             end;
  154.         end; { lbyte = 2 }
  155.       port[$20] := eoi;                       { signal end of interrupt code }
  156.       inline( $1F            { pop ds         }
  157.              /$07            { pop es         }
  158.              /$5E            { pop si         }
  159.              /$5F            { pop di         }
  160.              /$5A            { pop dx         }
  161.              /$59            { pop cx         }   { Restore all registers  }
  162.              /$5B            { pop bx         }
  163.              /$58            { pop ax         }
  164.              /$5D            { pop     bp     }   { Reset the stack to its }
  165.              /$89 /$EC       { mov     sp,bp  }   { proper position        }
  166.              /$5D            { pop     bp     }
  167.              /$CF );         { iret           }   { Return                 }
  168.     END;
  169.  
  170.   PROCEDURE IntCOM2_Handler;
  171.  
  172.     BEGIN
  173.       inline( $50            { push ax        }
  174.              /$53            { push bx        }
  175.              /$51            { push cx        }
  176.              /$52            { push dx        }    { Save all the registers }
  177.              /$57            { push di        }
  178.              /$56            { push si        }
  179.              /$06            { push es        }
  180.              /$1E            { push ds        }
  181.              /$2E            { cs:            }
  182.              /$A1 /$A0 /$00  { mov ax, [00A0] }    { Get the Current data    }
  183.              /$50            { push ax        }    { segment                 }
  184.              /$1F            { pop ds         } ); { Restore the DS register }
  185.       lbyte := port[ com2base + intidreg ];    { Get Interrupt ID             }
  186.       lbyte := ( lbyte shr 1 ) and $03;        { Isolate ID bits              }
  187.       If lbyte = 1 then                        { Check for Transmit done      }
  188.         ComBusy[com2]:=false                   { Clear busy flag              }
  189.       else                                     {                              }
  190.       If lbyte = 2 then                        { Check for Received Data      }
  191.         begin                                  { process the data             }
  192.           tbyte := port[ com2base ];           { Get the character in the port}
  193.           lbyte := port[ com2base + linestat ];{ Get the status of the port   }
  194.           If (tbyte=Xon) or (tbyte=Xoff) then
  195.             begin
  196.               If tbyte=Xon then OutputXoffed[com2]:=false
  197.               else              OutputXoffed[com2]:=true;
  198.             end
  199.           else
  200.           If ((com2queue.r+1) mod queue_size)=com2queue.f then
  201.             COM2_OverRun:=true
  202.           else
  203.             begin
  204.               com2queue.r:=(com2queue.r+1) mod queue_size;
  205.               com2queue.data[com2queue.r].b:=tbyte;
  206.               if not com2queue.DepthFlag then
  207.                 if ((com2queue.r-com2queue.f) mod queue_size) >= max_queue_depth then
  208.                   begin
  209.                     repeat
  210.                       tbyte:=port[com1base+linestat];
  211.                     Until (tbyte and $20)=$20;
  212.                     port[com2base]:=Xoff;     { Output the character         }
  213.                     com2queue.DepthFlag:=true;
  214.                   end;
  215.             end;
  216.         end; { lbyte = 2 }
  217.  
  218.       port[$20] := eoi;                       { signal end of interrupt code }
  219.       inline( $1F            { pop ds         }
  220.              /$07            { pop es         }
  221.              /$5E            { pop si         }
  222.              /$5F            { pop di         }
  223.              /$5A            { pop dx         }
  224.              /$59            { pop cx         }   { Restore all registers  }
  225.              /$5B            { pop bx         }
  226.              /$58            { pop ax         }
  227.              /$5D            { pop     bp     }   { Reset the stack to its }
  228.              /$89 /$EC       { mov     sp,bp  }   { proper position        }
  229.              /$5D            { pop     bp     }
  230.              /$CF );         { iret           }   { Return                 }
  231.     END;
  232.  
  233. {-----------------------------------------------------------------------------
  234.       This procedure sets the baud rate of the comport to either 300, 1200,
  235.  4800, or 9600 baud.  The communications protolcol parameters are also set
  236.  to the values passed.  The Divisor latches are set according to the table
  237.  the IBM hardware technical reference manual ( p. 1-238 ).
  238. -----------------------------------------------------------------------------}
  239.  
  240.   PROCEDURE SetCom(comport:integer;
  241.                    r:ratetype;
  242.                    b:bitsperchartype;
  243.                    s:stopbittype;
  244.                    p:paritytype);
  245.  
  246.     CONST
  247.       bits5=0;
  248.       bits6=1;
  249.       bits7=2;
  250.       bits8=3;
  251.       stopbit1=0;                             { These are constants used     }
  252.       stopbit2=4;                             { to define parity, stop bits, }
  253.       noparity=0;                             { data bits, etc.              }
  254.       oddparity=8;
  255.       evenparity=16;
  256.  
  257.     VAR
  258.       tlcr,                                   { Line control register        }
  259.       tdlmsb,                                 { Divisor latch MSB            }
  260.       tdllsb    : byte;                       { Divisor latch LSB            }
  261.       bits      : integer;                    { No of bits per char          }
  262.       stopbits  : integer;                    { No of stop bits per char     }
  263.       setparity : integer;                    { parity mode even, odd , none }
  264.  
  265.     BEGIN
  266.       tdlmsb:=0;                              { Set DL MSB to 0 for 1200,    }
  267.                                               { 4800 and 9600 baud           }
  268.       case r of                               { Use case to check baud rate  }
  269.         rate300 :  begin                      { Check for 300 baud           }
  270.                      tdlmsb:=1;               { Set DL MSB to 01             }
  271.                      tdllsb:=$80;             { Set DL LSB to 80             }
  272.                    end;                       { for a total of 0180          }
  273.         rate1200 : tdllsb:=$60;               { 1200 set LSB to 60           }
  274.         rate4800 : tdllsb:=$18;               { 4800 set LSB to 18           }
  275.         rate9600 : tdllsb:=$0c;               { 0C for 9600 baud             }
  276.       end;
  277.       tlcr := port[ comport ];                { Read the ports to clear any  }
  278.       tlcr := port[ comport + linestat ];     { error conditions             }
  279.       case p of                               { use case to check parity     }
  280.         even     : setparity:=evenparity;     { set for even parity          }
  281.         odd      : setparity:=oddparity;      { set for odd parity           }
  282.         none     : setparity:=noparity;       { set for no parity            }
  283.         else
  284.                    setparity:=noparity;       { default is no parity         }
  285.       end;
  286.       case s of                               { use case for stopbits        }
  287.         onestopbit : stopbits:=stopbit1;      { one stopbit                  }
  288.         twostopbit : stopbits:=stopbit2;      { two stopbits                 }
  289.         else
  290.                      stopbits:=stopbit1;      { default to 1 stopbit         }
  291.       end;
  292.       case b of                               { use case for bits per char   }
  293.        _8bits : bits:=bits8;                  { set to eight bits            }
  294.        _7bits : bits:=bits7;                  { set to seven bits            }
  295.        _6bits : bits:=bits6;                  { set to six bits              }
  296.        _5bits : bits:=bits5;                  { set to five bits             }
  297.        else
  298.                bits:=bits8;                   { default to eight bits        }
  299.       end;
  300.       port[ comport + linectrl ] := bits + stopbits + setparity;
  301.                                               { Set the protocall            }
  302.       tlcr:=port[comport+linectrl];           { Get the Line control register}
  303.       port[comport+linectrl]:=tlcr or $80;    { Set Divisor Latch Access Bit }
  304.       port[comport]:=tdllsb;                  { in order to access divisor   }
  305.       port[comport+1]:=tdlmsb;                { latches, then store the      }
  306.                                               { values for the desired baud  }
  307.                                               { rate                         }
  308.       port[comport+linectrl]:=tlcr and $7f;   { then clear the DLAB in order }
  309.                                               { to access to the receiver    }
  310.                                               { buffer                       }
  311.     END;
  312.  
  313. {-------------------------------------------------------------------------
  314.       The procedure IntOn sets up the interrupt handler vectors,  and
  315.  communication protocal.
  316. -------------------------------------------------------------------------}
  317.  
  318.   PROCEDURE IntOn(com:comtype);
  319.  
  320.     CONST
  321.       dtrtrue=1;
  322.       rtstrue=2;
  323.       bit3true=8;
  324.  
  325.     VAR
  326.       tbyte   : byte;                         { Temperary byte buffer        }
  327.       comport : integer;                      { Selected com address         }
  328.  
  329.     BEGIN
  330.       case com of
  331.         com1:comport:=com1base;               { Set the com port to talk to  }
  332.         com2:comport:=com2base;
  333.       end;
  334.       tbyte := port[ comport ];               { Read the ports to clear any  }
  335.       tbyte := port[ comport + linestat ];    { error conditions             }
  336.       port[ comport + modemctrl ] := dtrtrue + rtstrue + bit3true;
  337.       port[ comport + intenreg ] := 3;        { Enable com port interrupts   }
  338.       tbyte := port[$21];                     {                              }
  339.       with registers do
  340.         begin
  341.           ax:=$2500;                          { Load the function number for }
  342.                                               { redefining an interrupt      }
  343.           ds:=cseg;                           { Get and set the segment and  }
  344.           case com of
  345.             com1:dx:=ofs(IntCOM1_Handler);    { offset of the handler        }
  346.             com2:dx:=ofs(IntCOM2_Handler);    { COM1 or COM2                 }
  347.           end;
  348.         end;
  349.       case com of
  350.         com1: begin
  351.                 com1vecoff:=memw[0000:irq4];   { Save the segment and offset  }
  352.                 com1vecseg:=memw[0000:irq4+2]; { of the DOS interrupt handler }
  353.                 registers.ax:=registers.ax+$0c;{ Use the COM1: interrupt    }
  354.                 intr($21,registers);          { Call DOS to reset INT 0C     }
  355.                 port[$21]:=tbyte and $ef;     {                              }
  356.               end;
  357.         com2: begin
  358.                 com2vecoff:=memw[0000:irq3];   { Same as above                }
  359.                 com2vecseg:=memw[0000:irq3+2]; { Same as above                }
  360.                 registers.ax:=registers.ax+$0b;{ Use the COM2: interrupt      }
  361.                 intr($21,registers);          { Call DOS                     }
  362.                 port[$21]:=tbyte and $f7;     {                              }
  363.               end;
  364.       end;
  365.       ComBusy[com]:=false;                    { Com port not busy            }
  366.       inline($fb);                            { Enable interrupts            }
  367.     END;
  368.  
  369. {-----------------------------------------------------------------------------
  370.       This procedure restores the original system values to what they
  371.  were before the interrupt handler was set into action.
  372. -----------------------------------------------------------------------------}
  373.  
  374.   PROCEDURE IntOff(com:comtype);
  375.  
  376.     VAR
  377.       tbyte:byte;
  378.  
  379.     BEGIN
  380.       inline($FA);  { CLI }                   { Disable interrupts           }
  381.       tbyte:=port[$21];                       {                              }
  382.       case com of
  383.         com1:comport:=com1base;               { Set the com port to talk to  }
  384.         com2:comport:=com2base;
  385.       end;
  386.       port[comport+intenreg]:=0;              { Disable COM interrupts       }
  387.       If comport=com1base then                { If using COM1: then          }
  388.         begin
  389.           port[$21]:=tbyte or $10;            {                              }
  390.           memw[0000:irq4]:=com1vecoff;        { Restore the DOS interrupt    }
  391.           memw[0000:irq4+2]:=com1vecseg;      { handler                      }
  392.         end
  393.       else
  394.         begin
  395.           memw[0000:irq3]:=com2vecoff;        { Restore the DOS interrupt    }
  396.           memw[0000:irq3+2]:=com2vecseg;      { handler                      }
  397.           port[$21]:=tbyte or $08;            {                              }
  398.         end;
  399.       ComBusy[com]:=true;
  400.     END;
  401.  
  402. {----------------------------------------------------------------------------
  403.       This procedure outputs directly to the communications port the byte
  404.  equivilent of the character to be sent.
  405. ----------------------------------------------------------------------------}
  406.  
  407.   PROCEDURE WriteCom( com : comtype; ch : char );
  408.  
  409.     VAR
  410.       tbyte:byte;
  411.       comport:integer;
  412.  
  413.     BEGIN
  414.       case com of
  415.         com1:comport:=com1base;               { Set the com port to talk to  }
  416.         com2:comport:=com2base;
  417.       end;
  418.       while  ComBusy[com] do
  419.         begin
  420.         end;
  421.       inline($FA);                   { Disable interrupts                   }
  422.       tbyte:=ord(ch);                { Change to byte format                }
  423.       port[comport]:=tbyte;          { Output the character                 }
  424.       ComBusy[com]:=true;            { Signal comport busy, transmitting    }
  425.       inline($FB);                   { Enable interrupts                    }
  426.     END;
  427.  
  428. { ================================================================= }
  429. {   F u n c t i o n   /   P r o c e d u r e   S e c t i o n         }
  430. { ================================================================= }
  431.  
  432. function depth(var q:queue_type):integer;
  433. { this function returns the depth of the queue }
  434. begin
  435.    depth:=(q.r-q.f) mod queue_size
  436. end;
  437.  
  438. function full(var q:queue_type):boolean;
  439. { this fuction tests to see it the queue is full }
  440. begin
  441.    full:=q.r=(q.f-1) mod queue_size
  442. end;
  443.  
  444. function empty(var q:queue_type):boolean;
  445. { this function test to see if the queue is empty }
  446. begin
  447.    empty:=q.r=q.f
  448. end;
  449.  
  450. procedure enter(var q:queue_type;var v:char);
  451. { this procedure adds an entry to the queue at the rear }
  452. begin
  453.    if not full(q) then
  454.       begin
  455.          q.r:=(q.r+1) mod queue_size;
  456.          q.data[q.r].c:=v;
  457.          q.err:=false
  458.       end
  459.    else
  460.       q.err:=true
  461. end;
  462.  
  463. procedure clear(var q:queue_type);
  464. { this procedure clears a queue }
  465.  
  466. begin
  467.    q.r:=0;
  468.    q.f:=0;
  469.    q.err:=false;
  470.    q.DepthFlag:=false;
  471. end;
  472.  
  473. procedure SendFlow(com:comtype;C:Char);
  474. { this procedure will send an byte }
  475. var
  476.   WaitCount        :         integer;
  477. begin
  478.    WaitCount:=0;
  479.    while OutputXoffed[com] and (WaitCount < MaxWait) do
  480.      begin
  481.        WaitCount:=WaitCount+1;
  482.        Delay(100);
  483.      end;
  484.    If WaitCount >= MaxWait then
  485.      OutputXoffed[com]:=false;
  486.    WriteCom(com,C);
  487. end;
  488.  
  489. procedure SendStr(com:comtype;S:Str255);
  490. var
  491.   I  : integer;
  492. begin
  493.    for I:=1 to Length(S) do
  494.      SendFlow(com,S[I]);
  495.    SendFlow(com,#10);
  496. end;
  497.  
  498. procedure leave(var q:queue_type;var v:char;com:comtype);
  499. { this procedure removes an entry from the queue at the front }
  500. begin
  501.    if not empty(q) then
  502.       begin
  503.          If q.DepthFlag then
  504.            If depth(q)<=max_queue_depth then
  505.              WriteCom(com,CXon);
  506.          q.f:=(q.f+1) mod queue_size;
  507.          v:=q.data[q.f].c;
  508.          q.err:=false
  509.       end
  510.    else
  511.       q.err:=true
  512. end;
  513.  
  514. {-----------------------------------------------------------------------------
  515.       If the queue indexes are not equal then Receive returns the
  516.  char from the COM1: port.  The character is read from the queue and
  517.  is stored in queue_value.  If there is nothing in the queue after
  518.  WaitTime loops then NoResponce is set to true and a null is returned.
  519. -----------------------------------------------------------------------------}
  520.  
  521. procedure Receive( var C          :  char;
  522.                    var NoResponce :  boolean;
  523.                    WaitTime       :  integer;
  524.                    var queue      :  queue_type;
  525.                    com            :  comtype );
  526. var
  527.   CheckCount : integer;
  528.  
  529. begin
  530.    NoResponce:=false;
  531.    If not empty(queue) then
  532.      leave(queue,C,com)
  533.    else
  534.      begin { queue initially empty }
  535.         CheckCount:=0;
  536.         repeat { wait and see if anything comes in }
  537.          Delay(100);
  538.          CheckCount:=CheckCount+1;
  539.         Until not empty(queue) or (CheckCount>WaitTime);   { anything there }
  540.         If not empty(queue) then
  541.           leave(queue,C,com)
  542.         else
  543.           begin { Nothing came in }
  544.              C:=#0;
  545.              NoResponce:=true;
  546.           end;  { Nothing came in }
  547.      end; { queue initially empty }
  548. end;
  549.