home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / bix / catch.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-08-04  |  2.4 KB  |  83 lines
  1.  
  2.  
  3.  
  4. (*) Turbo Catch and Throw
  5. (*)
  6. (*) by Andrew Feldstein
  7. (*)
  8. (*) Version 1.0
  9. (*)
  10. (*) December 18, 1985
  11. (*)
  12.  
  13. {================================================================}
  14.  
  15. const catchsignature = $AFAF;
  16.  
  17. type  catchdata = record
  18.                      signature1         : integer;
  19.                      stackpointer       : integer;
  20.                      basepointer        : integer;
  21.                      instructionpointer : integer;
  22.                      thrown             : boolean;
  23.                      signature2         : integer
  24.                   end;
  25.  
  26. {================================================================}
  27.  
  28. procedure catch({OUT} var cd : catchdata);
  29. const ipvalue : integer = 0;
  30.       bpvalue : integer = 0;
  31.       spvalue : integer = 0;
  32. begin
  33.    inline($8B/$46/$02/      { MOV  AX,[BP+02] }
  34.           $2E/$A3/ipvalue/  { MOV  CS:[..],AX }
  35.           $8B/$46/$00/      { MOV  AX,[BP+00] }
  36.           $2E/$A3/bpvalue/  { MOV  CS:[..],AX }
  37.           $89/$E8/          { MOV  AX,BP      }
  38.           $05/$08/$00/      { ADD  AX,0008    }
  39.           $2E/$A3/spvalue); { MOV  CS:[..],AX }
  40.    cd.basepointer := bpvalue;
  41.    cd.stackpointer := spvalue;
  42.    cd.instructionpointer := ipvalue;
  43.    cd.thrown := false;
  44.    cd.signature1 := catchsignature;
  45.    cd.signature2 := catchsignature
  46. end;
  47.  
  48. {================================================================}
  49.  
  50. procedure throw({UPDATE}var cd : catchdata);
  51. const ipvalue : integer = 0;
  52.       bpvalue : integer = 0;
  53.       spvalue : integer = 0;
  54. begin
  55.    if (cd.signature1<>catchsignature) or (cd.signature2<>catchsignature) then
  56.       begin
  57.          writeln(con,^M^J^J'Throw called on uninitialized CATCHDATA.'^G^J);
  58.          halt
  59.       end;
  60.    cd.thrown := true;
  61.    ipvalue := cd.instructionpointer;
  62.    bpvalue := cd.basepointer;
  63.    spvalue := cd.stackpointer;
  64.    inline($2E/$8B/$26/spvalue/  { MOV  SP,CS:[spvalue] }
  65.           $2E/$8B/$2E/bpvalue/  { MOV  BP,CS:[bpvalue] }
  66.           $2E/$FF/$26/ipvalue); { JMP  CS:[ipvalue]    }
  67. end;
  68.  
  69. {================================================================}
  70.  
  71. function caught({IN}var cd : catchdata) : boolean;
  72. begin
  73.    caught := cd.thrown
  74. end;
  75.  
  76. {================================================================}
  77.  
  78. procedure uncatch({OUT}var cd : catchdata);
  79. begin
  80.    cd.signature1 := NOT catchsignature;
  81.    cd.signature2 := NOT catchsignature
  82. end;
  83.