mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 10:11:27 +01:00 
			
		
		
		
	 27731e342c
			
		
	
	
		27731e342c
		
	
	
	
	
		
			
			implementation is a bit different from that on native targets, the
    result is quite compatible
git-svn-id: branches/jvmbackend@18765 -
		
	
			
		
			
				
	
	
		
			285 lines
		
	
	
		
			5.0 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
			
		
		
	
	
			285 lines
		
	
	
		
			5.0 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
| {
 | |
|     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;
 | |
| 
 |