From: abuse@telia.com   
      
   > Is it *guaranteed* that Turbo Pascal 7 allocates memory blocks   
   > contiguously?   
      
       Unfortunately not. So you'd better add some code to check the   
   integrity of your memory space. For what it's worth, below you have my   
   unit for allocating contiguous heap space. At the bottom there's a small   
   test program for the unit.   
      
      
   {$G+} (* It even needs a 386 or better... *)   
   unit LArrUnit;   
   (*  A unit to handle large arrays in TurboPascal   
        By Björn Felten @ 2:203/208, 1991, 1994 *)   
      
   interface   
      
   const ArrSize  = 100000;   
      
   type  ArrItem  = longint;   
          ItemPtr  = ^ArrItem;   
      
   function BigArray(ItemNo:longint):ItemPtr;   
      
   implementation   
      
   const ItemSize = sizeof(ArrItem);   
      
   var   AddressBase:record   
                      P:ItemPtr;   
                      Size:longint   
                     end;   
      
   procedure Error(S:string; N:word);   
   begin writeln(S); halt(N) end;   
      
   function BigArray;assembler;   
   asm   
   db $66; mov  ax,word ptr ItemNo   
   db $66; xor  cx,cx   
            mov  cx,ItemSize   
   db $66; mul  cx   
            mov  cx,ax   
   db $66; shr  ax,4   
            les  dx,AddressBase.P   
            mov  bx,es   
            add  ax,bx   
            and  cx,15   
            add  dx,cx   
            xchg ax,dx   
   end;   
      
   function InitArray(NumItems:longint):integer;   
   var TotalSize:longint;   
        Num32KSeg,SegCounter:word;   
        Dummy,LastCheckPtr:pointer;   
   begin   
      TotalSize:=NumItems*sizeof(ArrItem); (* Number of bytes required *)   
      if MaxAvail0 then   
        HeapPtr:=ptr(seg(HeapPtr^)+1,0);   (* Push HeapPtr to Seg Bound *)   
      with AddressBase do begin   
        P:=HeapPtr;                        (* Now take the HeapPtr as BASE *)   
        Size:=NumItems;                    (* Set top index too *)   
        if Num32KSeg<>0 then begin         (* Do All 32K segs *)   
          for SegCounter:=1 to Num32KSeg do begin   
            getmem(Dummy,$8000);   
            (* Check if we're still contigous *)   
            if seg(heapptr^)<>((SegCounter shl 11)+seg(P^)) then begin   
              InitArray:=2; exit end;   
          end   
        end;   
      end;   
      LastCheckPtr:=heapptr; 		(* Save current position *)   
      getmem(Dummy,word(TotalSize)); 	(* Get the rest *)   
              (* Only segs need check *)   
      if seg(Dummy^)<>seg(LastCheckPtr^) then InitArray:=2 else InitArray:=0   
   end;   
      
   begin   
      case InitArray(ArrSize) of   
      1:  Error('Not enough memory to allocate array.',1);   
      2:  Error('Unable to make array contigous.',2);   
      end   
   end.   
      
      
      
   And here's the test program:   
      
   uses LArrUnit;   
      
   (* Here's a test program for LArrUnit.   
       NB! It will only work with ArrItem of type longint   
       because of the simple kind of testing.   
       The size of the array in this demo is 400000 bytes. *)   
      
   var L:longint;   
   begin   
      writeln('Filling array with numbers...');   
      for L:=0 to ArrSize-1 do begin   
        if (L and $3ff)=0 then write(L,#13);   
        BigArray(L)^:=L   
      end;   
      writeln;   
      writeln('Testing array integrity...');   
      for L:=0 to ArrSize-1 do begin   
        if (L and $3ff)=0 then write(L,#13);   
        if BigArray(L)^<>L then begin   
          writeln('Corrupted array at offset ',L);   
          halt   
        end   
      end   
   end.   
      
      
      
      
   --   
     FidoNet in your news reader:    news://felten.yi.org   
     For full access, register at:   http://felten.yi.org/join.html   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)