[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]
> > I'm working on a program where it would be very convenient
> >to use very large 2d arrays (40X3000 elements of type real, or
> >thereabouts) Is there any way to do this in TP7?
> >
> See URL in sig, but you may need BP since you call for 720000 bytes or
> thereabouts. See also #FloatTypes.
>
{
Leopoldo Salvo Massieu. e-mail lsm@teleline.es -and-
a900040@zipi.fi.upm.es
Object Storage is a zero-based array, just tell how many elements you
want to store and what's the size in bytes of each element (use sizeof).
It can allocate all heap available (also in Protected Mode). There's a
little demo down.
}
unit ALMACEN;
interface
USES GRAPH;
const Not_enough_memory = -100;
Element_too_big = -101;
File_Not_Found = -102;
Error_Writing_File = -103;
type pointerarray = array [0..16200] of pointer;
{Zero-based array}
PStorage = ^Storage;
storage = object
private
elements_x_pointer, elem_size : word;
num_pointers, last_pointer_size : word;
data : ^pointerarray;
max : longint;
out_of_mem : boolean;
public
constructor init (num_elements : longint;
element_size : word);
destructor done;
procedure put (pos : longint; p : pointer);
procedure get (pos : longint; VAR p :
pointer);
function save (filename : string) :
integer; virtual;
function load (filename : string) :
integer; virtual;
end;
implementation
(****************************************
object storage
****************************************)
const max_allocatable_ram : word = 65528;
constructor storage.init;
var memoria : longint;
aux : longint;
pneeded : word;
i : integer;
begin
memoria:=num_elements*element_size;
elements_x_pointer:=max_allocatable_ram div element_size;
max:=num_elements;
pneeded:=(num_elements*element_size div max_allocatable_ram)+2;
if (memoria+16000>memavail) or (elements_x_pointer=0)
or (pneeded>16200) then
begin
Out_Of_Mem:=true;
Fail;
end;
getmem (data, pneeded*sizeof(pointer));
num_pointers:=0;
for i:=1 to pneeded do data^[i]:=Nil;
while num_elements>elements_x_pointer do
begin
getmem (data^[num_pointers], elements_x_pointer*element_size);
fillchar (data^[num_pointers]^,elements_x_pointer*element_size,0);
inc (num_pointers);
dec (num_elements, elements_x_pointer);
end;
if (num_elements>0) then
begin
getmem (data^[num_pointers], num_elements*element_size);
fillchar (data^[num_pointers]^, num_elements*element_size,0);
last_pointer_size:=num_elements*element_size
end
else
last_pointer_size:=elements_x_pointer*element_size;
elem_size:=element_size;
end;
destructor storage.done;
var i : longint;
begin
if num_pointers>0 then
for i:=0 to num_pointers-1 do
if data^[i]<>NIL then freemem (data^[i], elements_x_pointer*elem_size);
if data^[num_pointers]<>nil then freemem (data^[num_pointers], last_pointer_size);
if data<>NIL then freemem (data, num_pointers*sizeof(pointer));
max:=-1;
end;
procedure storage.put;
type table = array [0..65528] of byte;
var numpunt : longint;
desp : word;
begin
if (pos>=0) and (pos<max) then
begin
numpunt:=pos div elements_x_pointer;
desp:=(pos-numpunt*elements_x_pointer)*elem_size;
move (p^, table(data^[numpunt]^)[desp], elem_size);
end
else
inc(pos)
end;
procedure storage.get;
type table = array [0..65528] of byte;
var numpunt : longint;
desp : word;
begin
if (pos>=0) and (pos<max) then
begin
numpunt:=pos div elements_x_pointer;
desp:=(pos-numpunt*elements_x_pointer)*elem_size;
p:=addr(table(data^[numpunt]^)[desp]);
end
else
halt (23)
end;
function storage.save;
var f : file;
i, res : integer;
escr : word;
begin
assign (f, filename);
{$I-}
rewrite (f,1);
{$I+}
res:=ioresult;
if res=0 then
begin
{$I-}
blockwrite (f, elements_x_pointer, sizeof(elements_x_pointer));
blockwrite (f, elem_size, sizeof(elem_size));
blockwrite (f, num_pointers, sizeof(num_pointers));
blockwrite (f, last_pointer_size, sizeof(last_pointer_size));
blockwrite (f, max, sizeof(max));
{$I+}
res:=ioresult;
if res<>0 then begin save:=res; exit; end;
if num_pointers>0 then
begin
for i:=0 to num_pointers-1 do
begin
{$I-}
blockwrite (f, data^[i]^, elements_x_pointer*elem_size,escr);
{$I+}
res:=ioresult; if res<>0 then begin write ('{#',res,',',escr,'}'); break; end
end;
if res=0 then
begin
{$I-}
blockwrite (f, data^[num_pointers]^, last_pointer_size, escr);
{$I+}
res:=ioresult; if res<>0 then begin write ('{@',res,',',escr,'}'); end
end;
end;
end;
save:=res;
{$I-}
close (f);
{$I+}
res:=ioresult;
end;
function storage.load;
var f : file;
i, res : integer;
lect,exp,es,np,lps :word;
m : longint;
begin
assign (f, filename);
{$I-}
reset (f,1);
{$I+}
res:=ioresult;
if res<>0 then begin load:=res; exit; end;
{$I-}
blockread (f, exp, sizeof(elements_x_pointer));
blockread (f, es, sizeof(elem_size));
blockread (f, np, sizeof(num_pointers));
blockread (f, lps, sizeof(last_pointer_size));
blockread (f, m, sizeof(max));
{$I+}
res:=ioresult;
if res<>0 then begin load:=res; exit; end;
if ( (np>0) and (longint(exp)*(np-1)*es+lps+32000>memavail) ) or
( (np=0) and (lps+32000>memavail) ) then
begin writeln; writeln ('np: ', np, 'exp: ', exp, 'es: ', es,'
lps: ',lps); out_of_mem:=true; exit; end;
done;
elements_x_pointer:=exp; elem_size:=es; num_pointers:=np;
last_pointer_size:=lps; max:=m;
getmem (data, num_pointers*sizeof(pointer));
if num_pointers>0 then for i:=0 to num_pointers-1 do
getmem (data^[i], elements_x_pointer*elem_size);
getmem (data^[num_pointers], last_pointer_size);
out_of_mem:=false;
if num_pointers>0 then
begin
for i:=0 to num_pointers-1 do
begin
{$I-}
blockread (f, data^[i]^, elements_x_pointer*elem_size, lect);
{$I+}
res:=ioresult; if res<>0 then begin write ('{&',res,',',lect,'}'); break; end
end;
if res=0 then
begin
{$I-}
blockwrite (f, data^[num_pointers]^, last_pointer_size);
{$I+}
res:=ioresult; if res<>0 then begin write ('{&',res,',',lect,'}'); end
end;
end;
load:=res;
{$I-}
close (f);
{$I+}
res:=ioresult;
end;
end. {of unit almacen}
{and now a little demo (compile under protected mode or there will be
not enough heap}
uses almacen;
type ptipe = ^tipe;
tipe = real;
const rows : longint = 40;
columns : longint = 30000;
var store : ^storage;
y,x : longint; {y=1..40
x=1..30000}
r : tipe;
pr : ptipe;
begin
new (store, init(rows*columns, sizeof(real)));
if (store=nil) then
begin
writeln ('Out of memory.');
exit;
end;
for y:=0 to rows-1 do
for x:=0 to columns-1 do
begin
r:=y*columns+x;
store^.put(y*columns+x, @r);
end;
for y:=0 to rows-1 do
for x:=0 to columns-1 do
begin
store^.get(y*columns+x, pointer(pr));
if (pr^<>y*columns+x) then
begin
writeln ('Error... (Hopefully Impossible)');
break;
end
else write ('.');
end;
dispose (store, done);
end.
[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]