paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 16:28:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* since enums are represented by classes in the JVM, initialize global

Browse Source 
variables, class/record fields and arrays with enumtype(0) on
    creation, so that using them without explicitly initializing them
    doesn't cause a null-pointer exception. If enumtype(0) is not a
    valid enum, they are not initialized (and since they wouldn't have
    a valid value on native targets either in that case, an exception
    on use is acceptable)

git-svn-id: branches/jvmbackend@18755 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:33:02 +00:00
parent 48710a5a3f
commit 76de70e683
7 changed files with 165 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
compiler/jvm/hlcgcpu.pas
View File

@ -155,7 +155,10 @@ uses
procedure gen_initialize_fields_code(list:TAsmList);
protected
function get_enum_init_val_ref(def: tdef; out ref: treference): boolean;
procedure allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
procedure allocate_enum_with_base_ref(list: TAsmList; vs: tabstractvarsym; const initref: treference; destbaseref: treference);
procedure allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
@ -605,7 +608,8 @@ implementation
procedure thlcgjvm.g_newarray(list: TAsmList; arrdef: tdef; initdim: longint);
var
recref: treference;
recref,
enuminitref: treference;
elemdef: tdef;
i: longint;
mangledname: string;
@ -646,38 +650,47 @@ implementation
for i:=1 to pred(initdim) do
elemdef:=tarraydef(elemdef).elementdef;
if (elemdef.typ in [recorddef,setdef]) or
((elemdef.typ=enumdef) and
get_enum_init_val_ref(elemdef,enuminitref)) or
is_shortstring(elemdef) or
((elemdef.typ=procvardef) and
not tprocvardef(elemdef).is_addressonly) then
begin
{ duplicate array/string/set instance }
{ duplicate array instance }
list.concat(taicpu.op_none(a_dup));
incstack(list,1);
a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
if elemdef.typ in [recorddef,setdef,procvardef] then
begin
tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
case elemdef.typ of
recorddef:
g_call_system_proc(list,'fpc_initialize_array_record');
setdef:
begin
if tsetdef(elemdef).elementdef.typ=enumdef then
g_call_system_proc(list,'fpc_initialize_array_enumset')
else
g_call_system_proc(list,'fpc_initialize_array_bitset')
end;
procvardef:
g_call_system_proc(list,'fpc_initialize_array_procvar');
case elemdef.typ of
recorddef,setdef,procvardef:
begin
tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
case elemdef.typ of
recorddef:
g_call_system_proc(list,'fpc_initialize_array_record');
setdef:
begin
if tsetdef(elemdef).elementdef.typ=enumdef then
g_call_system_proc(list,'fpc_initialize_array_enumset')
else
g_call_system_proc(list,'fpc_initialize_array_bitset')
end;
procvardef:
g_call_system_proc(list,'fpc_initialize_array_procvar');
end;
tg.ungettemp(list,recref);
end;
tg.ungettemp(list,recref);
end
else
begin
a_load_const_stack(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER);
g_call_system_proc(list,'fpc_initialize_array_shortstring');
end;
enumdef:
begin
a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false));
g_call_system_proc(list,'fpc_initialize_array_object');
end;
else
begin
a_load_const_stack(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER);
g_call_system_proc(list,'fpc_initialize_array_shortstring');
end;
end;
decstack(list,3);
end;
end;
@ -1495,6 +1508,14 @@ implementation
g_call_system_proc(list,'fpc_initialize_array_bitset');
tg.ungettemp(list,eleref);
end
else if (t.typ=enumdef) then
begin
if get_enum_init_val_ref(t,eleref) then
begin
a_load_ref_stack(list,java_jlobject,eleref,prepare_stack_for_ref(list,eleref,false));
g_call_system_proc(list,'fpc_initialize_array_object');
end;
end
else
internalerror(2011031901);
end;
@ -1933,11 +1954,35 @@ implementation
tg.ungettemp(list,tmpref);
end;
procedure thlcgjvm.allocate_enum_with_base_ref(list: TAsmList; vs: tabstractvarsym; const initref: treference; destbaseref: treference);
begin
destbaseref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname);
{ only copy the reference, not the actual data }
a_load_ref_ref(list,java_jlobject,java_jlobject,initref,destbaseref);
end;
function thlcgjvm.get_enum_init_val_ref(def: tdef; out ref: treference): boolean;
var
sym: tstaticvarsym;
begin
result:=false;
sym:=tstaticvarsym(tenumdef(def).getbasedef.classdef.symtable.Find('__FPC_ZERO_INITIALIZER'));
{ no enum with ordinal value 0 -> exit }
if not assigned(sym) then
exit;
reference_reset_symbol(ref,current_asmdata.RefAsmSymbol(sym.mangledname),0,4);
result:=true;
end;
procedure thlcgjvm.allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
var
vs: tabstractvarsym;
def: tdef;
i: longint;
initref: treference;
begin
for i:=0 to st.symlist.count-1 do
begin
@ -1951,9 +1996,16 @@ implementation
intialising the constant }
if [vo_is_external,vo_has_local_copy]*vs.varoptions=[vo_is_external] then
continue;
if not jvmimplicitpointertype(vs.vardef) then
continue;
allocate_implicit_struct_with_base_ref(list,vs,ref);
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
constructors or global variables, initialize them with the
enum instance for 0 if it exists (if not, it remains nil since
there is no valid enum value in it) }
else if (vs.vardef.typ=enumdef) and
get_enum_init_val_ref(vs.vardef,initref) then
allocate_enum_with_base_ref(list,vs,initref,ref);
end;
{ process symtables of routines part of this symtable (for local typed
constants) }
@ -1978,6 +2030,7 @@ implementation
procedure thlcgjvm.gen_initialize_fields_code(list: TAsmList);
var
sym: tsym;
selfpara: tparavarsym;
selfreg: tregister;
ref: treference;
@ -1989,12 +2042,17 @@ implementation
{ check whether there are any fields that need initialisation }
needinit:=false;
for i:=0 to obj.symtable.symlist.count-1 do
if (tsym(obj.symtable.symlist[i]).typ=fieldvarsym) and
jvmimplicitpointertype(tfieldvarsym(obj.symtable.symlist[i]).vardef) then
begin
needinit:=true;
break;
end;
begin
sym:=tsym(obj.symtable.symlist[i]);
if (sym.typ=fieldvarsym) and
(jvmimplicitpointertype(tfieldvarsym(sym).vardef) or
((tfieldvarsym(sym).vardef.typ=enumdef) and
get_enum_init_val_ref(tfieldvarsym(sym).vardef,ref))) then
begin
needinit:=true;
break;
end;
end;
if not needinit then
exit;
selfpara:=tparavarsym(current_procinfo.procdef.parast.find('self'));

12
compiler/jvm/njvmcon.pas
View File

@ -101,7 +101,6 @@ implementation
basedef: tenumdef;
sym: tenumsym;
classfield: tsym;
i: longint;
begin
if (resultdef.typ<>enumdef) or
enumconstok then
@ -113,20 +112,15 @@ implementation
{ a) find the enumsym corresponding to the value (may not exist in case
of an explicit typecast of an integer -> error) }
sym:=nil;
basedef:=tenumdef(resultdef).getbasedef;
for i:=0 to tenumdef(resultdef).symtable.symlist.count-1 do
begin
sym:=tenumsym(basedef.symtable.symlist[i]);
if sym.value=value then
break;
sym:=nil;
end;
sym:=tenumsym(tenumdef(resultdef).int2enumsym(int64(value)));
if not assigned(sym) then
begin
Message(parser_e_range_check_error);
result:=nil;
exit;
end;
{ b) find the corresponding class field }
basedef:=tenumdef(resultdef).getbasedef;
classfield:=search_struct_member(basedef.classdef,sym.name);
{ c) create loadnode of the field }

11
compiler/pjvm.pas
View File

@ -270,7 +270,8 @@ implementation
pd: tprocdef;
old_current_structdef: tabstractrecorddef;
i: longint;
sym: tstaticvarsym;
sym,
aliassym: tstaticvarsym;
fsym: tfieldvarsym;
sstate: tscannerstate;
sl: tpropaccesslist;
@ -333,6 +334,14 @@ implementation
fsym:=tfieldvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[]);
enumclass.symtable.insert(fsym);
sym:=make_field_static(enumclass.symtable,fsym);
{ add alias for the field representing ordinal(0), for use in
initialization code }
if tenumsym(tenumdef(def).symtable.symlist[i]).value=0 then
begin
aliassym:=tstaticvarsym.create('__FPC_Zero_Initializer',vs_final,enumclass,[vo_is_external]);
enumclass.symtable.insert(aliassym);
aliassym.set_raw_mangledname(sym.mangledname);
end;
end;
{ create local "array of enumtype" type for the "values" functionality
(used internally by the JDK) }

25
compiler/symdef.pas
View File

@ -737,6 +737,7 @@ interface
function min:asizeint;
function max:asizeint;
function getfirstsym:tsym;
function int2enumsym(l: asizeint): tsym;
{ returns basedef if assigned, otherwise self }
function getbasedef: tenumdef;
end;
@ -1895,6 +1896,30 @@ implementation
end;
function tenumdef.int2enumsym(l: asizeint): tsym;
var
i: longint;
sym: tsym;
bdef: tenumdef;
begin
result:=nil;
if (l<minval) or
(l>maxval) then
exit;
bdef:=getbasedef;
for i:=0 to bdef.symtable.symlist.count-1 do
begin
sym:=tsym(bdef.symtable.symlist[i]);
if (sym.typ=enumsym) and
(tenumsym(sym).value=l) then
begin
result:=sym;
exit;
end;
end;
end;
function tenumdef.getbasedef: tenumdef;
begin
if not assigned(basedef) then

13
compiler/symsym.pas
View File

@ -227,6 +227,7 @@ interface
function mangledname:TSymStr;override;
procedure set_mangledbasename(const s: TSymStr);
procedure set_mangledname(const s:TSymStr);
procedure set_raw_mangledname(const s:TSymStr);
end;
tabsolutevarsym = class(tabstractvarsym)
@ -1623,6 +1624,18 @@ implementation
end;
procedure tstaticvarsym.set_raw_mangledname(const s: TSymStr);
begin
{$ifndef symansistr}
stringdispose(_mangledname);
_mangledname:=stringdup(s);
{$else}
_mangledname:=s;
{$endif}
include(varoptions,vo_has_mangledname);
end;
{****************************************************************************
TLOCALVARSYM
****************************************************************************}

1
rtl/java/compproc.inc
View File

@ -637,6 +637,7 @@ procedure fpc_initialize_array_record(arr: TJObjectArray; normalarrdim: longint;
procedure fpc_initialize_array_procvar(arr: TJObjectArray; normalarrdim: longint; inst: FpcBaseProcVarType);compilerproc;
procedure fpc_initialize_array_bitset(arr: TJObjectArray; normalarrdim: longint; inst: FpcBitSet);compilerproc;
procedure fpc_initialize_array_enumset(arr: TJObjectArray; normalarrdim: longint; inst: JUEnumSet);compilerproc;
procedure fpc_initialize_array_object(arr: TJObjectArray; normalarrdim: longint; inst: JLObject);compilerproc;
procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;
{ set helpers }

21
rtl/java/rtti.inc
View File

@ -148,6 +148,27 @@ procedure fpc_initialize_array_enumset(arr: TJObjectArray; normalarrdim: longint
end;
{ initialize entire array with the same object, without making copies. Used for
initialization with enum instance }
procedure fpc_initialize_array_object_intern(arr: TJObjectArray; normalarrdim: longint; inst: JLObject); external name 'fpc_initialize_array_object';
procedure fpc_initialize_array_object(arr: TJObjectArray; normalarrdim: longint; inst: JLObject);compilerproc;
var
i: longint;
begin
if normalarrdim > 0 then
begin
for i:=low(arr) to high(arr) do
fpc_initialize_array_object_intern(TJObjectArray(arr[i]),normalarrdim-1,inst);
end
else
begin
for i:=low(arr) to high(arr) do
arr[i]:=inst;
end;
end;
procedure fpc_initialize_array_shortstring_intern(arr: TJObjectArray; normalarrdim: longint; maxlen: byte); external name 'fpc_initialize_array_shortstring';
procedure fpc_initialize_array_shortstring(arr: TJObjectArray; normalarrdim: longint; maxlen: byte);compilerproc;