home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / exit / sysdebug.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-21  |  2.2 KB  |  85 lines
  1. UNIT SysDebug;
  2.  
  3. { System globals debugging unit }
  4.  
  5. INTERFACE
  6.  
  7. IMPLEMENTATION
  8.  
  9. TYPE  String15 = String[15];    { WPointer string parameter }
  10.  
  11. VAR   savedExitProc : Pointer;  { Old ExitProc value }
  12.  
  13.  
  14. PROCEDURE WHex( v : word );
  15. { Display v as a 4-digit hex string }
  16. CONST
  17.    digits : ARRAY[ 0 .. 15 ] OF char = '0123456789ABCDEF';
  18. BEGIN
  19.    Write( digits[ hi( v ) div 16 ],
  20.           digits[ hi( v ) mod 16 ],
  21.           digits[ lo( v ) div 16 ],
  22.           digits[ lo( v ) mod 16 ]  )
  23. END; { WHex }
  24.  
  25.  
  26. PROCEDURE WPointer( description : String15; p : Pointer );
  27. { Display pointer value in 0000:0000 format }
  28. BEGIN
  29.    Write( description );
  30.    IF p = NIL THEN Write( 'NIL' ) ELSE
  31.    BEGIN
  32.       Write( '$' );
  33.       WHex( Seg(p^) );
  34.       Write( ':' );
  35.       WHex( Ofs(p^) )
  36.    END; { if }
  37.    Writeln
  38. END; { WPointer }
  39.  
  40.  
  41. PROCEDURE WWord( description : String15; w : Word );
  42. { Display word value in 0000 hex format }
  43. BEGIN
  44.    Write( description, '$' );
  45.    WHex( w );
  46.    Writeln
  47. END; { WWord }
  48.  
  49.  
  50. {$F+} PROCEDURE CustomExit; {$F-}
  51.  
  52. { Display system global variables at exit }
  53.  
  54. BEGIN
  55.    Writeln;
  56.    Writeln(  'System unit global variables' );
  57.    Writeln(  '----------------------------' );
  58.    Writeln(  'Memavail  = ', memavail, ' bytes');
  59.    Writeln(  'Maxavail  = ', maxavail, ' bytes');
  60.    WWord(    'PrefixSeg = ', prefixSeg );
  61.    WWord(    'CSeg      = ', cSeg      );
  62.    WWord(    'DSeg      = ', dSeg      );
  63.    WWord(    'SSeg      = ', sSeg      );
  64.    WWord(    'SPtr      = ', sPtr      );
  65.    WPointer( 'HeapOrg   = ', heapOrg   );
  66.    WPointer( 'HeapPtr   = ', heapPtr   );
  67.    WPointer( 'FreePtr   = ', freePtr   );
  68.    Writeln(  'FreeMin   = ', freeMin   );
  69.    WPointer( 'HeapError = ', heapError );
  70.    WPointer( 'ExitProc  = ', exitProc  );
  71.    Writeln(  'ExitCode  = ', exitCode  );
  72.    WPointer( 'ErrorAddr = ', errorAddr );
  73.    Writeln(  'RandSeed  = ', randSeed  );
  74.    Writeln(  'FileMode  = ', fileMode  );
  75.  
  76.    exitProc := savedExitProc    { Restore saved exitProc pointer }
  77.  
  78. END; { CustomExit }
  79.  
  80.  
  81. BEGIN
  82.    savedExitProc := exitProc;   { Save ExitProc pointer }
  83.    exitProc := @CustomExit      { Install custom exit procedure }
  84. END.
  85.