home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0000 - 0009 / ibm0000-0009 / ibm0003.tar / ibm0003 / TPOWER52.ZIP / TPSRC1.ARC / TPINT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-10  |  12.4 KB  |  339 lines
  1. {$S-,R-,V-,I-,B-,F-}
  2.  
  3. {$IFNDEF Ver40}
  4.   {$I OMINUS.INC}
  5. {$ENDIF}
  6.  
  7. {*********************************************************}
  8. {*                    TPINT.PAS 5.07                     *}
  9. {*        Copyright (c) TurboPower Software 1987.        *}
  10. {* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
  11. {*     and used under license to TurboPower Software     *}
  12. {*                 All rights reserved.                  *}
  13. {*********************************************************}
  14.  
  15. unit TpInt;
  16.   {-ISR management routines}
  17.  
  18. interface
  19.  
  20. uses
  21.   Dos;
  22.  
  23. const
  24.   MaxISRs = 20;
  25. type
  26.   Dummy5 = array[1..5] of Word;
  27.   IntRegisters =
  28.     record
  29.       case Byte of
  30.         1 : (BP, ES, DS, DI, SI, DX, CX, BX, AX, IP, CS, Flags : Word);
  31.         2 : (Dummy : Dummy5; DL, DH, CL, CH, BL, BH, AL, AH : Byte);
  32.     end;
  33.   ISR_Record =
  34.     record
  35.       IntNum : Byte;         {Interrupt vector number}
  36.       OrigAddr : Pointer;    {Original vector}
  37.       NewAddr : Pointer;     {New vector}
  38.       Captured : Boolean;    {Used for error checking}
  39.     end;
  40. var
  41.   {global array of ISR records}
  42.   ISR_Array : array[1..MaxISRs] of ISR_Record;
  43.  
  44. procedure InterruptsOn;
  45.   {-Turn interrupts on}
  46.   inline($FB);               {sti}
  47.  
  48. procedure InterruptsOff;
  49.   {-Turn interrupts off}
  50.   inline($FA);               {cli}
  51.  
  52. procedure SendEOI;
  53.   {-Send an End Of Interrupt command to the Programmable Interrupt Controller}
  54.   inline(
  55.     $B0/$20/                 {mov al,$20}
  56.     $E6/$20);                {out $20,al}
  57.  
  58. procedure IntReturn(var IntRegs : IntRegisters);
  59.   {-Return from interrupt. Needed only if stack has been changed.}
  60.   inline(
  61.     $58/                     {pop ax      ;old SP into AX}
  62.     $5A/                     {pop dx      ;old SS into DX}
  63.     $FA/                     {cli         ;Interrupts off while changing SS:SP}
  64.     $8E/$D2/                 {mov ss,dx   ;Address of IntRegs.BP is old SS:SP}
  65.     $89/$C4/                 {mov sp,ax}
  66.     $FB/                     {sti         ;Interrupts on}
  67.     $5D/                     {pop bp      ;Restore registers}
  68.     $07/                     {pop es}
  69.     $1F/                     {pop ds}
  70.     $5F/                     {pop di}
  71.     $5E/                     {pop si}
  72.     $5A/                     {pop dx}
  73.     $59/                     {pop cx}
  74.     $5B/                     {pop bx}
  75.     $58/                     {pop ax}
  76.     $CF);                    {iret        ;Return from interrupt}
  77.  
  78. procedure ChainInt(var Regs : IntRegisters; JumpAddr : Pointer);
  79.   {-Restores stack, registers from Regs and 'jumps' to JumpAddr}
  80.   inline(
  81.     $5B/                     {pop bx          ;BX = Ofs(JumpAddr^)}
  82.     $58/                     {pop ax          ;AX = Seg(JumpAddr^)}
  83.     $5E/                     {pop si          ;SI = Ofs(Regs)}
  84.     $1F/                     {pop ds          ;DS:SI => Regs}
  85.                              {;Change stack so RETF passes control to JumpAddr;
  86.                               restore Flags}
  87.     $87/$5C/$0E/             {xchg bx,[si+14] ;Switch old BX and Ofs(JumpAddr^)}
  88.     $87/$44/$10/             {xchg ax,[si+16] ;Switch old AX and Seg(JumpAddr^)}
  89.     $8B/$54/$16/             {mov  dx,[si+22] ;Old Flags into DX}
  90.     $52/                     {push dx         ;Push altered flags}
  91.     $9D/                     {popf            ;Pop them into place}
  92.                              {;Switch stacks -- make SS:SP point to Regs.BP}
  93.     $8C/$DA/                 {mov dx,ds       ;DX = Seg(Regs)}
  94.     $FA/                     {cli             ;Interrupts off}
  95.     $8E/$D2/                 {mov ss,dx       ;Restore SS from DX}
  96.     $89/$F4/                 {mov sp,si       ;Restore SP from SI}
  97.     $FB/                     {sti             ;Interrupts on}
  98.     $5D/                     {pop bp          ;Restore BP}
  99.     $07/                     {pop es          ;Restore ES}
  100.     $1F/                     {pop ds          ;Restore DS}
  101.     $5F/                     {pop di          ;Restore DI}
  102.     $5E/                     {pop si          ;Restore SI}
  103.     $5A/                     {pop dx          ;Restore DX}
  104.     $59/                     {pop cx          ;Restore CX}
  105.                              {;BX and AX restored earlier; their places on stack}
  106.                              {;now have JumpAddr, which is where return will go}
  107.     $CB);                    {retf            ;Chain to JumpAddr}
  108.  
  109. procedure SwapStackAndCallNear(Routine : Word; SP : Pointer;
  110.   var Regs : IntRegisters);
  111.   {-Switches to stack designated by SP and calls Routine with Regs as a
  112.     parameter. The Routine must be a NEAR call from the current ISR.}
  113.   inline(
  114.     $9C/                     {pushf        ;Load flags into AX}
  115.     $58/                     {pop ax}
  116.     $5A/                     {pop dx       ;AX = Ofs(Regs)}
  117.     $07/                     {pop es       ;ES = Seg(Regs)}
  118.     $59/                     {pop cx       ;CX = new SP}
  119.     $5F/                     {pop di       ;DI = new SS}
  120.     $5B/                     {pop bx       ;BX = offset of Routine to call}
  121.     $8C/$D6/                 {mov si,ss    ;Save SS in SI}
  122.     $FA/                     {cli          ;Force interrupts off}
  123.     $8E/$D7/                 {mov ss,di    ;Switch stack segments}
  124.     $87/$E1/                 {xchg cx,sp   ;Get new SP and save old in CX}
  125.     $50/                     {push ax      ;Restore flags}
  126.     $9D/                     {popf}
  127.     $9C/                     {pushf        ;Save flags again}
  128.     $56/                     {push si      ;Save old SS on stack}
  129.     $51/                     {push cx      ;Save old SP}
  130.     $06/                     {push es      ;Push Seg(Regs)}
  131.     $52/                     {push dx      ;Push Ofs(Regs)}
  132.     $FF/$D3/                 {call near bx ;Call Routine}
  133.     $FA/                     {cli          ;Interrupts off}
  134.     $58/                     {pop ax       ;Get back old SP}
  135.     $5A/                     {pop dx       ;Get back old SS}
  136.     $59/                     {pop cx       ;Get back old flags}
  137.     $8E/$D2/                 {mov ss,dx    ;Restore SS}
  138.     $89/$C4/                 {mov sp,ax    ;Restore SP}
  139.     $51/                     {push cx      ;Restore flags}
  140.     $9D);                    {popf}
  141.  
  142. procedure SwapStackAndCall(Routine, SP : Pointer; var Regs : IntRegisters);
  143.   {-Switches to stack designated by SP and calls Routine with Regs as a
  144.     parameter. The Routine must be a FAR call from the current ISR.}
  145.   inline(
  146.     $9C/                     {pushf         ;Save flags}
  147.     $59/                     {pop cx}
  148.     $8C/$D0/                 {mov ax,ss     ;AX = SS}
  149.     $8E/$C0/                 {mov es,ax     ;ES = SS}
  150.     $58/                     {pop ax        ;AX = Ofs(Regs)}
  151.     $5A/                     {pop dx        ;DX = Seg(Regs)}
  152.     $5B/                     {pop bx        ;BX = new SP}
  153.     $5F/                     {pop di        ;DI = new SS}
  154.                              {              ;address of Routine now at SS:SP}
  155.     $FA/                     {cli           ;Force interrupts off}
  156.     $8E/$D7/                 {mov ss,di     ;Switch stack segments}
  157.     $87/$E3/                 {xchg bx,sp    ;Get new SP and save old in BX}
  158.                              {              ;ES:BX now points to Routine}
  159.     $51/                     {push cx       ;Restore flags}
  160.     $9D/                     {popf}
  161.     $9C/                     {pushf         ;Save flags again}
  162.     $06/                     {push es       ;Save old SS on stack}
  163.     $53/                     {push bx       ;Save old SP}
  164.     $52/                     {push dx       ;Push Seg(Regs)}
  165.     $50/                     {push ax       ;Push Ofs(Regs)}
  166.     $26/                     {es:}
  167.     $FF/$1F/                 {call far [bx] ;Call Routine}
  168.     $FA/                     {cli           ;Force interrupts off}
  169.     $58/                     {pop ax        ;Get back old SP}
  170.     $5A/                     {pop dx        ;Get back old SS}
  171.     $59/                     {pop cx        ;Get back old flags}
  172.     $8E/$D2/                 {mov ss,dx     ;Restore SS}
  173.     $89/$C4/                 {mov sp,ax     ;Restore SP}
  174.     $51/                     {push cx       ;Restore flags}
  175.     $9D/                     {popf}
  176.     $83/$C4/$04);            {add sp,4      ;Get Routine off the stack}
  177.  
  178. procedure EmulateInt(var Regs : IntRegisters; IntAddr : Pointer);
  179.   {-Emulates an interrupt by filling the CPU registers with the values in Regs,
  180.     clearing interrupts, pushing the flags, and calling far to IntAddr.}
  181.  
  182. function InitVector(IntNumber, Handle : Byte; UserRoutine : Pointer) : Boolean;
  183.   {-Sets up an interrupt service routine}
  184.  
  185. procedure RestoreVector(Handle : Byte);
  186.   {-Restores an interrupt vector to its original value}
  187.  
  188. procedure RestoreAllVectors;
  189.   {-Restores all captured interrupt vectors.}
  190.  
  191. function AllocateStack(var P : Pointer; SizeInBytes : Word) : Boolean;
  192.   {-Allocates a stack of size SizeInBytes}
  193.  
  194. procedure DeallocateStack(P : Pointer);
  195.   {-Frees an allocated stack}
  196.  
  197.   {==========================================================================}
  198.  
  199. implementation
  200.  
  201. type
  202.   StackRecord =
  203.     record
  204.       Size : Word;
  205.       Address : Pointer;
  206.     end;
  207. var
  208.   SaveExitProc : Pointer;
  209.  
  210.   {$L TPINT.OBJ}
  211.  
  212.   procedure EmulateInt(var Regs : IntRegisters; IntAddr : Pointer);
  213.     {-Emulates an interrupt by filling the CPU registers with the values in Regs,
  214.       clearing interrupts, pushing the flags, and calling far to IntAddr.}
  215.   external {TPINT} ;
  216.  
  217.   function InitVector(IntNumber, Handle : Byte; UserRoutine : Pointer) : Boolean;
  218.     {-Sets up an interrupt service routine}
  219.   begin
  220.     {assume failure}
  221.     InitVector := False;
  222.  
  223.     case Handle of
  224.       1..MaxISRs :
  225.         with ISR_Array[Handle] do
  226.           if not Captured then begin
  227.             {Setup variables}
  228.             IntNum := IntNumber;
  229.             GetIntVec(IntNumber, OrigAddr);
  230.  
  231.             {Set the vector}
  232.             SetIntVec(IntNumber, UserRoutine);
  233.             NewAddr := UserRoutine;
  234.             Captured := True;
  235.             InitVector := True;
  236.           end;
  237.     end;
  238.   end;
  239.  
  240.   procedure RestoreVector(Handle : Byte);
  241.     {-Restores an interrupt vector to its original value}
  242.   begin
  243.     case Handle of
  244.       1..MaxISRs :
  245.         with ISR_Array[Handle] do
  246.           if Captured then begin
  247.             SetIntVec(IntNum, OrigAddr);
  248.             Captured := False;
  249.             OrigAddr := nil;
  250.           end;
  251.     end;
  252.   end;
  253.  
  254.   procedure RestoreAllVectors;
  255.     {-Restores all captured interrupt vectors}
  256.   var
  257.     I : Word;
  258.   begin
  259.     {restore in reverse order}
  260.     for I := MaxISRs downto 1 do
  261.       RestoreVector(I);
  262.   end;
  263.  
  264.   function AllocateStack(var P : Pointer; SizeInBytes : Word) : Boolean;
  265.     {-This routine allocates a stack of size SizeInBytes}
  266.   var
  267.     StackRecPtr : ^StackRecord absolute P;
  268.     POfs : Word absolute P;
  269.     PTemp : Pointer;
  270.     ActualSize : LongInt;
  271.   begin
  272.     {allocate space for the stack record as well}
  273.     ActualSize := LongInt(SizeInBytes)+6;
  274.  
  275.     {see if sufficient memory remains}
  276.     if (MaxAvail >= ActualSize) and (ActualSize <= 65521) then begin
  277.       {allocate the memory}
  278.       GetMem(P, Word(ActualSize));
  279.  
  280.       {save the address}
  281.       PTemp := P;
  282.  
  283.       {point P (hence StackRecPtr) to where the stack record goes}
  284.       Inc(POfs, SizeInBytes);
  285.  
  286.       {save the address returned by GetMem and the # of bytes allocated}
  287.       with StackRecPtr^ do begin
  288.         Address := PTemp;
  289.         Size := Word(ActualSize);
  290.       end;
  291.  
  292.       AllocateStack := True;
  293.     end
  294.     else
  295.       AllocateStack := False;
  296.   end;
  297.  
  298.   procedure DeallocateStack(P : Pointer);
  299.     {-Frees an allocated stack}
  300.   var
  301.     StackRecPtr : ^StackRecord absolute P;
  302.   begin
  303.     with StackRecPtr^ do
  304.       FreeMem(Address, Size);
  305.   end;
  306.  
  307.   {$F+}
  308.   procedure TpIntExit;
  309.     {-Exit/error handler for the unit. Restores all captured interrupt vectors}
  310.   begin
  311.     ExitProc := SaveExitProc;
  312.     RestoreAllVectors;
  313.   end;
  314.   {$F-}
  315.  
  316.   procedure TpIntInit;
  317.     {-This sets up an array of unused ISR records}
  318.   var
  319.     I : Word;
  320.   begin
  321.     {initialize the array of ISR records}
  322.     for I := 1 to MaxISRs do
  323.       with ISR_Array[I] do begin
  324.         IntNum := 0;
  325.         OrigAddr := nil;
  326.         NewAddr := nil;
  327.         Captured := False;
  328.       end;
  329.   end;
  330.  
  331. begin
  332.   {initialize array of ISR records}
  333.   TpIntInit;
  334.  
  335.   {set up exit handler}
  336.   SaveExitProc := ExitProc;
  337.   ExitProc := @TpIntExit;
  338. end.
  339.