Delphi -- Compiler helper for initializing/finalizing variable

  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;
时间: 2024-11-05 21:38:05

Delphi -- Compiler helper for initializing/finalizing variable的相关文章

Delphi引用C对象文件

C语言应用非常广泛,并在世界各地拥有大量的代码库.这些代码库与Delphi的可比性较小,因此如果我们无需转换为Delphi代码而可以直接使用这些库的部分代码就完美了.幸运的是,Delphi允许连接到C编译出来的对象文件.但这里有” unsatisfied externals”问题. C is a very widely used language, and this has made the worldwide code library for C huge. The code library

最新的Delphi版本号对照

The CompilerVersion constant identifies the internal version number of the Delphi compiler. It is defined in the System unit and may be referenced either in code just as any other constant: if CompilerVersion = 20 then sCompilerName := 'Delphi 2009';

2016年 delphi roadmap

2016年delphi Roadmap 发布,这也是新公司的第一次发布路线图. 虽然稍微晚点( 原来说是1月份发布路线图),至少比过去积极点.喧嚣多年的靴子终于落地. Linux 的支持终于正式公布. http://community.embarcadero.com/article/news/16211-embarcadero-rad-studio-2016-product-approach-and-roadmap-2 整体来说,意料之中. The changes in ownership in

Why does Delphi XE7 IDE hangs and fails on out of memory exception?

引自: https://stackoverflow.com/questions/27701294/why-does-delphi-xe7-ide-hangs-and-fails-on-out-of-memory-exception Why does Delphi XE7 IDE hangs and fails on out of memory exception? [closed] Ask Question up vote10down votefavorite 5 I'm using Delph

[转载]: delphi中XLSReadWrite控件的使用(2)---delphi XE下安装

一.下载 官方下载网址: http://www.axolot.com/components/download.htm 从这里可以下载到从Delphi5到DelphiXE全部支持的版本. 二.软件安装 下载下来的文件是exe格式,可以直接安装,一路next即可. 按照默认安装,会在: C:\Documents and Settings\All Users\Documents\RAD Studio\8.0  路径下生成XLSRWII4_D2011.bpl,安装时需要使用. C:\Program Fi

DELPHI XE2 ide设置技巧

01. 修改主程序的编译输出目录:Project - Options - Delphi Compiler - Output directory02. 修改单元文件编译输出目录:Project - Options - Delphi Compiler - Unit output directory03. 禁止生成"__history"目录:Tools - Options - Editor Options - 反选"Create backup files"04. 禁止语句

VJass

JassHelper 0.A.0.0 Although World Editor&apos;s Jass compiler was finally replaced by PJass using WEHelper , there were a couple of other annoyances that still needed fixing, that&apos;s the reason this project begand. Later I felt like going furt

Extern of C——C语言extern的用法

Using extern is only of relevance when the program you're building consists of multiple source files linked together, where some of the variables defined, for example, in source file file1.c need to be referenced in other source files, such as file2.

JVMS Specification(3)-The class File Format

Subsections 3 The class File Format 3.1 The ClassFile Structure 3.2 The Internal Form of Names 3.2.1 Binary Class and Interface Names 3.2.2 Unqualified Names 3.3 Descriptors and Signatures 3.3.1 Grammar Notation 3.3.2 Field Descriptors 3.3.3 Method D