objpas.inc 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2011 by Jonas Maebe
  4. member of the Free Pascal development team.
  5. This file implements the helper routines for TObject
  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. }
  13. procedure TObject.Free;
  14. begin
  15. if not DestructorCalled then
  16. begin
  17. DestructorCalled:=true;
  18. Destroy;
  19. end;
  20. end;
  21. destructor TObject.Destroy;
  22. begin
  23. end;
  24. procedure TObject.Finalize;
  25. begin
  26. Free;
  27. end;
  28. procedure tvarrec.init(l: longint);
  29. begin
  30. VType:=vtInteger;
  31. Value:=JLInteger.valueOf(l);
  32. end;
  33. procedure tvarrec.init(b: boolean);
  34. begin
  35. VType:=vtBoolean;
  36. Value:=JLBoolean.valueOf(b);
  37. end;
  38. procedure tvarrec.init(c: ansichar);
  39. begin
  40. VType:=vtChar;
  41. Value:=JLByte.valueOf(byte(c));
  42. end;
  43. procedure tvarrec.init(w: widechar);
  44. begin
  45. VType:=vtWideChar;
  46. Value:=JLCharacter.valueOf(w);
  47. end;
  48. procedure tvarrec.init(d: extended);
  49. var
  50. arr: array[0..0] of extended;
  51. begin
  52. VType:=vtExtended;
  53. { VExtended has to return a PExtended -> return address of array (it
  54. doesn't matter that this is a local variable, all arrays are garbage
  55. collected pointers underneath!) }
  56. arr[0]:=d;
  57. Value:=JLObject(@arr);
  58. end;
  59. procedure tvarrec.init(const s: shortstring);
  60. begin
  61. VType:=vtString;
  62. Value:=JLObject(@s);
  63. end;
  64. procedure tvarrec.init(constref p: pointer);
  65. begin
  66. // pointer = object
  67. VType:=vtPointer;
  68. Value:=JLObject(p);
  69. end;
  70. procedure tvarrec.init(p: pchar);
  71. begin
  72. VType:=vtPChar;
  73. Value:=JLObject(p);
  74. end;
  75. procedure tvarrec.init(p: JLObject);
  76. begin
  77. VType:=vtObject;
  78. Value:=p;
  79. end;
  80. procedure tvarrec.init(c: TJClass);
  81. begin
  82. VType:=vtClass;
  83. Value:=JLObject(c);
  84. end;
  85. procedure tvarrec.init(p: pwidechar);
  86. begin
  87. VType:=vtPWideChar;
  88. Value:=JLObject(p);
  89. end;
  90. procedure tvarrec.init(const a: ansistring);
  91. begin
  92. VType:=vtAnsiString;
  93. Value:=JLObject(a);
  94. end;
  95. procedure tvarrec.init(constref c: currency);
  96. begin
  97. VType:=vtCurrency;
  98. { a constref parameter is internally passed as an array -> we can just
  99. take its address and return it later as a pcurrency (which is also a
  100. pointer internally) }
  101. Value:=JLObject(@c);
  102. end;
  103. procedure tvarrec.init(const w: widestring);
  104. begin
  105. VType:=vtUnicodeString;
  106. Value:=JLObject(w);
  107. end;
  108. procedure tvarrec.init(i: int64);
  109. var
  110. arr: array[0..0] of int64;
  111. begin
  112. VType:=vtInt64;
  113. arr[0]:=i;
  114. Value:=JLObject(@arr);
  115. end;
  116. procedure tvarrec.init(q: qword; unsigned: boolean = true);
  117. var
  118. arr: array[0..0] of qword;
  119. begin
  120. init(int64(q));
  121. { parameter could be false in case it's called from Java code }
  122. if unsigned then
  123. VType:=vtQWord;
  124. end;
  125. function tvarrec.VInteger: longint;
  126. begin
  127. result:=JLInteger(Value).intValue
  128. end;
  129. function tvarrec.VBoolean: boolean;
  130. begin
  131. result:=JLBoolean(Value).booleanValue;
  132. end;
  133. function tvarrec.VChar: ansichar;
  134. begin
  135. result:=char(JLByte(Value).byteValue);
  136. end;
  137. function tvarrec.VWideChar: widechar;
  138. begin
  139. result:=JLCharacter(Value).charValue;
  140. end;
  141. function tvarrec.VExtended: pextended;
  142. begin
  143. result:=PExtended(Value);
  144. end;
  145. function tvarrec.VDouble: double;
  146. begin
  147. result:=JLDouble(Value).doubleValue;
  148. end;
  149. function tvarrec.VString: PShortString;
  150. begin
  151. result:=PShortString(Value);
  152. end;
  153. function tvarrec.VPointer: pointer;
  154. begin
  155. result:=pointer(Value);
  156. end;
  157. function tvarrec.VPChar: PChar;
  158. begin
  159. result:=PChar(Value);
  160. end;
  161. function tvarrec.VObject: JLObject;
  162. begin
  163. result:=Value;
  164. end;
  165. function tvarrec.VClass: TJClass;
  166. begin
  167. result:=TJClass(Value);
  168. end;
  169. function tvarrec.VPWideChar: PWideChar;
  170. begin
  171. result:=PWideChar(Value);
  172. end;
  173. function tvarrec.VAnsiString: Pointer;
  174. begin
  175. result:=Pointer(Value);
  176. end;
  177. function tvarrec.VCurrency: PCurrency;
  178. begin
  179. result:=PCurrency(Value);
  180. end;
  181. // function tvarrec.VVariant: PVariant;
  182. function tvarrec.VInterface: JLObject;
  183. begin
  184. result:=Value;
  185. end;
  186. function tvarrec.VWideString: Pointer;
  187. begin
  188. result:=Pointer(Value);
  189. end;
  190. function tvarrec.VInt64: PInt64;
  191. begin
  192. result:=PInt64(Value);
  193. end;
  194. function tvarrec.VUnicodeString: Pointer;
  195. begin
  196. result:=Pointer(Value);
  197. end;
  198. function tvarrec.VQWord: PQWord;
  199. begin
  200. result:=PQword(Value);
  201. end;