home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / bix / debug.pas < prev    next >
Pascal/Delphi Source File  |  1986-11-01  |  3KB  |  99 lines
  1. {TITLE: Turbo-IBM-PCDOS-Debugging aid}
  2. type sstring  = string[80];
  3.      alfa     = string[10];
  4.      unsigned = integer;
  5.  
  6. {----------------------------------------------------------------}
  7.  
  8. { Returns as a short string the hexadecimal representation of "w." }
  9.  
  10. function hex(w : unsigned) : alfa;
  11. const digs : array[0..15] of char = '0123456789ABCDEF';
  12. begin
  13.    hex := digs[hi(w) shr 4] + digs[hi(w) and 15] +
  14.           digs[lo(w) shr 4] + digs[lo(w) and 15]
  15. end;
  16.  
  17. {----------------------------------------------------------------}
  18.  
  19. { Sounds the speaker at a frequency of "freq" for "len" ms. }
  20.  
  21. procedure beep(freq, len : integer);
  22. begin
  23.    sound(freq);
  24.    delay(len);
  25.    nosound
  26. end;
  27.  
  28. {----------------------------------------------------------------}
  29.  
  30. { Returns value of Stack Segment Register (SS) (which is <>
  31. SSeg!). }
  32.  
  33. function STSeg : unsigned;
  34. const ss : unsigned = 0;
  35. begin
  36.    inline($8C/$D0/$2E/$A3/ss); { MOV AX,SS : MOV CS:[*],AX }
  37.    STSeg := ss
  38. end;
  39.  
  40. {----------------------------------------------------------------}
  41.  
  42. { Returns the offset into the stack segment of the "n"'th frame on
  43. the stack.  The calling procedure's frame is numbered 0.  "N" may
  44. be  either positive or negative (depending on your view of the
  45. stack).}
  46.  
  47. function frameoffset(n : integer) : unsigned;
  48. const _n  : unsigned = 0;
  49.       _bp : unsigned = 0;
  50. begin
  51.    _n := succ(abs(n));
  52.    inline($2E/$8B/$0E/_n/   {           MOV  CX,CS:[*]  }
  53.           $89/$EB/          {           MOV  BX,BP      }
  54.           $36/$8B/$1F/      { TOPLOOP:  MOV  BX,SS:[BX] } { ; Old BP at BP+0 }
  55.           $E2/$FB/          {           LOOP TOPLOOP    }
  56.           $2E/$89/$1E/_bp); {           MOV  CS:[*],BX  }
  57.    frameoffset := _bp
  58. end;
  59.  
  60. {----------------------------------------------------------------}
  61.  
  62. { Returns the return address stored in the "n"'th stack frame. }
  63.  
  64. function returnaddress(n : integer) : unsigned;
  65. begin
  66.    returnaddress := memw[STSeg:frameoffset(n)+2]
  67. end;
  68.  
  69. {----------------------------------------------------------------}
  70.  
  71. { Clears the screen and prints out the error message "msg"
  72. followed by up to "max" currently active return addresses. }
  73.  
  74. { A check is made for hex 0000 to see if the bottom of the stack
  75. is reached.  The -4 is so that the address printed is the
  76. beginning of the call instruction. }
  77.  
  78. procedure fatal(msg : sstring);
  79. const max = 10;         { Maximum number of addresses to print }
  80. var i : integer;
  81. begin
  82.    clrscr;
  83.         { Print out error message }
  84.    writeln(con,'FATAL ERROR:  '+msg);
  85.         { Print out runtime stack }
  86.    write(con,'CUR ADDRS = [ ');
  87.    for i := 1 to max do
  88.       if returnaddress(i) <> 0000 then
  89.          begin
  90.             write(con,hex(returnaddress(i)-4),' ');
  91.             if i = max then write(con,'... ')
  92.          end;
  93.    writeln(con,']');
  94.         { Sound the horn }
  95.    beep(3000,500);
  96.         { Halt the program }
  97.    halt
  98. end;
  99.