Delphi -- Compiler helper for initializing/finalizing variable

Posted 2020-08-04 ImProgrammer

  1 it CompilerhelperForInitializingFinalizingVariable;
  2 
  3 interface
  4 
  5 { Compiler helper for initializing/finalizing variable }
  6 
  7 procedure _Initialize(p : Pointer; typeInfo : Pointer);
  8 procedure _InitializeArray(p : Pointer; typeInfo : Pointer; elemCount : NativeUInt);
  9 procedure _InitializeRecord(p : Pointer; typeInfo : Pointer);
 10 
 11   {$IF not defined(X86ASMRTL)}
 12   // dcc64 generated code expects P to remain in RAX on exit from this function.
 13 function _Finalize(P : Pointer; TypeInfo : Pointer): Pointer;
 14 function _FinalizeArray(P : Pointer; TypeInfo : Pointer; ElemCount : NativeUInt): Pointer;
 15 function _FinalizeRecord(P : Pointer; TypeInfo : Pointer): Pointer;
 16   {$ELSE}
 17 procedure _Finalize(p : Pointer; typeInfo : Pointer);
 18 procedure _FinalizeArray(P : Pointer; TypeInfo : Pointer; ElemCount : NativeUInt);
 19 procedure _FinalizeRecord(P : Pointer; TypeInfo : Pointer);
 20   {$ENDIF}
 21 
 22 procedure _CopyRecord(Dest, Source, TypeInfo : Pointer);
 23 procedure _CopyObject(Dest, Source : Pointer; vmtPtrOffs : NativeInt; TypeInfo : Pointer);
 24 procedure _CopyArray(Dest, Source, TypeInfo : Pointer; Count : NativeUInt);
 25 
 26 procedure _AddRef(P : Pointer; TypeInfo : Pointer);
 27 procedure _AddRefArray(P : Pointer; TypeInfo : Pointer; ElemCount : NativeUInt);
 28 procedure _AddRefRecord(P : Pointer; TypeInfo : Pointer);
 29 
 30 function _New(Size : NativeInt; TypeInfo : Pointer): Pointer;
 31 procedure _Dispose(P : Pointer; TypeInfo : Pointer);
 32 
 33 procedure InitializeArray(p : Pointer; typeInfo : Pointer; elemCount : NativeUInt);
 34 procedure CopyArray(Dest, Source, TypeInfo : Pointer; Count : NativeInt);
 35 procedure FinalizeArray(P : Pointer; TypeInfo : Pointer; Count : NativeUInt);
 36 
 37 
 38 implementation
 39 
 40 { ===========================================================================
 41   InitializeRecord, InitializeArray, and Initialize are PIC safe even though
 42   they alter EBX because they only call each other.  They never call out to
 43   other functions and they don t access global data.
 44 
 45   FinalizeRecord, Finalize, and FinalizeArray are PIC safe because they call
 46   Pascal routines which will have EBX fixup prologs.
 47   ===========================================================================}
 48 procedure _VarClr(var v : TVarData);
 49 begin
 50   if Assigned(VarClearProc) then
 51     VarClearProc(v)
 52   else
 53     Error(reVarInvalidOp);
 54 end;
 55 
 56 procedure _VarCopy(var Dest : TVarData; const Src : TVarData);
 57 begin
 58   if Assigned(VarCopyProc) then
 59     VarCopyProc(Dest, Src)
 60   else
 61     Error(reVarInvalidOp);
 62 end;
 63 
 64 procedure _VarAddRef(var v : TVarData);
 65 begin
 66   if Assigned(VarAddRefProc) then
 67     VarAddRefProc(v)
 68   else
 69     Error(reVarInvalidOp);
 70 end;
 71 
 72 { ===========================================================================
 73   InitializeRecord, InitializeArray, and Initialize are PIC safe even though
 74   they alter EBX because they only call each other.  They never call out to
 75   other functions and they don t access global data.
 76 
 77   FinalizeRecord, Finalize, and FinalizeArray are PIC safe because they call
 78   Pascal routines which will have EBX fixup prologs.
 79   ===========================================================================}
 80       
 81 procedure _InitializeRecord(p : Pointer; typeInfo : Pointer);
 82 var
 83   FT : PFieldTable;
 84   I : Cardinal;
 85 begin
 86   FT := PFieldTable(PByte(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
 87   if FT.Count > 0 then
 88   begin
 89     for I := FT.Count - 1 downto 0 do
 90       {$IFDEF WEAKREF}
 91       if FT.Fields[I].TypeInfo <> nil then
 92         {$ENDIF}
 93         _InitializeArray(Pointer(PByte(P) + UIntPtr(FT.Fields[I].Offset)),
 94           FT.Fields[I].TypeInfo^, 1);
 95   end;
 96 end;
 97 
 98 function _FinalizeRecord(P : Pointer; TypeInfo : Pointer): Pointer;
 99 var
100   FT : PFieldTable;
101   I : Cardinal;
102   {$IFDEF WEAKREF}
103   Weak : Boolean;
104   {$ENDIF}
105 begin
106   FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
107   if FT.Count > 0 then
108   begin
109     {$IFDEF WEAKREF}
110     Weak := false;
111     {$ENDIF}
112     for I := 0 to FT.Count - 1 do
113     begin
114       {$IFDEF WEAKREF}
115       if FT.Fields[I].TypeInfo = nil then
116       begin
117         Weak := true;
118         Continue;
119       end;
120       if not Weak then
121       begin
122         {$ENDIF}
123         _FinalizeArray(Pointer(PByte(P) + IntPtr(FT.Fields[I].Offset)),
124           FT.Fields[I].TypeInfo^, 1);
125         {$IFDEF WEAKREF}
126       end 
127       else
128       begin
129         case FT.Fields[I].TypeInfo^.Kind of
130           {$IFDEF WEAKINTFREF}
131           tkInterface: 
132             _IntfWeakClear(IInterface(Pointer(PByte(P) +
133               IntPtr(FT.Fields[I].Offset))^));
134           {$ENDIF}
135           {$IFDEF WEAKINSTREF}
136           tkClass: 
137             _InstWeakClear(TObject(Pointer(PByte(P) + IntPtr(FT.Fields[I].Offset))^));
138           {$ENDIF}
139           {$IFDEF WEAKREF}
140           tkMethod: 
141             _ClosureRemoveWeakRef(TMethod(Pointer(PByte(P) +
142               IntPtr(FT.Fields[I].Offset))^));
143           {$ENDIF}
144           else
145             Error(reInvalidPtr);
146         end;
147       end;
148       {$ENDIF}
149     end;
150   end;
151   Result := P;
152 end;
153 
154 procedure _InitializeArray(p : Pointer; typeInfo : Pointer; elemCount : NativeUInt);
155 var
156   FT : PFieldTable;
157   I : Cardinal;
158 begin
159   if elemCount = 0 then 
160     Exit;
161   case PTypeInfo(typeInfo).Kind of
162     {$IFDEF WEAKREF}
163     tkMethod:
164       while elemCount > 0 do
165       begin
166         TMethod(P^).Data := nil;
167         TMethod(P^).Code := nil;
168         Inc(PByte(P), SizeOf(TMethod));
169         Dec(elemCount);
170       end;
171     {$ENDIF}
172     {$IFDEF AUTOREFCOUNT}
173     tkClass,
174     {$ENDIF}
175     tkLString, tkWString, tkInterface, tkDynArray, tkUString:
176       while elemCount > 0 do
177       begin
178         PPointer(P)^ := nil;
179         Inc(PByte(P), SizeOf(Pointer));
180         Dec(elemCount);
181       end;
182     tkVariant:
183       while elemCount > 0 do
184       begin
185         with PVarData(P)^ do
186           for I := Low(RawData) to High(RawData) do 
187             RawData[I] := 0;
188         Inc(PByte(P), SizeOf(TVarData));
189         Dec(elemCount);
190       end;
191     tkArray:
192       begin
193         FT := PFieldTable(PByte(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
194         while elemCount > 0 do
195         begin
196           _InitializeArray(P, FT.Fields[0].TypeInfo^, FT.Count);
197           Inc(PByte(P), FT.Size);
198           Dec(elemCount);
199         end;
200       end;
201     tkRecord:
202       begin
203         FT := PFieldTable(PByte(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
204         while elemCount > 0 do
205         begin
206           _InitializeRecord(P, typeInfo);
207           Inc(PByte(P), FT.Size);
208           Dec(elemCount);
209         end;
210       end;
211     else
212       Error(reInvalidPtr);
213   end;
214 end;
215 
216 function _FinalizeArray(P : Pointer; TypeInfo : Pointer; ElemCount : NativeUInt): Pointer;
217 var
218   FT : PFieldTable;
219 begin
220   Result := P;
221   if ElemCount = 0 then 
222     Exit;
223   case PTypeInfo(TypeInfo).Kind of
224     {$IFDEF WEAKREF}
225     tkMethod:
226       while ElemCount > 0 do
227       begin
228         _ClosureRemoveWeakRef(TMethod(P^));
229         Inc(PByte(P), SizeOf(TMethod));
230         Dec(ElemCount);
231       end;
232     {$ENDIF}
233     {$IFDEF AUTOREFCOUNT}
234     tkClass:
235       while ElemCount > 0 do
236       begin
237         _InstClear(TObject(P^));
238         Inc(PByte(P), SizeOf(Pointer));
239         Dec(ElemCount);
240       end;
241     {$ENDIF}
242     tkLString: 
243       _LStrArrayClr(P^, ElemCount);
244     tkWString: 
245       _WStrArrayClr(P^, ElemCount);
246     tkUString: 
247       _UStrArrayClr(P^, ElemCount);
248     tkVariant:
249       while ElemCount > 0 do
250       begin
251         _VarClr(PVarData(P)^);
252         Inc(PByte(P), SizeOf(TVarData));
253         Dec(ElemCount);
254       end;
255     tkArray:
256       begin
257         FT := PFieldTable(PByte(typeInfo) + Byte(PTypeInfo(typeInfo).Name[0]));
258         while ElemCount > 0 do
259         begin
260           _FinalizeArray(P, FT.Fields[0].TypeInfo^, FT.Count);
261           Inc(PByte(P), FT.Size);
262           Dec(ElemCount);
263         end;
264       end;
265     tkRecord:
266       begin
267         FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
268         while ElemCount > 0 do
269         begin
270           _FinalizeRecord(P, TypeInfo);
271           Inc(PByte(P), FT.Size);
272           Dec(ElemCount);
273         end;
274       end;
275     tkInterface:
276       while ElemCount > 0 do
277       begin
278         _IntfClear(IInterface(P^));
279         Inc(PByte(P), SizeOf(Pointer));
280         Dec(ElemCount);
281       end;
282     tkDynArray:
283       while ElemCount > 0 do
284       begin
285         { The cast and dereference of P here is to fake out the call to
286           _DynArrayClear.  That function expects a var parameter.  Our
287           declaration says we got a non-var parameter, but because of
288           the data type that got passed to us (tkDynArray), this isn t
289           strictly true.  The compiler will have passed us a reference. }
290         _DynArrayClear(PPointer(P)^, typeInfo);
291         Inc(PByte(P), SizeOf(Pointer));
292         Dec(ElemCount);
293       end;
294     else
295       Error(reInvalidPtr);
296   end;
297 end;
298 
299 procedure _AddRefRecord(P : Pointer; TypeInfo : Pointer);
300 var
301   FT : PFieldTable;
302   I : Cardinal;
303 begin
304   FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
305   if FT.Count > 0 then
306   begin
307     for I := 0 to FT.Count - 1 do
308     begin
309       {$IFDEF WEAKREF}
310       // Check for the sentinal indicating the following fields are weak references
311       // which don t need to be reference counted
312       if FT.Fields[I].TypeInfo = nil then
313         Break;
314       {$ENDIF}
315       _AddRefArray(Pointer(PByte(P) + UIntPtr(FT.Fields[I].Offset)),
316         FT.Fields[I].TypeInfo^, 1);
317     end;
318   end;
319 end;
320 
321 procedure _AddRefArray(P : Pointer; TypeInfo : Pointer; ElemCount : NativeUInt);
322 var
323   FT : PFieldTable;
324 begin
325   if ElemCount = 0 then 
326     Exit;
327   case PTypeInfo(TypeInfo).Kind of
328     {$IFDEF WEAKREF}
329     tkMethod:
330       while ElemCount > 0 do
331       begin
332         _ClosureAddWeakRef(TMethod(P^));
333         Inc(PByte(P), SizeOf(TMethod));
334         Dec(ElemCount);
335       end;
336     {$ENDIF}
337     {$IFDEF AUTOREFCOUNT}
338     tkClass:
339       while ElemCount > 0 do
340       begin
341         _InstAddRef(TObject(P^));
342         Inc(PByte(P), SizeOf(Pointer));
343         Dec(ElemCount);
344       end;
345     {$ENDIF}
346     tkLString:
347       while ElemCount > 0 do
348       begin
349         _LStrAddRef(PPointer(P)^);
350         Inc(PByte(P), SizeOf(Pointer));
351         Dec(ElemCount);
352       end;
353     tkWString:
354       while ElemCount > 0 do
355       begin
356         {$IFDEF MSWINDOWS}
357         _WStrAddRef(PWideString(P)^);
358         {$ELSE}
359         _WStrAddRef(PPointer(P)^);
360         {$ENDIF}
361         Inc(PByte(P), SizeOf(Pointer));
362         Dec(ElemCount);
363       end;
364     tkUString:
365       while ElemCount > 0 do
366       begin
367         _UStrAddRef(PPointer(P)^);
368         Inc(PByte(P), SizeOf(Pointer));
369         Dec(ElemCount);
370       end;
371     tkVariant:
372       while ElemCount > 0 do
373       begin
374         _VarAddRef(PVarData(P)^);
375         Inc(PByte(P), SizeOf(TVarData));
376         Dec(ElemCount);
377       end;
378     tkArray:
379       begin
380         FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
381         while ElemCount > 0 do
382         begin
383           _AddRefArray(P, FT.Fields[0].TypeInfo^, FT.Count);
384           Inc(PByte(P), FT.Size);
385           Dec(ElemCount);
386         end;
387       end;
388     tkRecord:
389       begin
390         FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
391         while ElemCount > 0 do
392         begin
393           _AddRefRecord(P, TypeInfo);
394           Inc(PByte(P), FT.Size);
395           Dec(ElemCount);
396         end;
397       end;
398     tkInterface:
399       while ElemCount > 0 do
400       begin
401         _IntfAddRef(IInterface(P^));
402         Inc(PByte(P), SizeOf(Pointer));
403         Dec(ElemCount);
404       end;
405     tkDynArray:
406       while ElemCount > 0 do
407       begin
408         _DynArrayAddRef(PPointer(P)^);
409         Inc(PByte(P), SizeOf(Pointer));
410         Dec(ElemCount);
411       end;
412     else
413       Error(reInvalidPtr);
414   end;
415 end;
416 
417 procedure _AddRef(P : Pointer; TypeInfo : Pointer);
418 begin
419   _AddRefArray(P, TypeInfo, 1);
420 end;
421 
422 procedure _CopyRecord(Dest, Source, TypeInfo : Pointer);
423 var
424   FT, EFT : PFieldTable;
425   I, Count, L : Cardinal;
426   {$IFDEF WEAKREF}
427   J, K : Cardinal;
428   {$ENDIF}
429   Offset : UIntPtr;
430   FTypeInfo : PTypeInfo;
431   DestOff, SrcOff : Pointer;
432 begin
433   FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
434   Offset := 0;
435   if FT.Count > 0 then
436   begin
437     Count := FT.Count;
438     {$IFDEF WEAKREF}
439     J := 0;
440     K := Count;
441     for I := Count - 1 downto 0 do
442       if FT.Fields[I].TypeInfo = nil then
443       begin
444         K := I + 1; // found the weak sentinal
445         Dec(Count); // remove the sentinal from consideration
446         Break;
447       end;
448     {$ENDIF}
449     for L := 0 to Count - 1 do
450     begin
451       {$IFDEF WEAKREF}
452       if (FT.Fields[J].TypeInfo <> nil) and
453         ((K = FT.Count) or (FT.Fields[J].Offset < FT.Fields[K].Offset)) then
454       begin
455         I := J;
456         Inc(J);
457       end 
458       else
459       begin
460         I := K;
461         Inc(K);
462       end;
463       {$ELSE}
464       I := L;
465       {$ENDIF}
466       if FT.Fields[I].Offset > Offset then
467         Move(Pointer(PByte(Source) + Offset)^,
468           Pointer(PByte(Dest) + Offset)^,
469           FT.Fields[I].Offset - Offset);
470       Offset := FT.Fields[I].Offset;
471       FTypeInfo := FT.Fields[I].TypeInfo^;
472       DestOff := Pointer(PByte(Dest) + Offset);
473       SrcOff := Pointer(PByte(Source) + Offset);
474       case FTypeInfo.Kind of
475         {$IFDEF WEAKREF}
476         tkMethod:
477           begin
478             _CopyClosure(PMethod(DestOff)^, PMethod(SrcOff)^);
479             Inc(Offset, SizeOf(TMethod));
480           end;
481         {$ENDIF}
482         {$IFDEF AUTOREFCOUNT}
483         tkClass:
484           begin
485             {$IFDEF WEAKINSTREF}
486             if I > J then
487               _InstWeakCopy(TObject(PPointer(DestOff)^),
488                 TObject(PPointer(SrcOff)^))
489             else
490               {$ENDIF}
491               _InstCopy(TObject(PPointer(DestOff)^), TObject(PPointer(SrcOff)^));
492             Inc(Offset, SizeOf(Pointer));
493           end;
494         {$ENDIF}
495         tkLString:
496           begin
497             _LStrAsg(_PAnsiStr(DestOff)^, _PAnsiStr(SrcOff)^);
498             Inc(Offset, SizeOf(Pointer));
499           end;
500         tkWString:
501           begin
502             _WStrAsg(_PWideStr(DestOff)^, _PWideStr(SrcOff)^);
503             Inc(Offset, SizeOf(Pointer));
504           end;
505         tkUString:
506           begin
507             _UStrAsg(PUnicodeString(DestOff)^, PUnicodeString(SrcOff)^);
508             Inc(Offset, SizeOf(Pointer));
509           end;
510         tkVariant:
511           begin
512             _VarCopy(PVarData(DestOff)^, PVarData(SrcOff)^);
513             Inc(Offset, SizeOf(TVarData));
514           end;
515         tkArray:
516           begin
517             EFT :=
518               PFieldTable(PByte(FTypeInfo) + Byte(PTypeInfo(FTypeInfo).Name[0]));
519             _CopyArray(DestOff, SrcOff, EFT.Fields[0].TypeInfo^, EFT.Count);
520             Inc(Offset, EFT.Size);
521           end;
522         tkRecord:
523           begin
524             EFT :=
525               PFieldTable(PByte(FTypeInfo) + Byte(PTypeInfo(FTypeInfo).Name[0]));
526             _CopyRecord(DestOff, SrcOff, FTypeInfo);
527 
528             Inc(Offset, EFT.Size);
529           end;
530         tkInterface:
531           begin
532             {$IFDEF WEAKINTFREF}
533             if I > J then
534               _IntfWeakCopy(IInterface(PPointer(DestOff)^),
535                 IInterface(PPointer(SrcOff)^))
536             else
537               {$ENDIF}
538               _IntfCopy(IInterface(PPointer(DestOff)^),
539                 IInterface(PPointer(SrcOff)^));
540             Inc(Offset, SizeOf(Pointer));
541           end;
542         tkDynArray:
543           begin
544             _DynArrayAsg(PPointer(DestOff)^, PPointer(SrcOff)^, FTypeInfo);
545             Inc(Offset, SizeOf(Pointer));
546           end;
547         else
548           Error(reInvalidPtr);
549       end;
550     end;
551   end;
552   if FT.Size > Offset then
553     Move(Pointer(PByte(Source) + Offset)^,
554       Pointer(PByte(Dest) + Offset)^,
555       FT.Size - Offset);
556 end;
557 
558 procedure _CopyObject(Dest, Source : Pointer; vmtPtrOffs : NativeInt; TypeInfo : Pointer);
559 var
560   SavedVmtPtr : Pointer;
561 begin
562   SavedVmtPtr := PPointer(PByte(Dest) + vmtPtrOffs)^;
563   _CopyRecord(Dest, Source, TypeInfo);
564   PPointer(PByte(Dest) + vmtPtrOffs)^ := SavedVmtPtr;
565 end;
566 
567 procedure _CopyArray(Dest, Source, TypeInfo : Pointer; Count : NativeUInt);
568 var
569   FT : PFieldTable;
570 begin
571   if Count = 0 then 
572     Exit;
573   case PTypeInfo(TypeInfo).Kind of
574     {$IFDEF WEAKREF}
575     tkMethod:
576       while Count > 0 do
577       begin
578         _CopyClosure(PMethod(Dest)^, PMethod(Source)^);
579         Inc(PByte(Dest), SizeOf(TMethod));
580         Inc(PByte(Source), SizeOf(TMethod));
581         Dec(Count);
582       end;
583     {$ENDIF}
584     {$IFDEF AUTOREFCOUNT}
585     tkClass:
586       while Count > 0 do
587       begin
588         _InstCopy(TObject(PPointer(Dest)^), TObject(PPointer(Source)^));
589         Inc(PByte(Dest), SizeOf(Pointer));
590         Inc(PByte(Source), SizeOf(Pointer));
591         Dec(Count);
592       end;
593     {$ENDIF}
594     tkLString:
595       while Count > 0 do
596       begin
597         _LStrAsg(_PAnsiStr(Dest)^, _PAnsiStr(Source)^);
598         Inc(PByte(Dest), SizeOf(Pointer));
599         Inc(PByte(Source), SizeOf(Pointer));
600         Dec(Count);
601       end;
602     tkWString:
603       while Count > 0 do
604       begin
605         _WStrAsg(_PWideStr(Dest)^, _PWideStr(Source)^);
606         Inc(PByte(Dest), SizeOf(Pointer));
607         Inc(PByte(Source), SizeOf(Pointer));
608         Dec(Count);
609       end;
610     tkUString:
611       while Count > 0 do
612       begin
613         _UStrAsg(PUnicodeString(Dest)^, PUnicodeString(Source)^);
614         Inc(PByte(Dest), SizeOf(Pointer));
615         Inc(PByte(Source), SizeOf(Pointer));
616         Dec(Count);
617       end;
618     tkVariant:
619       while Count > 0 do
620       begin
621         _VarCopy(PVarData(Dest)^, PVarData(Source)^);
622         Inc(PByte(Dest), SizeOf(TVarData));
623         Inc(PByte(Source), SizeOf(TVarData));
624         Dec(Count);
625       end;
626     tkArray:
627       begin
628         FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
629         while Count > 0 do
630         begin
631           _CopyArray(Pointer(Dest), Pointer(Source),
632             FT.Fields[0].TypeInfo^, FT.Count);
633           Inc(PByte(Dest), FT.Size);
634           Inc(PByte(Source), FT.Size);
635           Dec(Count);
636         end;
637       end;
638     tkRecord:
639       begin
640         FT := PFieldTable(PByte(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));
641         while Count > 0 do
642         begin
643           _CopyRecord(Dest, Source, TypeInfo);
644           Inc(PByte(Dest), FT.Size);
645           Inc(PByte(Source), FT.Size);
646           Dec(Count);
647         end;
648       end;
649     tkInterface:
650       while Count > 0 do
651       begin
652         _IntfCopy(IInterface(PPointer(Dest)^), IInterface(PPointer(Source)^));
653         Inc(PByte(Dest), SizeOf(Pointer));
654         Inc(PByte(Source), SizeOf(Pointer));
655         Dec(Count);
656       end;
657     tkDynArray:
658       while Count > 0 do
659       begin
660         _DynArrayAsg(PPointer(Dest)^, PPointer(Source)^, TypeInfo);
661         Inc(PByte(Dest), SizeOf(Pointer));
662         Inc(PByte(Source), SizeOf(Pointer));
663         Dec(Count);
664       end;
665     else
666       Error(reInvalidPtr);
667   end;
668 end;
669 
670 procedure CopyArray(Dest, Source, TypeInfo : Pointer; Count : NativeInt);
671 begin
672   if Count > 0 then
673     _CopyArray(Dest, Source, TypeInfo, Count);
674 end;
675 
676 procedure InitializeArray(p : Pointer; typeInfo : Pointer; elemCount : NativeUInt);
677 begin
678   _InitializeArray(p, typeInfo, elemCount);
679 end;
680 
681 procedure FinalizeArray(P, TypeInfo : Pointer; Count : NativeUInt);
682 begin
683   _FinalizeArray(P, TypeInfo, Count);
684 end;
685 
686 procedure _Initialize(p : Pointer; typeInfo : Pointer);
687 begin
688   _InitializeArray(p, typeInfo, 1);
689 end;
690 
691 function _Finalize(p : Pointer; typeInfo : Pointer): Pointer;
692 begin
693   Result := _FinalizeArray(p, typeInfo, 1);
694 end;
695 
696 function _New(Size : NativeInt; TypeInfo : Pointer): Pointer;
697 begin
698   GetMem(Result, Size);
699   if Result <> nil then
700     _Initialize(Result, TypeInfo);
701 end;
702 
703 procedure _Dispose(P : Pointer; TypeInfo : Pointer);
704 begin
705   _Finalize(P, TypeInfo);
706   FreeMem(P);
707 end;