Mathias hat geschrieben:
Hiermit erzeugst du einen neune Speicherbereich für die 2. Array.
Aber ich kopiere mit a2 := a; nur den Zeiger.
Oder würde dort noch ein FreeMem hingehören.
Code: Alles auswählen
procedure SetLength(var a: TIntArr; const len: Integer);
var tmp: TIntArr;
begin
GetMem(tmp, len*SizeOf(Integer));
Move(a[0], tmp[0], min(len, Length(a));
FreeMem(a, len*SizeOf(Integer));
a := tmp;
end;
Mein Ziel war es nicht eine Korrekte Prozedur zu schreiben, ich wollte es nur veranschaulichen. Dynamische Arrays in Pascal sind Referenzgezählt weswegen mein Beispiel eine extrem obersimplifizierte version darstellet, und Praktisch so auch nicht funktioniert. Mit dem Freemem zum Beispiel würde dir der Zugriff auf a dann um die Ohren fliegen.
Wenn es dich genau interessiert, die Definition eines Dynamischen Arrays lässt sich in der dynarr.inc nachlesen und lautet:
Code: Alles auswählen
pdynarray = ^tdynarray;
tdynarray = packed record
refcount : ptrint;
high : tdynarrayindex;
end;
Der Erstellung ist dann etwa so (Wieder obersimplifizierter Pseudocode):
Code: Alles auswählen
GetMem(tmp, SizeOf(tdynarray) + ElementCount*TypeSize);
pdynarray(tmp)^.refcount := 1;
pdynarray(tmp)^.high := ElementCount*TypeSize;
inc(tmp, SizeOf(tdynarray));
a := tmp;
Der Zuweisungsoperator (:=) ist dann etwa so etwas:
Code: Alles auswählen
if assigned(a1) then
begin
dec(pdynarray(IntPtr(a1)-SizeOf(tdynarray))^.refcount); // alte referenz reduzieren
if pdynarray(IntPtr(a1)-SizeOf(tdynarray))^.refcount = 0 then // alten array free-en falls referenzcounter = 0
begin
dec(a1, sizeOf(tdynarray));
Freemem(a1, sizeOf(tdynarray)+ pdynarray(a1)^.heigh);
end;
end;
Move(a2, a1, SizeOf(Pointer)); // zuweisen
inc(pdynarray(IntPtr(a1)-SizeOf(tdynarray))^.refcount); // neuen ref counter erhöhen
Aber das ist wie gesagt alles nur so pseudocode, der auch zum einen nicht ganz korrekt ist, zum anderen aber auch extrem vereinfacht ist, die genaue SetLength Prozedur aus der dynarr.inc ist wie folgt:
Code: Alles auswählen
procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
dimcount : dword;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARR_SETLENGTH']; compilerproc;
var
i : tdynarrayindex;
movelen,
size : sizeint;
{ contains the "fixed" pointers where the refcount }
{ and high are at positive offsets }
realp,newp : pdynarray;
ti : pdynarraytypeinfo;
updatep: boolean;
elesize : sizeint;
eletype : pdynarraytypeinfo;
begin
ti:=pdynarraytypeinfo(pti);
{ skip kind and name }
inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);
ti:=aligntoptr(ti);
elesize:=psizeint(ti)^;
eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
{ determine new memory size }
{ dims[dimcount-1] because the dimensions are in reverse order! (JM) }
size:=elesize*dims[dimcount-1]+sizeof(tdynarray);
updatep := false;
{ not assigned yet? }
if not(assigned(p)) then
begin
if dims[dimcount-1]<0 then
HandleErrorFrame(201,get_frame);
{ do we have to allocate memory? }
if dims[dimcount-1] = 0 then
exit;
getmem(newp,size);
fillchar(newp^,size,0);
updatep := true;
end
else
begin
realp:=pdynarray(p-sizeof(tdynarray));
newp := realp;
{ if the new dimension is 0, we've to release all data }
if dims[dimcount-1]<=0 then
begin
if dims[dimcount-1]<0 then
HandleErrorFrame(201,get_frame);
if declocked(realp^.refcount) then
fpc_dynarray_clear_internal(realp,pdynarraytypeinfo(pti));
p:=nil;
exit;
end;
if realp^.refcount<>1 then
begin
updatep := true;
{ make an unique copy }
getmem(newp,size);
fillchar(newp^,size,0);
if realp^.high < dims[dimcount-1] then
movelen := realp^.high+1
else
movelen := dims[dimcount-1];
move(p^,(pointer(newp)+sizeof(tdynarray))^,elesize*movelen);
{ increment ref. count of members }
for i:= 0 to movelen-1 do
int_addref(pointer(newp)+sizeof(tdynarray)+elesize*i,eletype);
{ a declock(ref. count) isn't enough here }
{ it could be that the in MT environments }
{ in the mean time the refcount was }
{ decremented }
{ it is, because it doesn't really matter }
{ if the array is now removed }
{ fpc_dynarray_decr_ref(p,ti); }
if declocked(realp^.refcount) then
fpc_dynarray_clear_internal(realp,pdynarraytypeinfo(ti));
end
else if dims[dimcount-1]<>realp^.high+1 then
begin
{ range checking is quite difficult ... }
{ if size overflows then it is less than }
{ the values it was calculated from }
if (size<sizeof(tdynarray)) or
((elesize>0) and (size<elesize)) then
HandleErrorFrame(201,get_frame);
{ resize? }
{ here, realp^.refcount has to be one, otherwise the previous }
{ if-statement would have been taken. Or is this also for MT }
{ code? (JM) }
if realp^.refcount=1 then
begin
{ shrink the array? }
if dims[dimcount-1]<realp^.high+1 then
begin
int_finalizearray(pointer(realp)+sizeof(tdynarray)+
elesize*dims[dimcount-1],
eletype,realp^.high-dims[dimcount-1]+1);
reallocmem(realp,size);
end
else if dims[dimcount-1]>realp^.high+1 then
begin
reallocmem(realp,size);
fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
(dims[dimcount-1]-realp^.high-1)*elesize,0);
end;
newp := realp;
updatep := true;
end;
end;
end;
{ handle nested arrays }
if dimcount>1 then
begin
for i:=0 to dims[dimcount-1]-1 do
int_dynarray_setlength(pointer((pointer(newp)+sizeof(tdynarray)+i*elesize)^),
eletype,dimcount-1,dims);
end;
if updatep then
begin
p:=pointer(newp)+sizeof(tdynarray);
newp^.refcount:=1;
newp^.high:=dims[dimcount-1]-1;
end;
end;
Verein
Links
Suche