genrtti.inc 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by xxxx
  5. member of the Free Pascal development team
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. { Run-Time type information routines - processor dependent part }
  13. {$ifndef FPC_SYSTEM_HAS_FPC_INITIALIZE}
  14. Procedure fpc_Initialize (Data,TypeInfo : pointer);saveregisters;[Public,Alias : 'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
  15. { this definition is sometimes (depending on switches)
  16. already defined or not so define it locally to avoid problems PM }
  17. Type
  18. Pbyte = ^Byte;
  19. Var Temp : PByte;
  20. I : longint;
  21. Size,Count : longint;
  22. TInfo : Pointer;
  23. begin
  24. Temp:=PByte(TypeInfo);
  25. case temp^ of
  26. tkAstring,tkWstring : PPchar(Data)^:=Nil;
  27. tkArray :
  28. begin
  29. temp:=Temp+1;
  30. I:=temp^;
  31. temp:=temp+(I+1); // skip name string;
  32. Size:=PArrayRec(Temp)^.Size; // get element size
  33. Count:=PArrayRec(Temp)^.Count; // get element Count
  34. TInfo:=PArrayRec(Temp)^.Info; // Get element info
  35. For I:=0 to Count-1 do
  36. int_Initialize (Data+(I*size),TInfo);
  37. end;
  38. tkrecord :
  39. begin
  40. Temp:=Temp+1;
  41. I:=Temp^;
  42. temp:=temp+(I+1); // skip name string;
  43. Size:=PRecRec(Temp)^.Size; // get record size; not needed.
  44. Count:=PRecRec(Temp)^.Count; // get element Count
  45. For I:=1 to count Do
  46. With PRecRec(Temp)^.elements[I] do
  47. int_Initialize (Data+Offset,Info);
  48. end;
  49. tkVariant:
  50. variant_init(Variant(PVarData(Data)^))
  51. end;
  52. end;
  53. {$endif}
  54. {$ifndef FPC_SYSTEM_HAS_FPC_FINALIZE}
  55. Procedure fpc_Finalize (Data,TypeInfo: Pointer);saveregisters;[Public,Alias : 'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
  56. { this definition is sometimes (depending on switches)
  57. already defined or not so define it locally to avoid problems PM }
  58. Type
  59. Pbyte = ^Byte;
  60. Var Temp : PByte;
  61. I : longint;
  62. Size,Count : longint;
  63. TInfo : Pointer;
  64. begin
  65. Temp:=PByte(TypeInfo);
  66. case temp^ of
  67. tkAstring,tkWstring : fpc_AnsiStr_Decr_Ref(Data);
  68. tkArray :
  69. begin
  70. Temp:=Temp+1;
  71. I:=temp^;
  72. temp:=temp+(I+1); // skip name string;
  73. Size:=PArrayRec(Temp)^.Size; // get element size
  74. Count:=PArrayRec(Temp)^.Count; // get element Count
  75. TInfo:=PArrayRec(Temp)^.Info; // Get element info
  76. For I:=0 to Count-1 do
  77. int_Finalize (Data+(I*size),TInfo);
  78. end;
  79. tkrecord :
  80. begin
  81. Temp:=Temp+1;
  82. I:=Temp^;
  83. temp:=temp+(I+1); // skip name string;
  84. Size:=PRecRec(Temp)^.Size; // get record size; not needed.
  85. Count:=PRecRec(Temp)^.Count; // get element Count
  86. For I:=1 to count do
  87. With PRecRec(Temp)^.elements[I] do
  88. int_Finalize (Data+Offset,Info);
  89. end;
  90. tkVariant:
  91. variant_clear(Variant(PVarData(Data)^))
  92. end;
  93. end;
  94. {$endif}
  95. {$ifndef FPC_SYSTEM_HAS_FPC_ADDREF}
  96. Procedure fpc_Addref (Data,TypeInfo : Pointer);saveregisters; [Public,alias : 'FPC_ADDREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
  97. { this definition is sometimes (depending on switches)
  98. already defined or not so define it locally to avoid problems PM }
  99. Type
  100. Pbyte = ^Byte;
  101. PPointer = ^Pointer;
  102. Var Temp : PByte;
  103. I : longint;
  104. Size,Count : longint;
  105. TInfo : Pointer;
  106. begin
  107. Temp:=PByte(TypeInfo);
  108. case temp^ of
  109. { In case of an ansistring, data is pushed as a var parameter. }
  110. { This means that if you look at data as a value parameter, it }
  111. { containst the address of the ansistring. AnsiStr_Incr_Ref also }
  112. { expects a var parameter, so to pass the address of the }
  113. { ansistring and not that of the data parameter on the stack, }
  114. { you have to dereference data (JM) }
  115. tkAstring,tkWstring : fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
  116. tkArray :
  117. begin
  118. Temp:=Temp+1;
  119. I:=temp^;
  120. temp:=temp+(I+1); // skip name string;
  121. Size:=PArrayRec(Temp)^.Size; // get element size
  122. Count:=PArrayRec(Temp)^.Count; // get element Count
  123. TInfo:=PArrayRec(Temp)^.Info; // Get element info
  124. For I:=0 to Count-1 do
  125. int_AddRef (Data+(I*size),TInfo);
  126. end;
  127. tkrecord :
  128. begin
  129. Temp:=Temp+1;
  130. I:=Temp^;
  131. temp:=temp+(I+1); // skip name string;
  132. Size:=PRecRec(Temp)^.Size; // get record size; not needed.
  133. Count:=PRecRec(Temp)^.Count; // get element Count
  134. For I:=1 to count do
  135. With PRecRec(Temp)^.elements[I] do
  136. int_AddRef (Data+Offset,Info);
  137. end;
  138. end;
  139. end;
  140. {$endif}
  141. {$ifndef FPC_SYSTEM_HAS_FPC_DECREF}
  142. Procedure fpc_DecRef (Data, TypeInfo : Pointer);saveregisters;[Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
  143. { this definition is sometimes (depending on switches)
  144. already defined or not so define it locally to avoid problems PM }
  145. Type
  146. Pbyte = ^Byte;
  147. PPointer = ^Pointer;
  148. Var Temp : PByte;
  149. I : longint;
  150. Size,Count : longint;
  151. TInfo : Pointer;
  152. begin
  153. Temp:=PByte(TypeInfo);
  154. case temp^ of
  155. { see AddRef for comment about below construct (JM) }
  156. tkAstring,tkWstring : fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
  157. tkArray :
  158. begin
  159. Temp:=Temp+1;
  160. I:=temp^;
  161. temp:=temp+(I+1); // skip name string;
  162. Size:=PArrayRec(Temp)^.Size; // get element size
  163. Count:=PArrayRec(Temp)^.Count; // get element Count
  164. TInfo:=PArrayRec(Temp)^.Info; // Get element info
  165. For I:=0 to Count-1 do
  166. fpc_DecRef (Data+(I*size),TInfo);
  167. end;
  168. tkrecord :
  169. begin
  170. Temp:=Temp+1;
  171. I:=Temp^;
  172. temp:=temp+(I+1); // skip name string;
  173. Size:=PRecRec(Temp)^.Size; // get record size; not needed.
  174. Count:=PRecRec(Temp)^.Count; // get element Count
  175. For I:=1 to count do
  176. With PRecRec(Temp)^.elements[I] do
  177. fpc_DecRef (Data+Offset,Info);
  178. end;
  179. end;
  180. end;
  181. {$endif}
  182. {$ifndef FPC_SYSTEM_HAS_FPC_FINALIZEARRAY}
  183. procedure fpc_FinalizeArray(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif}
  184. var
  185. i : longint;
  186. begin
  187. for i:=0 to count-1 do
  188. int_finalize(data+size*i,typeinfo);
  189. end;
  190. {$endif}
  191. {
  192. $Log$
  193. Revision 1.6 2001-11-14 22:59:11 michael
  194. + Initial variant support
  195. Revision 1.5 2001/08/01 15:00:10 jonas
  196. + "compproc" helpers
  197. * renamed several helpers so that their name is the same as their
  198. "public alias", which should facilitate the conversion of processor
  199. specific code in the code generator to processor independent code
  200. * some small fixes to the val_ansistring and val_widestring helpers
  201. (always immediately exit if the source string is longer than 255
  202. chars)
  203. * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
  204. still nil (used to crash, now return resp -1 and 0)
  205. Revision 1.4 2001/06/28 19:18:57 peter
  206. * ansistr fix merged
  207. Revision 1.3 2001/05/28 20:43:17 peter
  208. * more saveregisters added (merged)
  209. Revision 1.2 2001/04/23 18:25:44 peter
  210. * m68k updates
  211. }