home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / DebuggerTest ƒ / DebuggerTest.p < prev    next >
Encoding:
Text File  |  1993-12-17  |  7.7 KB  |  222 lines  |  [TEXT/PJMM]
  1. unit DebuggerTest;
  2.  
  3. interface
  4.  
  5.     type
  6.         DebuggerKind = ( {}
  7.             debuggerKindNone, {}
  8.             debuggerKindMacsBug, {}
  9.             debuggerKindTMON, {}
  10.             debuggerKindJasik, {}
  11.             debuggerKindABZmon, {}
  12.             debuggerKindOther {}
  13.             );
  14.         DebuggerSignature = packed array[1..2] of Char;
  15.  
  16. {$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
  17.     procedure GetDebuggerInfo (var present, active: Boolean; var kind: DebuggerKind; var signature: DebuggerSignature);
  18. {$ENDC}
  19.  
  20. {ABZmon can load “on top of” another debugger. In this case, the underlying debugger}
  21. {becomes the secondary debugger, but is the only one reported by GetDebuggerInfo, which}
  22. {looks in the “normal” places before trying to find ABZmon. The ABZMonIsLoaded function}
  23. {can be used to detect ABZmon’s presence when not the only debugger.}
  24.     function ABZMonIsLoaded: Boolean;
  25.  
  26.     function DebuggerPresent: Boolean;
  27.  
  28. implementation
  29.  
  30.     function ValidDebuggerWorldAddress (p: univ Ptr): Boolean;
  31.     begin
  32.     {Address must be even and somewhere within addressable RAM or ROM.}
  33.         ValidDebuggerWorldAddress := not ODD(ORD(p)) and (ORD(p) >= 0) and (ORD(p) < ORD(MFTopMem));
  34.     end;
  35.  
  36.     type
  37.         LongPtr = ^Longint;
  38.         IntPtr = ^Integer;
  39.         PtrPtr = ^Ptr;
  40.  
  41.     function GetVBR: Ptr;
  42.     inline
  43.         $7008,             {MOVEQ #$EnterSupervisorMode,D0}
  44.         $A08D,            {_DebugUtil}
  45.         $4E7A, $8801,    {MOVEC VBR,A0}
  46.         $46C0,            {MOVE D0,SR    ;restore user mode}
  47.         $2E88;            {MOVE.L A0,(A7)}
  48.  
  49.     function ABZMonIsLoaded: Boolean;
  50.         const
  51.             _DebugUtil = $A08D;
  52.             _Unimplemented = $A89F;
  53.         var
  54.             VBR: Ptr;
  55.             vectorPtr: PtrPtr;
  56.             codePtr: LongPtr;
  57.             err: OSErr;
  58.     begin
  59.     {Alain Birtz’s ABZmon doesn’t use MacJmp at all. In fact, it doesn’t even use}
  60.     {the trap dispatcher table. Instead, it patches the trap dispatcher! The hint for}
  61.     {finding this, aside from not finding it anywhere else, is that ABZmon defines}
  62.     {a private trap _DebugNum $AAFF - this has reserved bit 9 set. ABZmon’s trap}
  63.     {dispatcher can be identified by its first instruction, ORI #$700,SR. In hex, this}
  64.     {is $007C0700.}
  65.         if GetOSTrapAddress(_DebugUtil) = GetToolTrapAddress(_Unimplemented) then
  66.             VBR := Ptr(0)
  67.         else
  68.             begin
  69.                 if DebuggerGetMax >= 8 then
  70.                     VBR := GetVBR
  71.                 else
  72.                     VBR := Ptr(0);
  73.             end;
  74.         if ValidDebuggerWorldAddress(VBR) then
  75.             begin
  76.                 vectorPtr := PtrPtr(ORD(VBR) + $28);
  77.                 codePtr := LongPtr(vectorPtr^);
  78.                 ABZMonIsLoaded := ValidDebuggerWorldAddress(codePtr) & (codePtr^ = $007C0700);
  79.             end
  80.         else
  81.             ABZMonIsLoaded := False;
  82.     end;
  83.  
  84. {$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
  85.     function NonStandardDebuggerKind (entry: univ Ptr): DebuggerKind;
  86.     begin
  87.         NonStandardDebuggerKind := debuggerKindOther;    {If we can’t decide…}
  88.  
  89.     {Jasik’s “The Debugger” doesn’t have a world pointer. Its distinguishing}
  90.     {feature is a test for whether it was entered via an F-line trap, by executing}
  91.     {the instruction CMPI #10,DSErrCode. In hex this is $0C7800100AF0.}
  92.         if (LongPtr(entry)^ = $0C780010) and (IntPtr(ORD(entry) + SIZEOF(Longint))^ = $0AF0) then
  93.             NonStandardDebuggerKind := debuggerKindJasik
  94.         else
  95.  
  96.     {Add other tests as needed.}
  97.             ;
  98.     end;
  99. {$ENDC}
  100.  
  101. {This is based on info from “MacsBug Reference and Debugging Guide for MacsBug version 6.2”}
  102. {The MacsBug reference doesn’t mention that the ROM debugger masquerades as a real debugger.}
  103. {Because the ROM debugger doesn’t have a “world” pointer, we have to do some extra checks.}
  104.     procedure GetDebuggerInfo (var present, active: Boolean; var kind: DebuggerKind; var signature: DebuggerSignature);
  105.         const
  106.     {The first and current universal ROM is rev 1660. Assume}
  107.     {that future universal ROMs will have higher rev numbers.}
  108.             UnivROMVersion = 1660;
  109.             MacJmp = $120;
  110.             Debug32Flags = $BFF;
  111.             ROMBase = $2AE;
  112.             DebugInstalledFlagBit = 5;
  113.             DebugActiveFlagBit = 7;
  114.             Megabyte = $100000;
  115.     {The following gestalt selectors are from Rene G.A. Ros’ SGSL.}
  116.             gestaltEnablerAttr = 'bugy'; {32-bit System Enabler [1.0]}
  117.             gestaltEnabler32bit = 7; {32-bit enabler present}
  118.         type
  119.             PtrPtr = ^Ptr;
  120.             IntPtr = ^Integer;
  121.             SigPtr = ^DebuggerSignature;
  122.         var
  123.             err: OSErr;
  124.             gestaltResult: Longint;
  125.             MM32Bit, univROM, apple32BitEnabler, broken: Boolean;
  126.             debugFlagsAddr: Ptr;
  127.             debugEntryAddr, debugWorldAddr, ROMBaseAddr: Ptr;
  128.     begin
  129.         err := Gestalt(gestaltAddressingModeAttr, gestaltResult);
  130.         MM32Bit := (err = noErr) & BTST(gestaltResult, gestalt32BitAddressing);
  131.         err := Gestalt(gestaltROMVersion, gestaltResult);
  132.         UnivROM := (err = noErr) & (gestaltResult >= UnivROMVersion);
  133.         err := Gestalt(gestaltEnablerAttr, gestaltResult);
  134.         apple32BitEnabler := (err = noErr) & BTST(gestaltResult, gestaltEnabler32bit);
  135.     {According to the reference, debugger flags are located in the high byte of}
  136.     {MacJmp unless the machine is 32-bit capable, in which case they move to}
  137.     {$BFF. I’m not sure I believe that the 32-bit enablers (Connectix’s MODE32}
  138.     {and Apple’s 32-bit System Enabler) report the right thing w.r.t. 32-bit capability.}
  139.     {Clearly, if the machine is running in 32-bit mode, it’s 32-bit capable even under}
  140.     {the enablers. But when running under a 32-bit enabler in 24-bit mode, the enabler}
  141.     {would seem to be obliged to report 32-bit capability. In this state, I wouldn’t expect}
  142.     {the enabler to put up enough of a charade to move the debugger flags — they’d almost}
  143.     {certainly end up in the high byte of MacJmp. Also, Apple’s enabler is damaged in}
  144.     {the opposite case — the debugger traps still look at the high byte of MacJmp even in}
  145.     {32-bit mode. This requires a special test to pretend there’s no debugger present under}
  146.     {Apple’s 32-bit System Enabler in 32-bit addressing mode; 24-bit mode is OK.}
  147.         broken := apple32BitEnabler and MM32Bit;
  148.         if not broken then
  149.             begin
  150.                 if MM32Bit or UnivROM then
  151.                     debugFlagsAddr := Ptr(Debug32Flags)
  152.                 else
  153.                     debugFlagsAddr := Ptr(MacJmp);
  154.                 present := BTST(debugFlagsAddr^, DebugInstalledFlagBit);
  155.                 active := BTST(debugFlagsAddr^, DebugActiveFlagBit);
  156.             end
  157.         else
  158.             begin
  159.                 present := False;
  160.                 active := False;
  161.             end;
  162.         if present then
  163.             begin
  164.                 debugEntryAddr := StripAddress(PtrPtr(MacJmp)^);
  165.                 ROMBaseAddr := StripAddress(PtrPtr(ROMBase)^);
  166.                 if ORD(debugEntryAddr) > ORD(ROMBaseAddr) then    {Could be the ROM debugger…}
  167.                     if MM32Bit then
  168.                         begin    {In 32-bit mode, any address in or beyond ROM is not in RAM.}
  169.                             present := False;
  170.                             Exit(GetDebuggerInfo);
  171.                         end
  172.                     else if ORD(debugEntryAddr) <= ORD(ROMBaseAddr) + Megabyte then
  173.                         begin    {In 24-bit mode, the ROM gets 1MB and can be followed by RAM.}
  174.                             present := False;
  175.                             Exit(GetDebuggerInfo);
  176.                         end;
  177. {$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
  178.                 debugWorldAddr := PtrPtr(ORD(debugEntryAddr) - SIZEOF(Ptr))^;
  179.                 if ValidDebuggerWorldAddress(debugWorldAddr) then
  180.                     signature := SigPtr(debugWorldAddr)^
  181.                 else
  182.                     signature := '??';
  183.                 case Integer(signature) of
  184.                     $4D54:     {MT}
  185.                         kind := debuggerKindMacsBug;
  186.         {• This is from memory; I _think_ TMON registers itself this way…}
  187.                     $5748:     {WH}
  188.                         kind := debuggerKindTMON;
  189.                     otherwise
  190.                         kind := NonStandardDebuggerKind(debugEntryAddr);
  191.                 end;
  192. {$ENDC}
  193.             end
  194.     {Alain Birtz’s ABZmon doesn’t put anything in MacJmp, but patches the trap dispatcher.}
  195.         else if ABZMonIsLoaded then
  196.             begin
  197.                 kind := debuggerKindABZmon;
  198. {$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
  199.                 signature := '??';
  200. {$ENDC}
  201.                 present := True;
  202.             end
  203.         else    {No debugger present.}
  204.             begin
  205.                 kind := debuggerKindNone;
  206. {$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
  207.                 signature := '  ';
  208. {$ENDC}
  209.             end;
  210.     end;
  211.  
  212.     function DebuggerPresent: Boolean;
  213.         var
  214.             present, active: Boolean;
  215.             kind: DebuggerKind;                {this never gets a value}
  216.             signature: DebuggerSignature;    {this never gets a value}
  217.     begin
  218.         GetDebuggerInfo(present, active, kind, signature);
  219.         DebuggerPresent := present;
  220.     end;
  221.  
  222. end.