procedure setlength(p1,p2,p3,p4);beginVarArgStart(VAList);DynArraySetLength(A, TypeInfo, DimCnt, PNativeInt(VAList));end;
procedure DynArraySetLength(A, TypeInfo, DimCnt, PNativeInt(VAList));beginp := a;newLength := lengthVec^;if newLength <= 0 thenif newLength < 0 thenError(reRangeError);_DynArrayClear(a, typeInfo);exit;oldLength := 0;if p <> nil thenDec(PByte(p), SizeOf(TDynArrayRec));oldLength := PDynArrayRec(p).Length;Inc(PByte(typeInfo), PDynArrayTypeInfo(typeInfo).name);elSize := PDynArrayTypeInfo(typeInfo).elSize;if PDynArrayTypeInfo(typeInfo).elType <> nil thenElTypeInfo := PDynArrayTypeInfo(typeInfo).elType^ElTypeInfo := nil;neededSize := newLength*elSize;if neededSize div newLength <> elSize thenError(reRangeError);Inc(neededSize, SizeOf(TDynArrayRec));if neededSize < 0 thenError(reRangeError);if (p = nil) or (PDynArrayRec(p).RefCnt = 1) thenpp := p;if (newLength < oldLength) and (ElTypeInfo <> nil) thenFinalizeArray(PByte(p) + SizeOf(TDynArrayRec) + newLength*elSize, ElTypeInfo, oldLength - newLength);ReallocMem(pp, neededSize);p := pp;GetMem(p, neededSize);minLength := oldLength;if minLength > newLength thenminLength := newLength;if ElTypeInfo <> nil thenFillChar((PByte(p) + SizeOf(TDynArrayRec))^, minLength*elSize, 0);__CopyArray(PByte(p) + SizeOf(TDynArrayRec), a, ElTypeInfo, minLength)Move(PByte(a)^, (PByte(p) + SizeOf(TDynArrayRec))^, minLength*elSize);_DynArrayClear(a, typeInfo);PDynArrayRec(p).RefCnt := 1;PDynArrayRec(p).Length := newLength;Inc(PByte(p), SizeOf(TDynArrayRec));if newLength > oldLength thenFillChar((PByte(p) + elSize * oldLength)^, elSize * (newLength - oldLength), 0);if dimCnt > 1 thenInc(lengthVec);Dec(dimCnt);i := 0;tryDynArraySetLength(PPointerArray(p)[i], ElTypeInfo, dimCnt, lengthVec);Inc(i);while i < newLength do_DynArrayClear(PPointerArray(p)[j], typeInfo);for j := 0 to i do_DynArrayClear(p, ElTypeInfo);raise;a := p;end;