home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tricks / pascal / stacks / stack.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-10-01  |  4.2 KB  |  145 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      STACK.PAS                         *)
  3. (*           (c) 1991 Gerd Cebulla & DMV-Verlag           *)
  4. (* ------------------------------------------------------ *)
  5. UNIT Stack;
  6.  
  7. INTERFACE
  8.  
  9. TYPE
  10.   HexString      = STRING[4];
  11.   StackProc      = PROCEDURE;
  12.  
  13. CONST
  14.   Display        : BOOLEAN = TRUE;
  15.   WaitKey        : BOOLEAN = TRUE;
  16.   MinStack       : WORD    = $FFFF;
  17.   OutX           : BYTE    = 1;
  18.   OutY           : BYTE    = 1;
  19.  
  20. VAR
  21.   SystemStackProc : StackProc;
  22.   StackSize,
  23.   StackPtr,
  24.   LocalSize       : WORD;
  25.   CallAddr        : POINTER;
  26.  
  27.  
  28.   PROCEDURE SetStackProc(NewStackProc : StackProc);
  29.   PROCEDURE ResetStackProc;
  30.   PROCEDURE MakeHexStr(    Wert       : WORD;
  31.                        VAR HexStr     : HexString);
  32.   PROCEDURE StackTracer;
  33.   PROCEDURE Analyze;
  34.   INLINE(
  35.     $A3 / LocalSize /                  { mov LocalSize,ax  }
  36.     $89 / $E0 /                        { mov ax,sp         }
  37.     $05 / $06 / $00 /                  { add ax,6          }
  38.     $A3 / StackPtr /                   { mov StackPtr,ax   }
  39.     $8B / $46 / $02 /                  { mov ax,[bp+2]     }
  40.     $A3 / CallAddr /                   { mov CallAddr,ax   }
  41.     $8B / $46 / $04 /                  { mov ax,[bp+4]     }
  42.     $2B / $06 / PREFIXSEG /            { sub ax,PrefixSeg  }
  43.     $2D / $10 / $00 /                  { sub ax,10h        }
  44.     $A3 / CallAddr + 2                 { mov CallAddr+2,ax }
  45.     );
  46.  
  47. IMPLEMENTATION
  48.  
  49. USES
  50.   Crt;
  51.  
  52. TYPE
  53.   CallCodePtr    = ^CallCode;
  54.   CallCode       = RECORD
  55.                      Opcode : BYTE;
  56.                      ADDR   : StackProc;
  57.                    END;
  58.  
  59. VAR
  60.   SaveSystemCode : CallCode;
  61.  
  62.  
  63.   PROCEDURE SetStackProc(NewStackProc : StackProc);
  64.   BEGIN
  65.     WITH CallCodePtr(@SystemStackProc)^ DO BEGIN
  66.       Opcode := $EA;                        { "jmp far"    }
  67.       ADDR   := NewStackProc;
  68.     END;                                    { with         }
  69.   END;
  70.  
  71.   PROCEDURE ResetStackProc;
  72.   BEGIN
  73.     CallCodePtr(@SystemStackProc)^ := SaveSystemCode;
  74.   END;                                    { ResetStackproc }
  75.  
  76.   {$S-}                         { <-- unbedingt notwendig! }
  77.   PROCEDURE MakeHexStr(    Wert   : WORD;
  78.                        VAR HexStr : HexString);
  79.   VAR
  80.     i,
  81.     Nibble : BYTE;
  82.   BEGIN
  83.     HexStr[0] := #4;
  84.     FOR i := 4 DOWNTO 1 DO BEGIN
  85.       Nibble := Wert AND $000F;
  86.       IF Nibble < 10 THEN
  87.         HexStr[i] := CHR(Nibble + ORD('0'))
  88.       ELSE
  89.         HexStr[i] := CHR(Nibble - 10 + ORD('A'));
  90.       Wert := Wert SHR 4;
  91.     END;                          { for }
  92.   END;                            { MakeHexStr }
  93.  
  94. VAR
  95.   Hex    : HexString;
  96.   SaveX,
  97.   SaveY  : BYTE;
  98.  
  99.   PROCEDURE StackTracer;
  100.   BEGIN
  101.     Analyze;
  102.     IF StackPtr - LocalSize < MinStack THEN
  103.       MinStack := StackPtr - LocalSize;
  104.     IF Display THEN BEGIN
  105.       SaveX := WhereX;
  106.       SaveY := WhereY;
  107.       GotoXY(OutX, OutY);
  108.       MakeHexStr(SEG(CallAddr^), Hex);
  109.       Write('Adr.=', Hex);
  110.       MakeHexStr(OFS(CallAddr^), Hex);
  111.       Write(':', Hex);
  112.       MakeHexStr(StackPtr, Hex);
  113.       Write(' SP=', Hex);
  114.       MakeHexStr(LocalSize, Hex);
  115.       Write(' Lok.Var.=', Hex);
  116.       IF WaitKey THEN
  117.         REPEAT UNTIL ReadKey <> #0;
  118.       GotoXY(SaveX, SaveY);
  119.     END;
  120.   END;
  121.  
  122.   {$S+}                         { <-- unbedingt notwendig! }
  123.   PROCEDURE InitStack;
  124.   BEGIN
  125.     INLINE(
  126.       $E8 / $00 / $00 /         { call $+3 ("push ip")     }
  127.       $5B /                     { pop bx                   }
  128.       $2E / $8B / $47 / $F9 /   { mov ax,cs:[bx-7]         }
  129.       $A3 / SystemStackProc /   { mov SystemStackProc,ax   }
  130.       $2E / $8B / $47 / $FB /   { mov ax,cs:[bx-5]         }
  131.       $A3 / SystemStackProc + 2 /
  132.                                 { mov SystemStackProc+2,ax }
  133.       $89 / $E0 /               { mov ax,sp                }
  134.       $05 / $0C / $00 /         { add ax,12                }
  135.       $A3 / StackSize           { mov StackSize,ax         }
  136.       );
  137.     SaveSystemCode := CallCodePtr(@SystemStackProc)^;
  138.   END;
  139.  
  140. BEGIN
  141.   InitStack;
  142. END.
  143. (* ------------------------------------------------------ *)
  144. (*                Ende von STACK.PAS                      *)
  145.