* Brought my policy into practive that the RTL should output only runtime

errors and no other texts when things go wrong.

rtl/i386/heap.inc

@@ -1,5 +1,5 @@
 {
-    $Id$
+	$Id$
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,97 by the Free Pascal development team.
 
@@ -43,9 +43,9 @@
     const last_assigned : pheap_mem_info = nil;
     const growheapstop : boolean = false;
 
-    const free_nothing : boolean = false;
+	const free_nothing : boolean = false;
     const trace : boolean = true;
-    const getmem_nb : longint = 0;
+	const getmem_nb : longint = 0;
     const freemem_nb : longint = 0;
 {$EndIf CHECKHEAP}
 
@@ -61,7 +61,7 @@
 
     type
        tblocks   = array[1..maxblock] of pointer;
-       pblocks   = ^tblocks;
+	   pblocks   = ^tblocks;
        tnblocks  = array[1..maxblock] of longint;
        pnblocks  = ^tnblocks;
        pheapinfo = ^theapinfo;
@@ -87,7 +87,7 @@
        baseheap : theapinfo;
        curheap : pheapinfo;
 {$ifdef TEMPHEAP}
-       tempheap : theapinfo;
+	   tempheap : theapinfo;
        otherheap : pheapinfo;
 {$endif TEMPHEAP}
 
@@ -130,8 +130,8 @@
 
     function heapsize : longint;
 
-      begin
-         heapsize:=_heapsize;
+	  begin
+		 heapsize:=_heapsize;
       end;
 
 {$IfDef CHECKHEAP}
@@ -149,7 +149,7 @@
                begin
                  writeln(i,' 0x',hexstr(pp^.calls[i],8));
                end;
-          end
+		  end
         else
           writeln('tracing not enabled, sorry !!');
       end;
@@ -174,34 +174,34 @@
          call_stack(p+sizeof(heap_mem_info));
          asm
             movl (%ebp),%eax
-            movl (%eax),%eax
-            movl %eax,ebp
-         end;
-         dump_stack(ebp);
-      end;
-
-    function is_in_getmem_list (p : pointer) : boolean;
-        var pp : pheap_mem_info;
-            i : longint;
-      begin
-        is_in_getmem_list:=false;
-        pp:=last_assigned;
-        i:=0;
-        while pp<>nil do
-          begin
-             if (pp^.sig<>$DEADBEEF) and (pp^.sig <> $AAAAAAAA) then
+			movl (%eax),%eax
+			movl %eax,ebp
+		 end;
+		 dump_stack(ebp);
+	  end;
+
+	function is_in_getmem_list (p : pointer) : boolean;
+		var pp : pheap_mem_info;
+			i : longint;
+	  begin
+		is_in_getmem_list:=false;
+		pp:=last_assigned;
+		i:=0;
+		while pp<>nil do
+		  begin
+			 if (pp^.sig<>$DEADBEEF) and (pp^.sig <> $AAAAAAAA) then
+			   begin
+				  writeln('error in linked list of heap_mem_info');
+				  runerror(204);
+			   end;
+
+			 if pp=p then
                begin
-                  writeln('error in linked list of heap_mem_info');
-                  runerror(204);
-               end;
-
-             if pp=p then
-               begin
-                  is_in_getmem_list:=true;
+				  is_in_getmem_list:=true;
                end;
              pp:=pp^.previous;
              inc(i);
-             if i > getmem_nb - freemem_nb then
+			 if i > getmem_nb - freemem_nb then
                writeln('error in linked list of heap_mem_info');
           end;
       end;
@@ -218,8 +218,8 @@
               exit;
            end
          else
-           begin
-              hp:=freelist;
+		   begin
+			  hp:=freelist;
               while assigned(hp) do
                 begin
                    if (p>=hp) and (p<hp+hp^.size) then
@@ -237,32 +237,32 @@
     function cal_memavail : longint;
 
       var
-         hp : pfreerecord;
+		 hp : pfreerecord;
          ma : longint;
-         i  : longint;
-
-      begin
-         ma:=heapend-heapptr;
-         if heapblocks then
-         for i:=1 to maxblock do
-           ma:=ma+i*8*nblocks^[i];
-         hp:=freelist;
-         while assigned(hp) do
-           begin
-              ma:=ma+hp^.size;
+		 i  : longint;
+
+	  begin
+		 ma:=heapend-heapptr;
+		 if heapblocks then
+		 for i:=1 to maxblock do
+		   ma:=ma+i*8*nblocks^[i];
+		 hp:=freelist;
+		 while assigned(hp) do
+		   begin
+			  ma:=ma+hp^.size;
 {$IfDef CHECKHEAP}
-              if (longint(hp^.next)=0) then
-                begin
-                   if ((longint(hp)+hp^.size)>longint(heapptr)) then
-                     writeln('freerecordlist bad at end ')
-                end
-              else
-                          if ((longint(hp^.next)<=(longint(hp)+hp^.size)) or
+			  if (longint(hp^.next)=0) then
+				begin
+				   if ((longint(hp)+hp^.size)>longint(heapptr)) then
+					 writeln('freerecordlist bad at end ')
+				end
+			  else
+						  if ((longint(hp^.next)<=(longint(hp)+hp^.size)) or
                              ((hp^.size and 7) <> 0)) then
                   writeln('error in freerecord list ');
 {$EndIf CHECKHEAP}
               hp:=hp^.next;
-           end;
+		   end;
          cal_memavail:=ma;
       end;
 
@@ -289,8 +289,8 @@
       tempheap.heapend:=heapend;
       tempheap.memavail:=longint(tempheap.heapend) - longint(tempheap.heaporg);
       tempheap.heapsize:=tempheap.memavail;
-      getmem(tempheap.block,sizeof(tblocks));
-      getmem(tempheap.nblock,sizeof(tnblocks));
+	  getmem(tempheap.block,sizeof(tblocks));
+	  getmem(tempheap.nblock,sizeof(tnblocks));
       for i:=1 to maxblock do
         begin
         tempheap.block^[i]:=nil;
@@ -301,12 +301,12 @@
       baseheap.memavail:=_memavail;
       baseheap.heapsize:=longint(baseheap.heapend)-longint(baseheap.heaporg);
       curheap:=@baseheap;
-      otherheap:=@tempheap;
+	  otherheap:=@tempheap;
       heap_split:=true;
       end;
     end;
 
-    procedure switch_to_temp_heap;
+	procedure switch_to_temp_heap;
     begin
     if curheap = @baseheap then
       begin
@@ -320,12 +320,12 @@
 {$IfDef CHECKHEAP}
       baseheap.last_mem:=last_assigned;
       last_assigned:=tempheap.last_mem;
-      baseheap.nb_get:=getmem_nb;
+	  baseheap.nb_get:=getmem_nb;
       baseheap.nb_free:=freemem_nb;
-      getmem_nb:=tempheap.nb_get;
+	  getmem_nb:=tempheap.nb_get;
       freemem_nb:=tempheap.nb_free;
 {$EndIf CHECKHEAP}
-      heaporg:=tempheap.heaporg;
+	  heaporg:=tempheap.heaporg;
       heapptr:=tempheap.heapptr;
       freelist:=tempheap.freelist;
       heapend:=tempheap.heapend;
@@ -345,13 +345,13 @@
       tempheap.heapend:=heapend;
       tempheap.heapptr:=heapptr;
       tempheap.freelist:=freelist;
-      tempheap.memavail:=_memavail;
+	  tempheap.memavail:=_memavail;
 {$IfDef CHECKHEAP}
       tempheap.last_mem:=last_assigned;
       last_assigned:=baseheap.last_mem;
-      tempheap.nb_get:=getmem_nb;
-      tempheap.nb_free:=freemem_nb;
-      getmem_nb:=baseheap.nb_get;
+	  tempheap.nb_get:=getmem_nb;
+	  tempheap.nb_free:=freemem_nb;
+	  getmem_nb:=baseheap.nb_get;
       freemem_nb:=baseheap.nb_free;
 {$EndIf CHECKHEAP}
       heaporg:=baseheap.heaporg;
@@ -369,7 +369,7 @@
     procedure switch_heap;
     begin
     if not heap_split then split_heap;
-    if curheap = @tempheap then
+	if curheap = @tempheap then
       switch_to_base_heap
       else
       switch_to_temp_heap;
@@ -381,7 +381,7 @@
        split_heap;
        switch_to_temp_heap;
        allow_special:=true;
-       getmem(p,size);
+	   getmem(p,size);
        allow_special:=false;
     end;
 {$endif TEMPHEAP}
@@ -389,12 +389,12 @@
     function memavail : longint;
 
       begin
-         memavail:=_memavail;
+		 memavail:=_memavail;
       end;
 
 {$ifdef TEMPHEAP}
     procedure unsplit_heap;
-    var hp,hp2,thp : pfreerecord;
+	var hp,hp2,thp : pfreerecord;
     begin
     {heapend can be modified by HeapError }
     if not heap_split then exit;
@@ -413,7 +413,7 @@
            hp^.next:=tempheap.freelist;
            heapptr:=tempheap.heapptr;
         end;
-      heapend:=tempheap.heapend;
+	  heapend:=tempheap.heapend;
       _memavail:=cal_memavail;
       heap_split:=false;
       end else
@@ -433,12 +433,12 @@
             hp:=hp^.next;
         if assigned(hp^.next) then
             begin
-            thp:=hp^.next;
+			thp:=hp^.next;
             hp^.next:=hp2;
             hp:=thp;
             end else
             begin
-            hp^.next:=hp2;
+			hp^.next:=hp2;
             hp:=nil;
             end;
           end ;
@@ -457,7 +457,7 @@
     begin
     switch_to_temp_heap;
 {$ifdef CHECKHEAP}
-    if heapptr<>heaporg then
+	if heapptr<>heaporg then
       writeln('Warning in releasetempheap : ',longint(tempheap.heapsize)-longint(tempheap.memavail),' bytes used !');
     dump_heap(true);
 {    release(heaporg);
@@ -477,25 +477,25 @@
          maxavail:=heapend-heapptr;
          hp:=freelist;
          while assigned(hp) do
-           begin
-              if hp^.size>maxavail then
-                maxavail:=hp^.size;
-              hp:=hp^.next;
-           end;
-      end;
+		   begin
+			  if hp^.size>maxavail then
+				maxavail:=hp^.size;
+			  hp:=hp^.next;
+		   end;
+	  end;
 
 {$ifdef CHECKHEAP}
-     procedure test_memavail;
-
-       begin
-          if check and (_memavail<>cal_memavail) then
-            begin
-               writeln('Memavail error in getmem/freemem');
-            end;
-       end;
+	 procedure test_memavail;
+
+	   begin
+		  if check and (_memavail<>cal_memavail) then
+			begin
+			   writeln('Memavail error in getmem/freemem');
+			end;
+	   end;
 {$endif CHECKHEAP}
 
-    procedure getmem(var p : pointer;size : longint);[public,alias: 'GETMEM'];
+	procedure getmem(var p : pointer;size : longint);[public,alias: 'GETMEM'];
 
 {$IfDef CHECKHEAP}
       var i,bp,orsize : longint;
@@ -539,15 +539,15 @@
 {$ifdef TEMPHEAP}
          if heap_split and not allow_special then
            begin
-           if (@p < otherheap^.heapend) and
-              (@p > otherheap^.heaporg) then
-              { useful line for the debugger }
+		   if (@p < otherheap^.heapend) and
+			  (@p > otherheap^.heaporg) then
+			  { useful line for the debugger }
              writeln('warning : p and @p are in different heaps !');
            end;
 {$endif TEMPHEAP}
-         { calc to multiply of 8 }
+		 { calc to multiply of 8 }
          size:=(size+7) and not 7;
-         dec(_memavail,size);
+		 _memavail:=_memavail-size;
          if heapblocks then
           begin
          { search cache }
@@ -570,7 +570,7 @@
          repeat
            nochmal:=false;
            { search the freelist }
-           if assigned(freelist) then
+		   if assigned(freelist) then
              begin
                 last:=nil;
                 hp:=freelist;
@@ -583,57 +583,57 @@
                           { need we the whole block ? }
                           if (hp^.size>size) and heapblocks then
                             begin
-                               { we must check if we are still below the limit !! }
-                               if hp^.size-size<=max_size then
-                                 begin
-                                    { adjust the list }
-                                    if assigned(last) then
-                                      last^.next:=hp^.next
-                                    else
-                                      freelist:=hp^.next;
-                                    { insert in chain }
-                                    s:=(hp^.size-size) div 8;
-                                    ppointer(hp+size)^:=blocks^[s];
-                                    blocks^[s]:=hp+size;
-                                    inc(nblocks^[s]);
-                                 end
-                               else
-                               begin
-                                  (hp+size)^.size:=hp^.size-size;
-                                  (hp+size)^.next:=hp^.next;
-                                  if assigned(last) then
-                                    last^.next:=hp+size
-                                  else
-                                    freelist:=hp+size;
-                               end;
-                            end
-                          else
-                            begin
+							   { we must check if we are still below the limit !! }
+							   if hp^.size-size<=max_size then
+								 begin
+									{ adjust the list }
+									if assigned(last) then
+									  last^.next:=hp^.next
+									else
+									  freelist:=hp^.next;
+									{ insert in chain }
+									s:=(hp^.size-size) div 8;
+									ppointer(hp+size)^:=blocks^[s];
+									blocks^[s]:=hp+size;
+									inc(nblocks^[s]);
+								 end
+							   else
+							   begin
+								  (hp+size)^.size:=hp^.size-size;
+								  (hp+size)^.next:=hp^.next;
+								  if assigned(last) then
+									last^.next:=hp+size
+								  else
+									freelist:=hp+size;
+							   end;
+							end
+						  else
+							begin
 {$IfDef CHECKHEAP}
-                               dec(freerecord_list_length);
+							   dec(freerecord_list_length);
 {$endif CHECKHEAP}
-                               if assigned(last) then
-                                 last^.next:=hp^.next
-                               else
-                                 {this was wrong !!}
-                                 {freelist:=nil;}
-                                 freelist:=hp^.next;
-                            end;
+							   if assigned(last) then
+								 last^.next:=hp^.next
+							   else
+								 {this was wrong !!}
+								 {freelist:=nil;}
+								 freelist:=hp^.next;
+							end;
 {$ifdef CHECKHEAP}
                             goto check_new;
 {$else CHECKHEAP}
                             exit;
 {$endif CHECKHEAP}
-                       end;
+					   end;
                      last:=hp;
                      hp:=hp^.next;
                   end;
              end;
-           { Latly, the top of the heap is checked, to see if there is }
+		   { Latly, the top of the heap is checked, to see if there is }
            { still memory available.                                   }
            if heapend-heapptr<size then
              begin
-                if assigned(heaperror) then
+				if assigned(heaperror) then
                   begin
                      case call_heaperror(heaperror,size) of
                         0 : runerror(203);
@@ -658,11 +658,11 @@ check_new:
        begin
            asm
               movl (%ebp),%eax
-              movl %eax,bp
+			  movl %eax,bp
            end;
           pheap_mem_info(p)^.sig:=$DEADBEEF;
           pheap_mem_info(p)^.previous:=last_assigned;
-          if last_assigned<>nil then
+		  if last_assigned<>nil then
             last_assigned^.next:=pheap_mem_info(p);
           last_assigned:=p;
           pheap_mem_info(p)^.next:=nil;
@@ -673,11 +673,11 @@ check_new:
                bp:=get_next_frame(bp);
             end;
           p:=p+sizeof(heap_mem_info);
-       end;
+	   end;
 {$endif CHECKHEAP}
       end;
 
-    procedure freemem(var p : pointer;size : longint);[public,alias: 'FREEMEM'];
+	procedure freemem(var p : pointer;size : longint);[public,alias: 'FREEMEM'];
 
       var
          hp : pfreerecord;
@@ -700,73 +700,73 @@ check_new:
           p:=p-sizeof(heap_mem_info);
           { made after heap_switch
           if not (is_in_getmem_list(p)) then
-            runerror(204); }
+			runerror(204); }
        end;
 {$endif CHECKHEAP}
          if size=0 then
            begin
               p:=nil;
-              exit;
+			  exit;
            end;
-         if p=nil then RunError (204);
+		 if p=nil then RunError (204);
 {$ifdef TEMPHEAP}
-         heap_switched:=false;
-         if heap_split and not allow_special then
-           begin
-              if (p <= heapptr) and
-                 ( p >= heaporg) and
-                 (@p <= otherheap^.heapend) and
-                 (@p >= otherheap^.heaporg) then
-                begin
-                   writeln('warning : p and @p are in different heaps !');
-                end;
-           end;
-         if (p<heaporg) or (p>heapptr) then
-           begin
-              if heap_split and (p<otherheap^.heapend) and
-                 (p>otherheap^.heaporg) then
-                begin
-                   if (@p >= heaporg) and
-                      (@p <= heapptr) and
-                      not allow_special then
-                      writeln('warning : p and @p are in different heaps !');
-                   switch_heap;
-                   heap_switched:=true;
-                end
-              else
-                begin
-                   writeln('pointer ',hexstr(longint(@p),8),' at ',
-                     hexstr(longint(p),8),' doesn''t points to the heap');
-                   runerror(204);
-                end;
-           end;
+		 heap_switched:=false;
+		 if heap_split and not allow_special then
+		   begin
+			  if (p <= heapptr) and
+				 ( p >= heaporg) and
+				 (@p <= otherheap^.heapend) and
+				 (@p >= otherheap^.heaporg) then
+				begin
+				   writeln('warning : p and @p are in different heaps !');
+				end;
+		   end;
+		 if (p<heaporg) or (p>heapptr) then
+		   begin
+			  if heap_split and (p<otherheap^.heapend) and
+				 (p>otherheap^.heaporg) then
+				begin
+				   if (@p >= heaporg) and
+					  (@p <= heapptr) and
+					  not allow_special then
+					  writeln('warning : p and @p are in different heaps !');
+				   switch_heap;
+				   heap_switched:=true;
+				end
+			  else
+				begin
+				   writeln('pointer ',hexstr(longint(@p),8),' at ',
+					 hexstr(longint(p),8),' doesn''t points to the heap');
+				   runerror(204);
+				end;
+		   end;
 {$endif TEMPHEAP}
 {$ifdef CHECKHEAP}
-     if trace then
-       begin
-          if not (is_in_getmem_list(p)) then
-            runerror(204);
-          if pheap_mem_info(p)^.sig=$AAAAAAAA then
-            dump_free(p);
-          if pheap_mem_info(p)^.next<>nil then
-            pheap_mem_info(p)^.next^.previous:=pheap_mem_info(p)^.previous;
-          if pheap_mem_info(p)^.previous<>nil then
-            pheap_mem_info(p)^.previous^.next:=pheap_mem_info(p)^.next;
-          if pheap_mem_info(p)=last_assigned then
-            last_assigned:=last_assigned^.previous;
-       end;
+	 if trace then
+	   begin
+		  if not (is_in_getmem_list(p)) then
+			runerror(204);
+		  if pheap_mem_info(p)^.sig=$AAAAAAAA then
+			dump_free(p);
+		  if pheap_mem_info(p)^.next<>nil then
+			pheap_mem_info(p)^.next^.previous:=pheap_mem_info(p)^.previous;
+		  if pheap_mem_info(p)^.previous<>nil then
+			pheap_mem_info(p)^.previous^.next:=pheap_mem_info(p)^.next;
+		  if pheap_mem_info(p)=last_assigned then
+			last_assigned:=last_assigned^.previous;
+	   end;
 {$endif CHECKHEAP}
-         { calc to multiple of 8 }
-         size:=(size+7) and not 7;
-         inc(_memavail,size);
-         if p+size>=heapptr then
-           heapptr:=p
-         { insert into cache }
-         else
-          if heapblocks and (size<=max_size) then
-           begin
-              s:=size div 8;
-              ppointer(p)^:=blocks^[s];
+		 { calc to multiple of 8 }
+		 size:=(size+7) and not 7;
+		 _memavail:=_memavail+size;
+		 if p+size>=heapptr then
+		   heapptr:=p
+		 { insert into cache }
+		 else
+		  if heapblocks and (size<=max_size) then
+		   begin
+			  s:=size div 8;
+			  ppointer(p)^:=blocks^[s];
               blocks^[s]:=p;
               inc(nblocks^[s]);
            end
@@ -785,7 +785,7 @@ check_new:
                    inc(freerecord_list_length);
 {$endif CHECKHEAP}
                    goto freemem_exit;
-                end;
+				end;
               if p+size<freelist then
                 begin
                 pfreerecord(p)^.next:=freelist;
@@ -794,22 +794,22 @@ check_new:
                 inc(freerecord_list_length);
 {$endif CHECKHEAP}
                 goto freemem_exit;
-                end
+				end
               else
-              if p+size=freelist then
-                begin
-                inc(pfreerecord(p)^.size,pfreerecord(freelist)^.size);
-                pfreerecord(p)^.next:=pfreerecord(freelist)^.next;
-                freelist:=p;
-                { but now it can also connect the next block !!}
-                if p+pfreerecord(p)^.size=pfreerecord(p)^.next then
-                  begin
-                     inc(pfreerecord(p)^.size,pfreerecord(p)^.next^.size);
+			  if p+size=freelist then
+				begin
+				pfreerecord(p)^.size:=Pfreerecord(p)^.size+pfreerecord(freelist)^.size;
+				pfreerecord(p)^.next:=pfreerecord(freelist)^.next;
+				freelist:=p;
+				{ but now it can also connect the next block !!}
+				if p+pfreerecord(p)^.size=pfreerecord(p)^.next then
+				  begin
+					 pfreerecord(p)^.size:=pfreerecord(p)^.size+pfreerecord(p)^.next^.size;
 {$ifdef CHECKHEAP}
                      dec(freerecord_list_length);
 {$endif CHECKHEAP}
                      pfreerecord(p)^.next:=pfreerecord(freelist)^.next^.next;
-                  end;
+				  end;
                 goto freemem_exit;
                 end;
               { search the insert position }
@@ -817,68 +817,72 @@ check_new:
               while assigned(hp) do
                 begin
                    if p<hp+hp^.size then
-                      begin
-                      writeln('pointer to dispose at ',hexstr(longint(p),8),
-                        ' has already been disposed');
-                      runerror(204);
-                      end;
-                   { connecting two blocks ? }
-                   if hp+hp^.size=p then
-                      begin
-                         inc(hp^.size,size);
-                         { connecting also to next block ? }
-                         if hp+hp^.size=hp^.next then
-                           begin
-                              inc(hp^.size,hp^.next^.size);
+					  begin
 {$ifdef CHECKHEAP}
-                              dec(freerecord_list_length);
+					  writeln('pointer to dispose at ',hexstr(longint(p),8),
+						' has already been disposed');
 {$endif CHECKHEAP}
-                              hp^.next:=hp^.next^.next;
-                           end
-                         else
-                         if (hp^.next<>nil) and (hp+hp^.size>hp^.next) then
-                           begin
-                              writeln('pointer to dispose at ',hexstr(longint(p),8),
-                                ' is too big !!');
-                              runerror(204);
-                            end;
-                         break;
-                      end
-                   { if the end is reached, then concat }
-                   else if hp^.next=nil then
-                     begin
-                        hp^.next:=p;
+					  runerror(204);
+					  end;
+				   { connecting two blocks ? }
+				   if hp+hp^.size=p then
+					  begin
+						 hp^.size:=hp^.size+size;
+						 { connecting also to next block ? }
+						 if hp+hp^.size=hp^.next then
+						   begin
+							  hp^.size:=hp^.size+hp^.next^.size;
 {$ifdef CHECKHEAP}
-                        inc(freerecord_list_length);
+							  dec(freerecord_list_length);
 {$endif CHECKHEAP}
-                        pfreerecord(p)^.next:=nil;
-                        break;
-                     end
-                   { falls der n„chste Zeiger gr”áer ist, dann }
-                   { Einh„ngen                                 }
-                   else if hp^.next>p then
-                     begin
-                        { connect to blocks }
-                        if p+size=hp^.next then
-                          begin
-                             pfreerecord(p)^.next:=hp^.next^.next;
-                             inc(pfreerecord(p)^.size,hp^.next^.size);
-                             { we have to reset the right position }
-                             hp^.next:=pfreerecord(p);
-                          end
-                        else
-                          begin
+							  hp^.next:=hp^.next^.next;
+						   end
+						 else
+						 if (hp^.next<>nil) and (hp+hp^.size>hp^.next) then
+						   begin
+{$ifdef CHECKHEAP}
+							  writeln('pointer to dispose at ',hexstr(longint(p),8),
+								' is too big !!');
+{$endif CHECKHEAP}
+							  runerror(204);
+							end;
+						 break;
+					  end
+				   { if the end is reached, then concat }
+				   else if hp^.next=nil then
+					 begin
+						hp^.next:=p;
+{$ifdef CHECKHEAP}
+						inc(freerecord_list_length);
+{$endif CHECKHEAP}
+						pfreerecord(p)^.next:=nil;
+						break;
+					 end
+				   { falls der n„chste Zeiger gr”áer ist, dann }
+				   { Einh„ngen                                 }
+				   else if hp^.next>p then
+					 begin
+						{ connect to blocks }
+						if p+size=hp^.next then
+						  begin
+							 pfreerecord(p)^.next:=hp^.next^.next;
+							 pfreerecord(p)^.size:=pfreerecord(p)^.size+hp^.next^.size;
+							 { we have to reset the right position }
+							 hp^.next:=pfreerecord(p);
+						  end
+						else
+						  begin
                              pfreerecord(p)^.next:=hp^.next;
-                             hp^.next:=p;
+							 hp^.next:=p;
 {$ifdef CHECKHEAP}
                              inc(freerecord_list_length);
 {$endif CHECKHEAP}
                           end;
-                        break;
+						break;
                      end;
                    hp:=hp^.next;
                 end;
-           end;
+		   end;
          freemem_exit:
 {$ifdef CHECKHEAP}
          inc(freemem_nb);
@@ -893,7 +897,7 @@ check_new:
     procedure release(var p : pointer);
 
       begin
-         heapptr:=p;
+		 heapptr:=p;
          freelist:=nil;
          _memavail:=cal_memavail;
       end;
@@ -904,7 +908,7 @@ check_new:
          p:=heapptr;
       end;
 
-    procedure markheap(var oldfreelist,oldheapptr : pointer);
+	procedure markheap(var oldfreelist,oldheapptr : pointer);
 
       begin
          oldheapptr:=heapptr;
@@ -913,16 +917,16 @@ check_new:
          _memavail:=cal_memavail;
       end;
 
-    procedure releaseheap(oldfreelist,oldheapptr : pointer);
+	procedure releaseheap(oldfreelist,oldheapptr : pointer);
 
       begin
          heapptr:=oldheapptr;
          if longint(freelist) < longint(heapptr) then
-           begin
+		   begin
            {here we should reget the freed blocks}
            end;
          freelist:=oldfreelist;
-         _memavail:=cal_memavail;
+		 _memavail:=cal_memavail;
       end;
 
 { the sbrk  function is moved to the system.pp }
@@ -948,40 +952,40 @@ begin
      begin
         GrowHeap:=0;
         {$IfDef CHECKHEAP}
-        writeln('Call to GrowHeap failed');
-        readln;
-        {$EndIf CHECKHEAP}
-        Exit;
-     end
+		writeln('Call to GrowHeap failed');
+		readln;
+		{$EndIf CHECKHEAP}
+		Exit;
+	 end
    else
-     begin
-     { make the room clean }
+	 begin
+	 { make the room clean }
 {$ifdef CHECKHEAP}
-        Fillword(pointer(NewPos)^,size div 2,$ABCD);
-        Newlimit:= (newpos+size) or $3fff;
+		Fillword(pointer(NewPos)^,size div 2,$ABCD);
+		Newlimit:= (newpos+size) or $3fff;
 {$else }
-        Fillchar(pointer(NewPos)^,size,#0);
+		Fillchar(pointer(NewPos)^,size,#0);
 {$endif }
-        hp:=pfreerecord(freelist);
-        if not assigned(hp) then
-          begin
-          if pointer(newpos) = heapend then
-            heapend:=pointer(newpos+size)
-          else
-            begin
-               if heapend - heapptr > 0 then
-                 begin
-                    freelist:=heapptr;
-                    hp:=pfreerecord(freelist);
-                    hp^.size:=heapend-heapptr;
-                    hp^.next:=nil;
-                 end;
-               heapptr:=pointer(newpos);
-               heapend:=pointer(newpos+size);
-            end;
-          end
-        else
-          begin
+		hp:=pfreerecord(freelist);
+		if not assigned(hp) then
+		  begin
+		  if pointer(newpos) = heapend then
+			heapend:=pointer(newpos+size)
+		  else
+			begin
+			   if heapend - heapptr > 0 then
+				 begin
+					freelist:=heapptr;
+					hp:=pfreerecord(freelist);
+					hp^.size:=heapend-heapptr;
+					hp^.next:=nil;
+				 end;
+			   heapptr:=pointer(newpos);
+			   heapend:=pointer(newpos+size);
+			end;
+		  end
+		else
+		  begin
              if pointer(newpos) = heapend then
                heapend:=pointer(newpos+size)
              else
@@ -1001,16 +1005,16 @@ begin
                     begin
                        pfreerecord(NewPos)^.Size:=Size;
                        pfreerecord(NewPos)^.Next:=hp^.next;
-                       hp^.next:=pfreerecord(NewPos);
+					   hp^.next:=pfreerecord(NewPos);
                     end;
                end;
           end;
         { the wanted size has to be substracted }
-        _memavail:=cal_memavail-wantedsize;
+		_memavail:=cal_memavail-wantedsize;
         { set the total new heap size }
         asm
         movl Size,%ebx
-        movl HEAPSIZE,%eax
+		movl HEAPSIZE,%eax
         addl %ebx,%eax
         movl %eax,HEAPSIZE
         end;
@@ -1057,7 +1061,13 @@ end;
 
 {
   $Log$
-  Revision 1.7  1998-05-30 15:01:28  peter
+  Revision 1.8  1998-06-15 15:15:13  daniel
+
+
+  * Brought my policy into practive that the RTL should output only runtime
+  errors and no other texts when things go wrong.
+
+  Revision 1.7  1998/05/30 15:01:28  peter
     * this needs also direct mode :(
 
   Revision 1.6  1998/05/25 10:40:48  peter