home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BP7BUGS2.ZIP / TRASHSRC.ZIP / MESS386.PAS next >
Encoding:
Pascal/Delphi Source File  |  1993-01-03  |  3.0 KB  |  142 lines
  1. {$M 8192,0,0}
  2.  
  3. program Mess386;
  4.  
  5. { This program installs an ISR on the timer tick that messes up EAX, EBX, ECX
  6.   and EDX, then runs a DOS shell. Run TEST in the shell in order to see the
  7.   effects on the calculations. }
  8.  
  9. uses
  10.   Dos;
  11.  
  12. const
  13.   Op32 = $66;
  14.  
  15. type
  16.   regs = (reax,rebx,recx,redx);
  17.   TIntRec = record   { This record must be exactly 16 bytes long!!! }
  18.     oldisr : pointer;
  19.     junk : array[1..12] of byte;
  20.   end;
  21.  
  22.   TIntRecArray = array[0..15] of TIntRec;
  23.   PIntRecArray = ^TIntRecArray;
  24.  
  25. { Put the oldisr pointers in the code segment to make the ISR simple. }
  26.  
  27. procedure InterruptRecs; assembler;
  28. { We need 256 bytes here.  Most of it is unused, but it'd make the ISR
  29.   too complicated if I got rid of the Junk field.}
  30. asm
  31.   dd 1,2,3,4,5,6,7,8
  32.   dd 1,2,3,4,5,6,7,8
  33.   dd 1,2,3,4,5,6,7,8
  34.   dd 1,2,3,4,5,6,7,8
  35.   dd 1,2,3,4,5,6,7,8
  36.   dd 1,2,3,4,5,6,7,8
  37.   dd 1,2,3,4,5,6,7,8
  38.   dd 1,2,3,4,5,6,7
  39.   db 1,2,3
  40. end;  { RET is the last byte }
  41.  
  42. const
  43.   PtrOfs = 15*sizeof(TIntRec);
  44.  
  45. procedure FixupISR; assembler;
  46. { This ISR saves and restores the high word of EAX,EBX,ECX,EDX.
  47.   Use it to fix up a bad handler.  Uses 14 bytes of stack space. }
  48. asm
  49.   push bp
  50.   mov bp,sp
  51.   push ds
  52.   push ds    { This will reload DS into the high part of EAX - EDX }
  53.   push ds
  54.   push ds
  55.   push word ptr [bp+6]      { This pushes the old flags again }
  56.   mov bp,[bp]                { Restore BP for the old interrupt }
  57.   call dword ptr cs:InterruptRecs[PtrOfs]
  58.   push ax
  59.   pushf
  60.   pop ax                     { Now flags are in AX }
  61.  
  62.   push bp                    { Save the ISR's BP }
  63.   mov bp,sp                  { Set up our frame again }
  64.   add bp,12
  65.   mov word ptr [bp+6],ax      { This way flags on our return will be
  66.                                    as the old ISR returned them. }
  67.   pop ax
  68.   mov word ptr [bp],ax        { as will BP }
  69.   pop ax
  70.  
  71.   push dx
  72.   db Op32; pop dx
  73.   push cx
  74.   db Op32; pop cx
  75.   push bx
  76.   db Op32; pop bx
  77.   push ax
  78.   db Op32; pop ax
  79.   pop bp
  80.   iret
  81. end;
  82.  
  83. procedure Install;
  84. var
  85.   int,irq : byte;
  86.   IntRecs : PIntRecArray;
  87.  
  88.   procedure InstallHandler;
  89.   var
  90.     addr : pointer;
  91.     segmod : byte;
  92.   begin
  93.     GetIntVec(int,IntRecs^[irq].OldIsr);
  94.     segmod := 15-irq;
  95.     Addr := Ptr(Seg(FixupISR)-segmod, Ofs(FixupISR)+16*segmod);
  96.     SetIntVec(int,Addr);
  97.   end;
  98.  
  99. begin
  100.   IntRecs := @InterruptRecs;
  101.   int := 8;
  102.   irq := 0;
  103.   installhandler;
  104. end;
  105.  
  106. procedure UnInstall;
  107. var
  108.   int,irq : byte;
  109.   IntRecs : PIntRecArray;
  110.  
  111.   procedure UnInstallHandler;
  112.   begin
  113.     SetIntVec(int,IntRecs^[irq].OldIsr);
  114.   end;
  115.  
  116. begin
  117.   IntRecs := @InterruptRecs;
  118.   int := 8;
  119.   irq := 0;
  120.   uninstallhandler;
  121. end;
  122.  
  123. var
  124.   OldExitProc : pointer;
  125.  
  126. procedure MyExitProc; far;
  127. begin
  128.   ExitProc := OldExitProc;
  129.   Uninstall;
  130. end;
  131.  
  132. begin
  133.   if test8086 >= 2 then
  134.   begin
  135.     swapvectors;
  136.     Install;
  137.     OldExitProc := ExitProc;
  138.     ExitProc := @MyExitProc;
  139.     Exec(getenv('comspec'),'');
  140.   end;
  141. end.
  142.