home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp6goodi / error / bigmem.pas next >
Encoding:
Pascal/Delphi Source File  |  1990-12-16  |  4.1 KB  |  114 lines
  1. unit BIGMEM;
  2. { ************************************
  3.   User Runtime Error Demo 3
  4.  
  5.   This routine demonstrates how FRTE can be used.  This program has a "unit"
  6.   which allocates heap space for a particular type of data struture.  When
  7.   a heap error occurs, rather than a runtime error ocurring where the actual
  8.   new() procedure was called, it occurs where the program called the "unit"
  9.   routine that does memory allocation.  This allows user written "units" to
  10.   be linked into Turbo's runtime error support.
  11.   ************************************ }
  12.  
  13. {=======================================
  14.  Ok here is our "unit".  It allocates memory to a datatype.  If the routine
  15.  calling this "unit" ask for too much memory, a heap error is generated. Where
  16.  we want to see the error is where our unit is called, not where the new() that
  17.  caused the error is located.
  18.  =======================================}
  19. interface
  20.     uses FRTE;
  21.   {$F+}
  22.   const
  23.     InUnit : boolean = true;
  24.   type
  25.         bigmemarray =array[1..$fffe] of byte;
  26.         bigmemptr = ^bigmemarray;
  27.   procedure get_bigmem(var BM:bigmemptr);
  28.  
  29. implementation
  30. var
  31.   errsize:word;
  32.     UNITID:word;
  33. {-----------------------------------------}
  34. { This is the routine that traps Turbo's Heap Error.  It replaces Turbo's
  35.   Heap error routine (which basically does nothing), and calls FRTE passing
  36.   the errorcode and location of the call that caused the error.  If FRTE
  37.   is told to trap the error, this routine is never returned to, and control
  38.   never passes back to Heap Manager.  FRTE then handles the error via
  39.   TURBO's IDE error system.  However, if FRTE is told not to trap
  40.   error, control will pass here.  This routine then must tell Heap Manager
  41.   how to handle the error.  Returning a 0 means generate a runtime error
  42.   from location of new() or whatever, 1 causes new() and getmem() to return
  43.   a nil pointer, 2 indicates problem has been corrected and retry.
  44.                   }
  45. {$F+}
  46. function trapheaperror(Size:word):integer; far;
  47. var
  48.   generation : word;
  49. begin
  50.   if Size>0 then  { Ignore this call, Heapptr just moved Thnx}
  51.     begin
  52.     ShowFRTEmessage := true;
  53.     errsize := size;
  54.         { Error is 3 generations back, 1 Internal, 2 is new() and
  55.       3 is Get_BIGMEM() }
  56.       if InUnit then Generation := 2 else Generation := 3;
  57.     FRTError(Find_far_Caller(generation),203 or UnitID);
  58.     trapheaperror := 0;
  59.     end;
  60. end;
  61.  
  62. {-----------------------------------------}
  63. { This routine simply displays an interpretive message, and then decides
  64.   where the error should be handled, i.e FRTE and then dumped into Turbo's
  65.   run time error routine, or returned to the Heap manager, who will dumpit.
  66.   This is done via the InUnit variable.  Essentially, when InUnit is true,
  67.   the the error will be trapped where it occurs in the Unit's code and the
  68.   IDE will go there.  If InUnit is false, the error is trapped in the Unit
  69.   but the IDE takes you to where the UNIT was called. }
  70.  
  71. function showheaperror(eaddr:pointer;errcode:word):integer;
  72. begin
  73.   writeln('Heap overflow, request was for ',errsize,' bytes, only ',
  74.           maxavail,' bytes are available');
  75.   if InUnit then
  76.     showheaperror := 0
  77.   else
  78.     showheaperror := 1;
  79. end;
  80.  
  81. {-----------------------------------------}
  82. { This is just a dummy procedure we are using to demonstrate trapping heap
  83.   errors }
  84.  
  85. procedure init_bigmem;
  86. begin
  87.   { Set up to Trap Turbo's Heap Error }
  88.     HeapError := @trapheaperror;
  89.   { This installs the FRTE system }
  90.     UNITID := InstallFRTE(showHeapError);
  91. end;
  92. {========================================}
  93.  
  94. { Ok here is main program, it tries and hog
  95.   memory, but we find out who the culprit is!
  96.   If you want to debug the unit, set InUnit to true,
  97.   if you want to debug the program set InUnit to false;
  98.   Try it ! You'll like it !
  99. }
  100. {-----------------------------------------}
  101. { Allocates memory }
  102. procedure get_bigmem(var BM:bigmemptr);
  103. begin
  104.     writeln('This is Get_bigmem ');
  105.   {Here is where the actual allocation is made }
  106.   new(BM);
  107. end;
  108. {-----------------------------------------}
  109. begin
  110.   init_bigmem;
  111. end.
  112.  
  113.  
  114.