{ This file is part of the Free Pascal run time library. Copyright (c) 2011 by Jonas Maebe member of the Free Pascal development team. This file implements the helper routines for TObject See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ********************************************************************** } procedure TObject.Free; begin if not DestructorCalled then begin DestructorCalled:=true; Destroy; end; end; destructor TObject.Destroy; begin end; procedure TObject.Finalize; begin Free; end; procedure tvarrec.init(l: longint); begin VType:=vtInteger; Value:=JLInteger.valueOf(l); end; procedure tvarrec.init(b: boolean); begin VType:=vtBoolean; Value:=JLBoolean.valueOf(b); end; procedure tvarrec.init(c: ansichar); begin VType:=vtChar; Value:=JLByte.valueOf(byte(c)); end; procedure tvarrec.init(w: widechar); begin VType:=vtWideChar; Value:=JLCharacter.valueOf(w); end; procedure tvarrec.init(d: extended); var arr: array[0..0] of extended; begin VType:=vtExtended; { VExtended has to return a PExtended -> return address of array (it doesn't matter that this is a local variable, all arrays are garbage collected pointers underneath!) } arr[0]:=d; Value:=JLObject(@arr); end; procedure tvarrec.init(const s: shortstring); begin VType:=vtString; Value:=JLObject(@s); end; procedure tvarrec.init(constref p: pointer); begin // pointer = object VType:=vtPointer; Value:=JLObject(p); end; procedure tvarrec.init(p: pchar); begin VType:=vtPChar; Value:=JLObject(p); end; procedure tvarrec.init(p: JLObject); begin VType:=vtObject; Value:=p; end; procedure tvarrec.init(c: TJClass); begin VType:=vtClass; Value:=JLObject(c); end; procedure tvarrec.init(p: pwidechar); begin VType:=vtPWideChar; Value:=JLObject(p); end; procedure tvarrec.init(const a: ansistring); begin VType:=vtAnsiString; Value:=JLObject(a); end; procedure tvarrec.init(constref c: currency); begin VType:=vtCurrency; { a constref parameter is internally passed as an array -> we can just take its address and return it later as a pcurrency (which is also a pointer internally) } Value:=JLObject(@c); end; procedure tvarrec.init(const w: widestring); begin VType:=vtUnicodeString; Value:=JLObject(w); end; procedure tvarrec.init(i: int64); var arr: array[0..0] of int64; begin VType:=vtInt64; arr[0]:=i; Value:=JLObject(@arr); end; procedure tvarrec.init(q: qword; unsigned: boolean = true); var arr: array[0..0] of qword; begin init(int64(q)); { parameter could be false in case it's called from Java code } if unsigned then VType:=vtQWord; end; function tvarrec.VInteger: longint; begin result:=JLInteger(Value).intValue end; function tvarrec.VBoolean: boolean; begin result:=JLBoolean(Value).booleanValue; end; function tvarrec.VChar: ansichar; begin result:=char(JLByte(Value).byteValue); end; function tvarrec.VWideChar: widechar; begin result:=JLCharacter(Value).charValue; end; function tvarrec.VExtended: pextended; begin result:=PExtended(Value); end; function tvarrec.VDouble: double; begin result:=JLDouble(Value).doubleValue; end; function tvarrec.VString: PShortString; begin result:=PShortString(Value); end; function tvarrec.VPointer: pointer; begin result:=pointer(Value); end; function tvarrec.VPChar: PChar; begin result:=PChar(Value); end; function tvarrec.VObject: JLObject; begin result:=Value; end; function tvarrec.VClass: TJClass; begin result:=TJClass(Value); end; function tvarrec.VPWideChar: PWideChar; begin result:=PWideChar(Value); end; function tvarrec.VAnsiString: Pointer; begin result:=Pointer(Value); end; function tvarrec.VCurrency: PCurrency; begin result:=PCurrency(Value); end; // function tvarrec.VVariant: PVariant; function tvarrec.VInterface: JLObject; begin result:=Value; end; function tvarrec.VWideString: Pointer; begin result:=Pointer(Value); end; function tvarrec.VInt64: PInt64; begin result:=PInt64(Value); end; function tvarrec.VUnicodeString: Pointer; begin result:=Pointer(Value); end; function tvarrec.VQWord: PQWord; begin result:=PQword(Value); end;