paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 09:09:47 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ support for threadvars in the JVM based on JLThreadLocal; see

Browse Source 
rtl/java/jtvarh.inc for the details

git-svn-id: branches/jvmbackend@18820 -
This commit is contained in:
Jonas Maebe 2011-08-23 17:45:01 +00:00
parent 992cc352c6
commit a2a0436347
18 changed files with 1087 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -7373,6 +7373,8 @@ rtl/java/jseth.inc svneol=native#text/plain
rtl/java/jsystem.inc svneol=native#text/plain
rtl/java/jsystemh.inc svneol=native#text/plain
rtl/java/jsystemh_types.inc svneol=native#text/plain
rtl/java/jtvar.inc svneol=native#text/plain
rtl/java/jtvarh.inc svneol=native#text/plain
rtl/java/objpas.inc svneol=native#text/plain
rtl/java/objpas.pp svneol=native#text/plain
rtl/java/objpash.inc svneol=native#text/plain
@ -9801,6 +9803,7 @@ tests/test/jvm/trange2.pp svneol=native#text/plain
tests/test/jvm/trange3.pp svneol=native#text/plain
tests/test/jvm/tset1.pp svneol=native#text/plain
tests/test/jvm/tset3.pp svneol=native#text/plain
tests/test/jvm/tthreadvar.pp svneol=native#text/plain
tests/test/jvm/ttrig.pp svneol=native#text/plain
tests/test/jvm/ttrunc.pp svneol=native#text/plain
tests/test/jvm/tvarpara.pp svneol=native#text/plain

4
compiler/agjasmin.pas
View File

@ -922,8 +922,8 @@ implementation
if (sym.owner.symtabletype in [recordsymtable,ObjectSymtable]) and
(sym.typ=staticvarsym) then
exit;
{ external definition -> no definition here }
if vo_is_external in sym.varoptions then
{ external or threadvar definition -> no definition here }
if ([vo_is_external,vo_is_thread_var]*sym.varoptions)<>[] then
exit;
AsmWrite('.field ');
AsmWriteln(FieldDefinition(sym));

7
compiler/jvm/hlcgcpu.pas
View File

@ -2025,7 +2025,12 @@ implementation
intialising the constant }
if [vo_is_external,vo_has_local_copy]*vs.varoptions=[vo_is_external] then
continue;
if jvmimplicitpointertype(vs.vardef) then
{ threadvar innitializations are handled at the node tree level }
if vo_is_thread_var in vs.varoptions then
begin
{ nothing }
end
else if jvmimplicitpointertype(vs.vardef) then
allocate_implicit_struct_with_base_ref(list,vs,ref)
{ enums are class instances in Java, while they are ordinals in
Pascal. When they are initialized with enum(0), such as in

102
compiler/jvm/jvmdef.pas
View File

@ -81,6 +81,14 @@ interface
function jvmgetcorrespondingclassdef(def: tdef): tdef;
{ threadvars are wrapped via descendents of java.lang.ThreadLocal }
function jvmgetthreadvardef(def: tdef): tdef;
{ gets the number of dimensions and the final element type of a normal
array }
procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
implementation
uses
@ -737,6 +745,100 @@ implementation
end;
function jvmgetthreadvardef(def: tdef): tdef;
begin
if (def.typ=arraydef) and
not is_dynamic_array(def) then
begin
result:=search_system_type('FPCNORMALARRAYTHREADVAR').typedef;
exit;
end;
if jvmimplicitpointertype(def) then
begin
result:=search_system_type('FPCIMPLICITPTRTHREADVAR').typedef;
exit;
end;
case def.typ of
orddef:
begin
case torddef(def).ordtype of
pasbool8:
begin
result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
end;
uwidechar:
begin
result:=tobjectdef(search_system_type('FPCCHARTHREADVAR').typedef);
end;
s8bit,
u8bit,
uchar,
bool8bit:
begin
result:=tobjectdef(search_system_type('FPCBYTETHREADVAR').typedef);
end;
s16bit,
u16bit,
bool16bit,
pasbool16:
begin
result:=tobjectdef(search_system_type('FPCSHORTTHREADVAR').typedef);
end;
s32bit,
u32bit,
bool32bit,
pasbool32:
begin
result:=tobjectdef(search_system_type('FPCINTTHREADVAR').typedef);
end;
s64bit,
u64bit,
scurrency,
bool64bit,
pasbool64:
begin
result:=tobjectdef(search_system_type('FPCLONGTHREADVAR').typedef);
end
else
internalerror(2011082101);
end;
end;
floatdef:
begin
case tfloatdef(def).floattype of
s32real:
begin
result:=tobjectdef(search_system_type('FPCFLOATTHREADVAR').typedef);
end;
s64real:
begin
result:=tobjectdef(search_system_type('FPCDOUBLETHREADVAR').typedef);
end;
else
internalerror(2011082102);
end;
end
else
begin
result:=search_system_type('FPCPOINTERTHREADVAR').typedef
end;
end;
end;
procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
begin
eledef:=arrdef;
ndim:=0;
repeat
eledef:=tarraydef(eledef).elementdef;
inc(ndim);
until (eledef.typ<>arraydef) or
is_dynamic_array(eledef);
end;
function jvmmangledbasename(sym: tsym; const usesymname: TSymStr; withsignature: boolean): TSymStr;
var
container: tsymtable;

19
compiler/jvm/njvmld.pas
View File

@ -35,6 +35,7 @@ type
tjvmloadnode = class(tcgnestloadnode)
protected
function is_copyout_addr_param_load: boolean;
function handle_threadvar_access: tnode; override;
public
function is_addr_param_load: boolean; override;
procedure pass_generate_code; override;
@ -159,6 +160,24 @@ function tjvmloadnode.is_copyout_addr_param_load: boolean;
end;
function tjvmloadnode.handle_threadvar_access: tnode;
var
vs: tsym;
begin
{ get the variable wrapping the threadvar }
vs:=tsym(symtable.find(symtableentry.name+'$THREADVAR'));
if not assigned(vs) or
(vs.typ<>staticvarsym) then
internalerror(2011082201);
{ get a read/write reference to the threadvar value }
result:=cloadnode.create(vs,vs.owner);
typecheckpass(result);
result:=ccallnode.createinternmethod(result,'GETREADWRITEREFERENCE',nil);
result:=ctypeconvnode.create_explicit(result,getpointerdef(resultdef));
result:=cderefnode.create(result);
end;
function tjvmloadnode.is_addr_param_load: boolean;
begin
result:=

107
compiler/jvm/njvmutil.pas
View File

@ -171,6 +171,16 @@ implementation
end;
class procedure tjvmnodeutils.insertbssdata(sym: tstaticvarsym);
var
enuminitsym,
vs: tstaticvarsym;
block: tblocknode;
stat: tstatementnode;
temp: ttempcreatenode;
initnode: tnode;
eledef: tdef;
ndim: longint;
initnodefinished: boolean;
begin
{ handled while generating the unit/program init code, or class
constructor; add something to al_globals to indicate that we need to
@ -178,6 +188,103 @@ implementation
if current_asmdata.asmlists[al_globals].empty and
jvmimplicitpointertype(sym.vardef) then
current_asmdata.asmlists[al_globals].concat(cai_align.Create(1));
{ in case of a threadvar, allocate a separate sym that's a subtype of the
java.lang.ThreadLocal class which will wrap the actual variable value }
if vo_is_thread_var in sym.varoptions then
begin
vs:=tstaticvarsym.create(sym.realname+'$threadvar',sym.varspez,
jvmgetthreadvardef(sym.vardef),
sym.varoptions - [vo_is_thread_var]);
sym.owner.insert(vs);
{ make sure that the new sym does not get allocated (we will allocate
it when encountering the original sym, because only then we know
that it's a threadvar) }
include(vs.symoptions,sp_static);
{ switch around the mangled names of sym and vs, since the wrapper
should map to the declared name }
sym.set_mangledbasename(vs.realname);
vs.set_mangledbasename(sym.realname);
{ add initialization code for the wrapper }
block:=internalstatements(stat);
if assigned(current_module.tcinitcode) then
addstatement(stat,tnode(current_module.tcinitcode));
current_module.tcinitcode:=block;
{ create initialization value if necessary }
initnode:=nil;
initnodefinished:=false;
temp:=nil;
{ in case of enum type, initialize with enum(0) if it exists }
if sym.vardef.typ=enumdef then
begin
enuminitsym:=tstaticvarsym(tenumdef(sym.vardef).getbasedef.classdef.symtable.Find('__FPC_ZERO_INITIALIZER'));
if assigned(enuminitsym) then
initnode:=cloadnode.create(enuminitsym,enuminitsym.owner);
end
{ normal array -> include dimensions and element type so we can
create a deep copy }
else if (sym.vardef.typ=arraydef) and
not is_dynamic_array(sym.vardef) then
begin
temp:=ctempcreatenode.create(sym.vardef,sym.vardef.size,tt_persistent,true);
addstatement(stat,temp);
initnode:=ccallparanode.create(
ctypeconvnode.create_explicit(
caddrnode.create_internal(ctemprefnode.create(temp)),
java_jlobject),
nil);
jvmgetarraydimdef(sym.vardef,eledef,ndim);
initnode:=ccallparanode.create(genintconstnode(ndim),initnode);
initnode:=ccallparanode.create(
cordconstnode.create(ord(jvmarrtype_setlength(eledef)),
cwidechartype,false),
initnode);
initnodefinished:=true;
end
{ implicitpointertype -> allocate (get temp and assign address) }
else if jvmimplicitpointertype(sym.vardef) then
begin
temp:=ctempcreatenode.create(sym.vardef,sym.vardef.size,tt_persistent,true);
addstatement(stat,temp);
initnode:=caddrnode.create_internal(ctemprefnode.create(temp));
end
{ unicodestring/ansistring -> empty string }
else if is_wide_or_unicode_string(sym.vardef) or
is_ansistring(sym.vardef) then
begin
temp:=ctempcreatenode.create(sym.vardef,sym.vardef.size,tt_persistent,true);
addstatement(stat,temp);
addstatement(stat,cassignmentnode.create(
ctemprefnode.create(temp),
cstringconstnode.createstr('')));
initnode:=ctemprefnode.create(temp);
end
{ dynamic array -> empty array }
else if is_dynamic_array(sym.vardef) then
begin
temp:=ctempcreatenode.create(sym.vardef,sym.vardef.size,tt_persistent,true);
addstatement(stat,temp);
addstatement(stat,cinlinenode.create(in_setlength_x,false,
ccallparanode.create(genintconstnode(0),
ccallparanode.create(ctemprefnode.create(temp),nil))
)
);
initnode:=ctemprefnode.create(temp);
end;
if assigned(initnode) and
not initnodefinished then
initnode:=ccallparanode.create(ctypeconvnode.create_explicit(initnode,java_jlobject),nil);
addstatement(stat,cassignmentnode.create(
cloadnode.create(vs,vs.owner),
ccallnode.createinternmethod(
cloadvmtaddrnode.create(ctypenode.create(vs.vardef)),
'CREATE',initnode)));
{ deallocate the temp if we allocated one }
if assigned(temp) then
addstatement(stat,ctempdeletenode.create(temp));
end;
end;

10
compiler/nld.pas
View File

@ -39,6 +39,7 @@ interface
protected
fprocdef : tprocdef;
fprocdefderef : tderef;
function handle_threadvar_access: tnode; virtual;
public
symtableentry : tsym;
symtableentryderef : tderef;
@ -167,6 +168,13 @@ implementation
TLOADNODE
*****************************************************************************}
function tloadnode.handle_threadvar_access: tnode;
begin
{ nothing special by default }
result:=nil;
end;
constructor tloadnode.create(v : tsym;st : TSymtable);
begin
inherited create(loadn,nil);
@ -283,6 +291,8 @@ implementation
) then
make_not_regable(self,[ra_addr_taken]);
resultdef:=tabstractvarsym(symtableentry).vardef;
if vo_is_thread_var in tstaticvarsym(symtableentry).varoptions then
result:=handle_threadvar_access;
end;
paravarsym,
localvarsym :

35
rtl/java/java_sys.inc
View File

@ -174,6 +174,41 @@
class function mapLibraryName(para1: JLString): JLString; static; overload;
end;
JLThreadLocal = class external 'java.lang' name 'ThreadLocal' (JLObject)
public
type
InnerThreadLocalMap = class;
Arr1InnerThreadLocalMap = array of InnerThreadLocalMap;
Arr2InnerThreadLocalMap = array of Arr1InnerThreadLocalMap;
Arr3InnerThreadLocalMap = array of Arr2InnerThreadLocalMap;
InnerEntry = class;
Arr1InnerEntry = array of InnerEntry;
Arr2InnerEntry = array of Arr1InnerEntry;
Arr3InnerEntry = array of Arr2InnerEntry;
InnerThreadLocalMap = class external 'java.lang' name 'ThreadLocalMap'
public
type
InnerEntry = class;
Arr1InnerEntry = array of InnerEntry;
Arr2InnerEntry = array of Arr1InnerEntry;
Arr3InnerEntry = array of Arr2InnerEntry;
InnerEntry = class external 'java.lang' name 'Entry'
end;
end;
InnerEntry = class external 'java.lang' name 'Entry'
end;
strict protected
function initialValue(): JLObject; overload; virtual;
public
constructor create(); overload;
function get(): JLObject; overload; virtual;
procedure &set(para1: JLObject); overload; virtual;
procedure remove(); overload; virtual;
end;
JLRAnnotatedElement = interface external 'java.lang.reflect' name 'AnnotatedElement'
function isAnnotationPresent(para1: JLClass): jboolean; overload;
function getAnnotation(para1: JLClass): JLAAnnotation; overload;

7
rtl/java/java_sysh.inc
View File

@ -1,4 +1,4 @@
{ Imports for Java packages/classes: java.io.Serializable, java.lang.AbstractStringBuilder, java.lang.Appendable, java.lang.Boolean, java.lang.Byte, java.lang.CharSequence, java.lang.Character, java.lang.Class, java.lang.Cloneable, java.lang.Comparable, java.lang.Double, java.lang.Enum, java.lang.Error, java.lang.Exception, java.lang.Float, java.lang.IllegalArgumentException, java.lang.IndexOutOfBoundsException, java.lang.Integer, java.lang.Iterable, java.lang.LinkageError, java.lang.Long, java.lang.Math, java.lang.NoSuchMethodException, java.lang.Number, java.lang.Object, java.lang.Runtime, java.lang.RuntimeException, java.lang.Short, java.lang.String, java.lang.StringBuffer, java.lang.StringBuilder, java.lang.System, java.lang.Throwable, java.lang.reflect.AccessibleObject, java.lang.reflect.AnnotatedElement, java.lang.reflect.Array, java.lang.reflect.Field, java.lang.reflect.GenericDeclaration, java.lang.reflect.Member, java.lang.reflect.Method, java.lang.reflect.Type, java.math.BigInteger, java.text.Collator, java.util.AbstractCollection, java.util.AbstractMap, java.util.AbstractSet, java.util.Arrays, java.util.BitSet, java.util.Calendar, java.util.Collection, java.util.Comparator, java.util.EnumSet, java.util.HashMap, java.util.Iterator, java.util.Map, java.util.Set }
{ Imports for Java packages/classes: java.io.Serializable, java.lang.AbstractStringBuilder, java.lang.Appendable, java.lang.Boolean, java.lang.Byte, java.lang.CharSequence, java.lang.Character, java.lang.Class, java.lang.Cloneable, java.lang.Comparable, java.lang.Double, java.lang.Enum, java.lang.Error, java.lang.Exception, java.lang.Float, java.lang.IllegalArgumentException, java.lang.IndexOutOfBoundsException, java.lang.Integer, java.lang.Iterable, java.lang.LinkageError, java.lang.Long, java.lang.Math, java.lang.NoSuchMethodException, java.lang.Number, java.lang.Object, java.lang.Runtime, java.lang.RuntimeException, java.lang.Short, java.lang.String, java.lang.StringBuffer, java.lang.StringBuilder, java.lang.System, java.lang.ThreadLocal, java.lang.Throwable, java.lang.reflect.AccessibleObject, java.lang.reflect.AnnotatedElement, java.lang.reflect.Array, java.lang.reflect.Field, java.lang.reflect.GenericDeclaration, java.lang.reflect.Member, java.lang.reflect.Method, java.lang.reflect.Type, java.math.BigInteger, java.text.Collator, java.util.AbstractCollection, java.util.AbstractMap, java.util.AbstractSet, java.util.Arrays, java.util.BitSet, java.util.Calendar, java.util.Collection, java.util.Comparator, java.util.EnumSet, java.util.HashMap, java.util.Iterator, java.util.Map, java.util.Set }
type
JLNoSuchMethodException = class;
Arr1JLNoSuchMethodException = array of JLNoSuchMethodException;
@ -120,6 +120,11 @@ type
Arr2JUAbstractMap = array of Arr1JUAbstractMap;
Arr3JUAbstractMap = array of Arr2JUAbstractMap;
JLThreadLocal = class;
Arr1JLThreadLocal = array of JLThreadLocal;
Arr2JLThreadLocal = array of Arr1JLThreadLocal;
Arr3JLThreadLocal = array of Arr2JLThreadLocal;
JLRArray = class;
Arr1JLRArray = array of JLRArray;
Arr2JLRArray = array of Arr1JLRArray;

49
rtl/java/jdk15.inc
View File

@ -2099,41 +2099,6 @@
JLTerminator = class external 'java.lang' name 'Terminator' (JLObject)
end;
JLThreadLocal = class external 'java.lang' name 'ThreadLocal' (JLObject)
public
type
InnerThreadLocalMap = class;
Arr1InnerThreadLocalMap = array of InnerThreadLocalMap;
Arr2InnerThreadLocalMap = array of Arr1InnerThreadLocalMap;
Arr3InnerThreadLocalMap = array of Arr2InnerThreadLocalMap;
InnerEntry = class;
Arr1InnerEntry = array of InnerEntry;
Arr2InnerEntry = array of Arr1InnerEntry;
Arr3InnerEntry = array of Arr2InnerEntry;
InnerThreadLocalMap = class external 'java.lang' name 'ThreadLocalMap'
public
type
InnerEntry = class;
Arr1InnerEntry = array of InnerEntry;
Arr2InnerEntry = array of Arr1InnerEntry;
Arr3InnerEntry = array of Arr2InnerEntry;
InnerEntry = class external 'java.lang' name 'Entry'
end;
end;
InnerEntry = class external 'java.lang' name 'Entry'
end;
strict protected
function initialValue(): JLObject; overload; virtual;
public
constructor create(); overload;
function get(): JLObject; overload; virtual;
procedure &set(para1: JLObject); overload; virtual;
procedure remove(); overload; virtual;
end;
JLVoid = class sealed external 'java.lang' name 'Void' (JLObject)
public
final class var
@ -23790,6 +23755,13 @@
constructor create(para1: JLString); overload;
end;
JLInheritableThreadLocal = class external 'java.lang' name 'InheritableThreadLocal' (JLThreadLocal)
public
constructor create(); overload;
strict protected
function childValue(para1: JLObject): JLObject; overload; virtual;
end;
JLPackage = class external 'java.lang' name 'Package' (JLObject, JLRAnnotatedElement)
public
function getName(): JLString; overload; virtual;
@ -28394,13 +28366,6 @@
JCSunJCE_h = class sealed external 'javax.crypto' name 'SunJCE_h' (JLSecurityManager)
end;
JLInheritableThreadLocal = class external 'java.lang' name 'InheritableThreadLocal' (JLThreadLocal)
public
constructor create(); overload;
strict protected
function childValue(para1: JLObject): JLObject; overload; virtual;
end;
JBConstructorProperties = interface external 'java.beans' name 'ConstructorProperties' (JLAAnnotation)
function value(): Arr1JLString; overload;
end;

30
rtl/java/jdk15.pas
View File

@ -1080,11 +1080,6 @@ type
Arr2JMBitSieve = array of Arr1JMBitSieve;
Arr3JMBitSieve = array of Arr2JMBitSieve;
JLThreadLocal = class;
Arr1JLThreadLocal = array of JLThreadLocal;
Arr2JLThreadLocal = array of Arr1JLThreadLocal;
Arr3JLThreadLocal = array of Arr2JLThreadLocal;
JAFLineBreakMeasurer = class;
Arr1JAFLineBreakMeasurer = array of JAFLineBreakMeasurer;
Arr2JAFLineBreakMeasurer = array of Arr1JAFLineBreakMeasurer;
@ -8965,16 +8960,16 @@ type
Arr2OOCNVList = array of Arr1OOCNVList;
Arr3OOCNVList = array of Arr2OOCNVList;
JNNamingException = class;
Arr1JNNamingException = array of JNNamingException;
Arr2JNNamingException = array of Arr1JNNamingException;
Arr3JNNamingException = array of Arr2JNNamingException;
JUTimer = class;
Arr1JUTimer = array of JUTimer;
Arr2JUTimer = array of Arr1JUTimer;
Arr3JUTimer = array of Arr2JUTimer;
JNNamingException = class;
Arr1JNNamingException = array of JNNamingException;
Arr2JNNamingException = array of Arr1JNNamingException;
Arr3JNNamingException = array of Arr2JNNamingException;
JSDebugGraphicsObserver = class;
Arr1JSDebugGraphicsObserver = array of JSDebugGraphicsObserver;
Arr2JSDebugGraphicsObserver = array of Arr1JSDebugGraphicsObserver;
@ -20705,16 +20700,16 @@ type
Arr2JLLong = array of Arr1JLLong;
Arr3JLLong = array of Arr2JLLong;
JLInteger = class external 'java.lang' name 'Integer';
Arr1JLInteger = array of JLInteger;
Arr2JLInteger = array of Arr1JLInteger;
Arr3JLInteger = array of Arr2JLInteger;
JLThrowable = class external 'java.lang' name 'Throwable';
Arr1JLThrowable = array of JLThrowable;
Arr2JLThrowable = array of Arr1JLThrowable;
Arr3JLThrowable = array of Arr2JLThrowable;
JLInteger = class external 'java.lang' name 'Integer';
Arr1JLInteger = array of JLInteger;
Arr2JLInteger = array of Arr1JLInteger;
Arr3JLInteger = array of Arr2JLInteger;
JLLinkageError = class external 'java.lang' name 'LinkageError';
Arr1JLLinkageError = array of JLLinkageError;
Arr2JLLinkageError = array of Arr1JLLinkageError;
@ -20725,6 +20720,11 @@ type
Arr2JUAbstractCollection = array of Arr1JUAbstractCollection;
Arr3JUAbstractCollection = array of Arr2JUAbstractCollection;
JLThreadLocal = class external 'java.lang' name 'ThreadLocal';
Arr1JLThreadLocal = array of JLThreadLocal;
Arr2JLThreadLocal = array of Arr1JLThreadLocal;
Arr3JLThreadLocal = array of Arr2JLThreadLocal;
JUAbstractMap = class external 'java.util' name 'AbstractMap';
Arr1JUAbstractMap = array of JUAbstractMap;
Arr2JUAbstractMap = array of Arr1JUAbstractMap;

2
rtl/java/jdynarrh.inc
View File

@ -16,6 +16,7 @@
}
type
TJBooleanArray = array of jboolean;
TJByteArray = array of jbyte;
TJShortArray = array of jshort;
TJIntArray = array of jint;
@ -32,6 +33,7 @@ type
TJStringArray = array of unicodestring;
const
FPCJDynArrTypeBoolean = 'Z';
FPCJDynArrTypeJByte = 'B';
FPCJDynArrTypeJShort = 'S';
FPCJDynArrTypeJInt = 'I';

239
rtl/java/jtvar.inc Normal file
View File

@ -0,0 +1,239 @@
{
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 support routines for threadvarq with FPC/JVM
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.
**********************************************************************}
function FpcImplicitPtrThreadVar.initialValue: JLObject;
var
owningClass: JLClass;
begin
{ look up the clone method if we haven't done this yet }
if not assigned(fCloneMethod) then
begin
owningClass:=fInstanceToClone.getClass;
repeat
try
fCloneMethod:=owningClass.getDeclaredMethod('clone',[]);
except
on JLNoSuchMethodException do
owningClass:=owningClass.getSuperClass;
end;
until assigned(fCloneMethod);
end;
{ required to enable calling methods of non-public classes (e.g. a record
type defined in the implementation of a unit -- can cause security
exceptions if the security manager doesn't allow this though... }
if not fCloneMethod.isAccessible then
fCloneMethod.setAccessible(true);
{ return a copy of the record/shortstring/set/... }
result:=fCloneMethod.invoke(fInstanceToClone,[]);
end;
constructor FpcImplicitPtrThreadVar.create(initInstanceToClone: JLObject);
begin
fInstanceToClone:=initInstanceToClone;
end;
function FpcImplicitPtrThreadVar.getReadWriteReference: Pointer;
begin
{ return the address of the record/shortstring/set/... }
result:=Pointer(get);
end;
function FpcNormalArrayThreadVar.initialValue: JLObject;
begin
result:=fpc_dynarray_copy(fInstanceToClone,-1,-1,fArrDim,fArrTyp);
end;
constructor FpcNormalArrayThreadVar.create(initInstanceToClone: JLObject; arrdim: longint; arrtyp: widechar);
begin
inherited create(initInstanceToClone);
fArrDim:=arrdim;
fArrTyp:=arrtyp;
end;
function FpcBooleanThreadVar.initialValue: JLObject;
var
arr: TJBooleanArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcBooleanThreadVar.getReadWriteReference: PBoolean;
var
arr: TJBooleanArray;
begin
arr:=TJBooleanArray(get);
result:=@arr[0];
end;
function FpcByteThreadVar.initialValue: JLObject;
var
arr: TJByteArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcByteThreadVar.getReadWriteReference: PShortint;
var
arr: TJByteArray;
begin
arr:=TJByteArray(get);
result:=@arr[0];
end;
function FpcShortThreadVar.initialValue: JLObject;
var
arr: TJShortArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcShortThreadVar.getReadWriteReference: PSmallint;
var
arr: TJShortArray;
begin
arr:=TJShortArray(get);
result:=@arr[0];
end;
function FpcIntThreadVar.initialValue: JLObject;
var
arr: TJIntArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcIntThreadVar.getReadWriteReference: PLongint;
var
arr: TJIntArray;
begin
arr:=TJIntArray(get);
result:=@arr[0];
end;
function FpcLongThreadVar.initialValue: JLObject;
var
arr: TJLongArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcLongThreadVar.getReadWriteReference: PInt64;
var
arr: TJLongArray;
begin
arr:=TJLongArray(get);
result:=@arr[0];
end;
function FpcCharThreadVar.initialValue: JLObject;
var
arr: TJCharArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcCharThreadVar.getReadWriteReference: PWideChar;
var
arr: TJCharArray;
begin
arr:=TJCharArray(get);
result:=@arr[0];
end;
function FpcFloatThreadVar.initialValue: JLObject;
var
arr: TJFloatArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcFloatThreadVar.getReadWriteReference: PSingle;
var
arr: TJFloatArray;
begin
arr:=TJFloatArray(get);
result:=@arr[0];
end;
function FpcDoubleThreadVar.initialValue: JLObject;
var
arr: TJDoubleArray;
begin
setlength(arr,1);
result:=JLObject(arr);
end;
function FpcDoubleThreadVar.getReadWriteReference: PDouble;
var
arr: TJDoubleArray;
begin
arr:=TJDoubleArray(get);
result:=@arr[0];
end;
function FpcPointerThreadVar.initialValue: JLObject;
var
arr: TJObjectArray;
begin
setlength(arr,1);
arr[0]:=fInitVal;
result:=JLObject(arr);
end;
constructor FpcPointerThreadVar.create(initVal: JLObject);
begin
fInitVal:=initVal;
end;
function FpcPointerThreadVar.getReadWriteReference: PPointer;
var
arr: TJObjectArray;
begin
arr:=TJObjectArray(get);
result:=PPointer(@arr[0]);
end;

166
rtl/java/jtvarh.inc Normal file
View File

@ -0,0 +1,166 @@
{
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 support routines for threadvarq with FPC/JVM
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.
**********************************************************************}
{ In Java, threadvars are represented by descendnts of java.lang.ThreadLocal.
This class has three important methods: set, get and initialValue.
If you call the "get" method of a JLThreadLocal instance in a thread for the
first time before calling "set", it will call the initialValue method and
return its result. After that, it will return whatever initialValue returned,
or the previous value instated by "set". A JLThreadLocal always keeps track of
a JLObject.
We don't want to translate accesses to threadvars into calls to get/set, since
that would mean that we would
a) have to generate different code in the compiler for read and write
accesses
b) no be able to pass threadvars to var-parameters etc
Instead, we add a method called getReadWriteReference to all of our
descendants classes that returns a pointer to the actual value of the
threadvar for this thread. This results in several cases:
a) For primitive types, we store an array of one element of that ordinal
type.
Their initialValue is simply an array of one element (automatically
initialized to 0).
The pointer returned is the "address" of element 0 (pointers to primitive
types are internally arrays pointing to element 0).
b) For non-dynamic arrays, we store that array itself (all arrays are
internally Java arrays, which descend from JLObject).
When initializing the threadvar on startup, we pass an empty copy of such
an array to the constructor and store it. Their initialValue is a deep
copy of this array, created by fpc_dynarray_copy (it accepts a number of
dimensions, because it also has to work for making a copy of dynamic
arrays whose elements are regular arrays).
The pointer returned is simply the address of the array.
c) For implicit pointer types other than regular arrays, we also store the
implicit pointer itself and keep an initialized empty instance around
that is passed to the constructor.
Their initialValue is a clone of this empty instance (can't use this for
arrays, since it would make a shallow copy of the array). Because of the
way the JLCloneable interface works, we have to call the clone method via
reflection.
The pointer returned is again simply the implicit pointer itself.
d) For all other types, we store an array of JLObject of one element,
similar as with primitive types.
Their initialValue is either nil, or optionally a value passed to the
constructor when creating the JLThreadLocal instance (e.g. an empty
string for unicodestring/ansistring, or the enum instance whose ordinal
value is 0)
The pointer returned is the address of element 0 of the array.
}
type
FpcImplicitPtrThreadVar = class(JLThreadLocal)
protected
{ all implicit pointer types are clonable }
fInstanceToClone: JLObject;
{ don't look up the clone method every time }
fCloneMethod: JLRMethod;
function initialValue: JLObject; override;
public
constructor create(initInstanceToClone: JLObject);
function getReadWriteReference: Pointer;
end;
FpcNormalArrayThreadVar = class sealed (FpcImplicitPtrThreadVar)
protected
fArrDim: longint;
fArrTyp: widechar;
function initialValue: JLObject; override;
public
constructor create(initInstanceToClone: JLObject; arrdim: longint; arrtyp: widechar);
end;
FpcBooleanThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PBoolean;
end;
FpcByteThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PShortint;
end;
FpcShortThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PSmallint;
end;
FpcIntThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PLongint;
end;
FpcLongThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PInt64;
end;
FpcCharThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PWideChar;
end;
FpcFloatThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PSingle;
end;
FpcDoubleThreadVar = class sealed (JLThreadLocal)
protected
function initialValue: JLObject; override;
public
function getReadWriteReference: PDouble;
end;
FpcPointerThreadVar = class sealed (JLThreadLocal)
protected
fInitVal: JLObject;
function initialValue: JLObject; override;
public
function getReadWriteReference: PPointer;
constructor create(initVal: JLObject);overload;
end;

2
rtl/java/system.pp
View File

@ -84,6 +84,7 @@ const
{$i jseth.inc}
{$i jpvarh.inc}
{$i jsystemh_types.inc}
{$i jtvarh.inc}
{$i sstringh.inc}
{$i jdynarrh.inc}
{$i astringh.inc}
@ -95,6 +96,7 @@ const
implementation
{*****************************************************************************}
{$i jtvar.inc}
{$i jdynarr.inc}
{*****************************************************************************

4
tests/test/jvm/testall.bat
View File

@ -180,3 +180,7 @@ ppcjvm -O2 -g getbit
if %errorlevel% neq 0 exit /b %errorlevel%
java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. getbit
if %errorlevel% neq 0 exit /b %errorlevel%
ppcjvm -O2 -g tthreadvar
if %errorlevel% neq 0 exit /b %errorlevel%
java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tthreadvar
if %errorlevel% neq 0 exit /b %errorlevel%

2
tests/test/jvm/testall.sh
View File

@ -100,3 +100,5 @@ $PPC -O2 -g tdefpara
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tdefpara
$PPC -O2 -g getbit
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. getbit
$PPC -O2 -g tthreadvar
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tthreadvar

360
tests/test/jvm/tthreadvar.pp Normal file
View File

@ -0,0 +1,360 @@
program tthreadvar;
{$mode delphi}
{$modeswitch unicodestrings}
uses
jdk15;
type
tc = class
end;
tmythread = class(JLThread)
procedure run; override;
end;
type
tthreadvarkind = (fboolean,fbyte,fsmallint,fcardinal,fint64,fchar,fwidechar,fsingle,fdouble,fsetint,fsetenum,frec,fshortstring,funicodestring,farrbyte,farrset);
tsetint = set of 30..40;
tsetenum = set of tthreadvarkind;
tarrbyte = array[4..6] of byte;
tarrset = array[1..2] of tsetint;
trec = record
a: longint;
b: array[3..4] of ansistring;
end;
const
cenumin: tthreadvarkind = fcardinal;
cbooleanin: boolean = true;
cbytein: byte = 35;
csmallintin: smallint = 1234;
ccardinalin: cardinal = $1234567;
cint64in: int64 = $deadcafebabe;
ccharin: ansichar = 'S';
cwidecharin: widechar = 'U';
csinglein: single = 1234.5;
cdoublein: double = 1239643.75;
csetintin: tsetint = [36..39];
csetenumin: tsetenum = [fsmallint,fint64,funicodestring];
crecin: trec = (a:98765; b:('abc','def'));
cshortstringin: shortstring = 'greaT';
cunicodestringin: unicodestring = 'a bit longer!';
carrbytein: tarrbyte = (4,2,5);
carrsetin: tarrset = ([31,33,37],[]);
cenumout: tthreadvarkind = farrbyte;
cbooleanout: boolean = false;
cbyteout: byte = 128;
csmallintout: smallint = 4321;
ccardinalout: cardinal = $7654321;
cint64out: int64 = $B4B3154713;
ccharout: ansichar = 's';
cwidecharout: widechar = 'u';
csingleout: single = 4321.5;
cdoubleout: double = 9876543.75;
csetintout: tsetint = [31..36];
csetenumout: tsetenum = [fbyte];
crecout: trec = (a:4365246; b:('cbax','iiiiii'));
cshortstringout: shortstring = 'tiny';
cunicodestringout: unicodestring = 'yet another bit longer!';
carrbyteout: tarrbyte = (6,6,6);
carrsetout: tarrset = ([30,31],[33..38]);
threadvar
venum: tthreadvarkind;
vboolean: boolean;
vbyte: byte;
vsmallint: smallint;
vcardinal: cardinal;
vint64: int64;
vchar: ansichar;
vwidechar: widechar;
vsingle: single;
vdouble: double;
vsetint: tsetint;
vsetenum: tsetenum;
vrec: trec;
vshortstring: shortstring;
vunicodestring: unicodestring;
varrbyte: tarrbyte;
varrset: tarrset;
i: longint;
procedure checkmainthreadvarsinit;
var
i: longint;
begin
if venum<>fboolean then
raise jlexception.create('enum in');
venum:=cenumout;
if venum<>cenumout then
raise jlexception.create('enum out');
if vboolean<>false then
raise jlexception.create('boolean in');
vboolean:=cbooleanout;
if vboolean<>cbooleanout then
raise jlexception.create('boolean out');
if vbyte<>0 then
raise jlexception.create('byte in');
vbyte:=cbyteout;
if vbyte<>cbyteout then
raise jlexception.create('byte out');
if vsmallint<>0 then
raise jlexception.create('smallint in');
vsmallint:=csmallintout;
if vsmallint<>csmallintout then
raise jlexception.create('smallint out');
if vcardinal<>0 then
raise jlexception.create('cardinal in');
vcardinal:=ccardinalout;
if vcardinal<>ccardinalout then
raise jlexception.create('cardinal out');
if vint64<>0 then
raise jlexception.create('int64 in');
vint64:=cint64out;
if vint64<>cint64out then
raise jlexception.create('int64 out');
if vchar<>#0 then
raise jlexception.create('char in');
vchar:=ccharout;
if vchar<>ccharout then
raise jlexception.create('char out');
if vwidechar<>#0 then
raise jlexception.create('widechar in');
vwidechar:=cwidecharout;
if vwidechar<>cwidecharout then
raise jlexception.create('widechar out');
if vsingle<>0 then
raise jlexception.create('single in');
vsingle:=csingleout;
if vsingle<>csingleout then
raise jlexception.create('single out');
if vdouble<>0 then
raise jlexception.create('double in');
vdouble:=cdoubleout;
if vdouble<>cdoubleout then
raise jlexception.create('double out');
if vsetint<>[] then
raise jlexception.create('setint in');
vsetint:=csetintout;
if vsetint<>csetintout then
raise jlexception.create('setint out');
if vsetenum<>[] then
raise jlexception.create('setenum in');
vsetenum:=csetenumout;
if vsetenum<>csetenumout then
raise jlexception.create('setenum out');
if vrec.a<>0 then
raise jlexception.create('rec.a in');
if vrec.b[3]<>'' then
raise jlexception.create('rec.b[3] in');
if vrec.b[4]<>'' then
raise jlexception.create('rec.b[4] in');
vrec:=crecout;
if crecout.a<>vrec.a then
raise jlexception.create('rec.a out');
if crecout.b[3]<>vrec.b[3] then
raise jlexception.create('rec.b[3] out');
if crecout.b[4]<>vrec.b[4] then
raise jlexception.create('rec.b[4] out');
if vshortstring<>'' then
raise jlexception.create('shortstring in');
vshortstring:=cshortstringout;
if vshortstring<>cshortstringout then
raise jlexception.create('shortstring out');
if vunicodestring<>'' then
raise jlexception.create('unicodestring in');
vunicodestring:=cunicodestringout;
if vunicodestring<>cunicodestringout then
raise jlexception.create('unicodestring out');
for i:=low(varrbyte) to high(varrbyte) do
if varrbyte[i]<>0 then
raise jlexception.create('arrbyte in');
varrbyte:=carrbyteout;
for i:=low(carrbyteout) to high(carrbyteout) do
if carrbyteout[i]<>varrbyte[i] then
raise jlexception.create('arrbyte out');
for i:=low(varrset) to high(varrset) do
if varrset[i]<>[] then
raise jlexception.create('arrset in');
varrset:=carrsetout;
for i:=low(carrsetout) to high(carrsetout) do
if varrset[i]<>carrsetout[i] then
raise jlexception.create('arrset out');
end;
procedure testmainthreadvarsafterwards;
var
i: longint;
begin
if venum<>cenumout then
raise jlexception.create('venum out2');
if vboolean<>cbooleanout then
raise jlexception.create('boolean out2');
if vbyte<>cbyteout then
raise jlexception.create('byte out2');
if vsmallint<>csmallintout then
raise jlexception.create('smallint out2');
if vcardinal<>ccardinalout then
raise jlexception.create('cardinal out2');
if vint64<>cint64out then
raise jlexception.create('int64 out2');
if vchar<>ccharout then
raise jlexception.create('char out2');
if vwidechar<>cwidecharout then
raise jlexception.create('widechar out2');
if vsingle<>csingleout then
raise jlexception.create('single out2');
if vdouble<>cdoubleout then
raise jlexception.create('double out2');
if vsetint<>csetintout then
raise jlexception.create('setint out2');
if vsetenum<>csetenumout then
raise jlexception.create('setenum out2');
if crecout.a<>vrec.a then
raise jlexception.create('rec.a out2');
if crecout.b[3]<>vrec.b[3] then
raise jlexception.create('rec.b[3] out2');
if crecout.b[4]<>vrec.b[4] then
raise jlexception.create('rec.b[4] out2');
if vshortstring<>cshortstringout then
raise jlexception.create('shortstring out2');
if vunicodestring<>cunicodestringout then
raise jlexception.create('unicodestring out2');
for i:=low(carrbyteout) to high(carrbyteout) do
if carrbyteout[i]<>varrbyte[i] then
raise jlexception.create('arrbyte out2');
for i:=low(carrsetout) to high(carrsetout) do
if varrset[i]<>carrsetout[i] then
raise jlexception.create('arrset out2');
end;
procedure tmythread.run;
var
i: longint;
begin
if venum<>fboolean then
raise jlexception.create('enum in');
venum:=cenumin;
if venum<>cenumin then
raise jlexception.create('enum out');
if vboolean<>false then
raise jlexception.create('boolean in');
vboolean:=cbooleanin;
if vboolean<>cbooleanin then
raise jlexception.create('boolean out');
if vbyte<>0 then
raise jlexception.create('byte in');
vbyte:=cbytein;
if vbyte<>cbytein then
raise jlexception.create('byte out');
if vsmallint<>0 then
raise jlexception.create('smallint in');
vsmallint:=csmallintin;
if vsmallint<>csmallintin then
raise jlexception.create('smallint out');
if vcardinal<>0 then
raise jlexception.create('cardinal in');
vcardinal:=ccardinalin;
if vcardinal<>ccardinalin then
raise jlexception.create('cardinal out');
if vint64<>0 then
raise jlexception.create('int64 in');
vint64:=cint64in;
if vint64<>cint64in then
raise jlexception.create('int64 out');
if vchar<>#0 then
raise jlexception.create('char in');
vchar:=ccharin;
if vchar<>ccharin then
raise jlexception.create('char out');
if vwidechar<>#0 then
raise jlexception.create('widechar in');
vwidechar:=cwidecharin;
if vwidechar<>cwidecharin then
raise jlexception.create('widechar out');
if vsingle<>0 then
raise jlexception.create('single in');
vsingle:=csinglein;
if vsingle<>csinglein then
raise jlexception.create('single out');
if vdouble<>0 then
raise jlexception.create('double in');
vdouble:=cdoublein;
if vdouble<>cdoublein then
raise jlexception.create('double out');
if vsetint<>[] then
raise jlexception.create('setint in');
vsetint:=csetintin;
if vsetint<>csetintin then
raise jlexception.create('setint out');
if vsetenum<>[] then
raise jlexception.create('setenum in');
vsetenum:=csetenumin;
if vsetenum<>csetenumin then
raise jlexception.create('setenum out');
if vrec.a<>0 then
raise jlexception.create('rec.a in');
if vrec.b[3]<>'' then
raise jlexception.create('rec.b[3] in');
if vrec.b[4]<>'' then
raise jlexception.create('rec.b[4] in');
vrec:=crecin;
if crecin.a<>vrec.a then
raise jlexception.create('rec.a out');
if crecin.b[3]<>vrec.b[3] then
raise jlexception.create('rec.b[3] out');
if crecin.b[4]<>vrec.b[4] then
raise jlexception.create('rec.b[4] out');
if vshortstring<>'' then
raise jlexception.create('shortstring in');
vshortstring:=cshortstringin;
if vshortstring<>cshortstringin then
raise jlexception.create('shortstring out');
if vunicodestring<>'' then
raise jlexception.create('unicodestring in');
vunicodestring:=cunicodestringin;
if vunicodestring<>cunicodestringin then
raise jlexception.create('unicodestring out');
for i:=low(varrbyte) to high(varrbyte) do
if varrbyte[i]<>0 then
raise jlexception.create('arrbyte in');
varrbyte:=carrbytein;
for i:=low(carrbytein) to high(carrbytein) do
if carrbytein[i]<>varrbyte[i] then
raise jlexception.create('arrbyte out');
for i:=low(varrset) to high(varrset) do
if varrset[i]<>[] then
raise jlexception.create('arrset in');
varrset:=carrsetin;
for i:=low(carrsetin) to high(carrsetin) do
if varrset[i]<>carrsetin[i] then
raise jlexception.create('arrset out');
end;
procedure test;
var
t1, t2: tmythread;
begin
checkmainthreadvarsinit;
t1:=tmythread.create;
t1.start;
t2:=tmythread.create;
t2.start;
t1.join;
t2.join;
testmainthreadvarsafterwards;
end;
begin
test;
end.