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

* converted all enum handling for the JVM target so that it uses the

Browse Source 
JDK class-style enums rather than plain ordinals like in Pascal
   o for Pascal code, nothing changes, except that for the JVM target
     you can always typecast any enum into a class instance (to interface
     with the JDK)
   o to Java programs, FPC enums look exactly like Java enum types

git-svn-id: branches/jvmbackend@18620 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:15:54 +00:00
parent d64f5d14d6
commit 569228447d
18 changed files with 474 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -228,6 +228,7 @@ compiler/jvm/njvminl.pas svneol=native#text/plain
compiler/jvm/njvmld.pas svneol=native#text/plain
compiler/jvm/njvmmat.pas svneol=native#text/plain
compiler/jvm/njvmmem.pas svneol=native#text/plain
compiler/jvm/njvmset.pas svneol=native#text/plain
compiler/jvm/njvmutil.pas svneol=native#text/plain
compiler/jvm/rgcpu.pas svneol=native#text/plain
compiler/jvm/rjvmcon.inc svneol=native#text/plain

7
compiler/agjasmin.pas
View File

@ -776,7 +776,12 @@ implementation
constnil:
result:='';
else
result:=' = '+ConstValue(csym)
begin
{ enums are initialized as typed constants }
if not assigned(csym.constdef) or
(csym.constdef.typ<>enumdef) then
result:=' = '+ConstValue(csym)
end;
end;
end;

3
compiler/jvm/cpunode.pas
View File

@ -32,7 +32,8 @@ implementation
uses
ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
ncgadd, ncgcal,ncgmat,ncginl,
njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw,njvmld
njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw,njvmld,
njvmset
{ these are not really nodes }
,rgcpu,tgcpu,njvmutil;

5
compiler/jvm/hlcgcpu.pas
View File

@ -250,8 +250,9 @@ implementation
function thlcgjvm.def2regtyp(def: tdef): tregistertype;
begin
case def.typ of
{ records are implemented via classes }
recorddef:
{ records and enums are implemented via classes }
recorddef,
enumdef:
result:=R_ADDRESSREGISTER;
setdef:
if is_smallset(def) then

18
compiler/jvm/njvmadd.pas
View File

@ -57,12 +57,12 @@ interface
uses
systems,
cutils,verbose,constexp,
symtable,symdef,
symconst,symtable,symdef,
paramgr,procinfo,
aasmtai,aasmdata,aasmcpu,defutil,
hlcgobj,hlcgcpu,cgutils,
cpupara,
ncon,nset,nadd,ncal,
ncon,nset,nadd,ncal,ncnv,
cgobj;
{*****************************************************************************
@ -71,6 +71,20 @@ interface
function tjvmaddnode.pass_1: tnode;
begin
{ special handling for enums: they're classes in the JVM -> get their
ordinal value to compare them (do before calling inherited pass_1,
because pass_1 will convert enum constants from ordinals into class
instances) }
if (left.resultdef.typ=enumdef) and
(right.resultdef.typ=enumdef) then
begin
{ enums can only be compared at this stage (add/sub is only allowed
in constant expressions) }
if not is_boolean(resultdef) then
internalerror(2011062603);
inserttypeconv_explicit(left,s32inttype);
inserttypeconv_explicit(right,s32inttype);
end;
result:=inherited pass_1;
if expectloc=LOC_FLAGS then
expectloc:=LOC_JUMP;

105
compiler/jvm/njvmcnv.pas
View File

@ -534,6 +534,42 @@ implementation
left:=nil;
end;
function ord_enum_explicit_typecast(fdef: torddef; todef: tenumdef): tnode;
var
psym: tsym;
begin
{ we only create a class for the basedefs }
todef:=todef.getbasedef;
psym:=search_struct_member(todef.classdef,'FPCVALUEOF');
if not assigned(psym) or
(psym.typ<>procsym) then
internalerror(2011062601);
result:=ccallnode.create(ccallparanode.create(left,nil),
tprocsym(psym),psym.owner,
cloadvmtaddrnode.create(ctypenode.create(todef.classdef)),[]);
{ convert the result to the result type of this type conversion node }
inserttypeconv_explicit(result,resultdef);
{ left is reused }
left:=nil;
end;
function enum_ord_explicit_typecast(fdef: tenumdef; todef: torddef): tnode;
var
psym: tsym;
begin
{ we only create a class for the basedef }
fdef:=fdef.getbasedef;
psym:=search_struct_member(fdef.classdef,'FPCORDINAL');
if not assigned(psym) or
(psym.typ<>procsym) then
internalerror(2011062602);
result:=ccallnode.create(nil,tprocsym(psym),psym.owner,left,[]);
{ convert the result to the result type of this type conversion node }
inserttypeconv_explicit(result,resultdef);
{ left is reused }
left:=nil;
end;
function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;
function check_type_equality(def1,def2: tdef): boolean;
@ -635,6 +671,7 @@ implementation
is_dynamic_array(left.resultdef) or
((left.resultdef.typ in [stringdef,classrefdef]) and
not is_shortstring(left.resultdef)) or
(left.resultdef.typ=enumdef) or
procvarconv;
toclasscompatible:=
(resultdef.typ=pointerdef) or
@ -642,6 +679,7 @@ implementation
is_dynamic_array(resultdef) or
((resultdef.typ in [stringdef,classrefdef]) and
not is_shortstring(resultdef)) or
(resultdef.typ=enumdef) or
procvarconv;
{ typescasts from void (the result of untyped_ptr^) to an implicit
pointertype (record, array, ...) also needs a typecheck }
@ -668,6 +706,11 @@ implementation
fromdef:=left.resultdef;
todef:=resultdef;
get_most_nested_types(fromdef,todef);
{ in case of enums, get the equivalent class definitions }
if (fromdef.typ=enumdef) then
fromdef:=tenumdef(fromdef).getbasedef;
if (todef.typ=enumdef) then
todef:=tenumdef(todef).getbasedef;
fromarrtype:=jvmarrtype_setlength(fromdef);
toarrtype:=jvmarrtype_setlength(todef);
if not ptr_no_typecheck_required(fromdef,todef) then
@ -723,6 +766,8 @@ implementation
begin
if (convtype<>tc_int_2_real) then
begin
if (left.resultdef.typ=enumdef) then
inserttypeconv_explicit(left,s32inttype);
if not check_only then
resnode:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE');
result:=true;
@ -731,12 +776,48 @@ implementation
result:=false;
exit;
end;
{ nothing special required when going between ordinals and enums }
if (left.resultdef.typ in [orddef,enumdef]) and
(resultdef.typ in [orddef,enumdef]) then
{ enums }
if (left.resultdef.typ=enumdef) or
(resultdef.typ=enumdef) then
begin
result:=false;
exit;
{ both enum? }
if (resultdef.typ=left.resultdef.typ) then
begin
{ same base type -> nothing special }
fromdef:=tenumdef(left.resultdef).getbasedef;
todef:=tenumdef(resultdef).getbasedef;
if fromdef=todef then
begin
result:=false;
exit;
end;
{ convert via ordinal intermediate }
if not check_only then
begin;
inserttypeconv_explicit(left,s32inttype);
inserttypeconv_explicit(left,resultdef);
resnode:=left;
left:=nil
end;
result:=true;
exit;
end;
{ enum to orddef & vice versa }
if left.resultdef.typ=orddef then
begin
if not check_only then
resnode:=ord_enum_explicit_typecast(torddef(left.resultdef),tenumdef(resultdef));
result:=true;
exit;
end
else if resultdef.typ=orddef then
begin
if not check_only then
resnode:=enum_ord_explicit_typecast(tenumdef(left.resultdef),torddef(resultdef));
result:=true;
exit;
end
end;
{$ifndef nounsupported}
@ -792,6 +873,16 @@ implementation
function tjvmtypeconvnode.target_specific_general_typeconv: boolean;
begin
result:=false;
{ on the JVM platform, enums can always be converted to class instances,
because enums /are/ class instances there. To prevent the
typechecking/conversion code from assuming it can treat it like any
ordinal constant, firstpass() it so that the ordinal constant gets
replaced with a load of a staticvarsym. This is not done in
pass_typecheck, because that would prevent many optimizations }
if (left.nodetype=ordconstn) and
(left.resultdef.typ=enumdef) and
(resultdef.typ=objectdef) then
firstpass(left);
{$ifndef nounsupported}
{ generated in nmem; replace voidpointertype with java_jlobject }
if nf_load_procvar in flags then
@ -913,7 +1004,9 @@ implementation
if checkdef=voidpointertype then
checkdef:=java_jlobject
else if checkdef.typ=pointerdef then
checkdef:=tpointerdef(checkdef).pointeddef;
checkdef:=tpointerdef(checkdef).pointeddef
else if checkdef.typ=enumdef then
checkdef:=tenumdef(checkdef).classdef;
{$ifndef nounsupported}
if checkdef.typ=procvardef then
checkdef:=java_jlobject

74
compiler/jvm/njvmcon.pas
View File

@ -30,6 +30,16 @@ interface
node,ncon,ncgcon;
type
tjvmordconstnode = class(tcgordconstnode)
{ normally, we convert the enum constant into a load of the
appropriate enum class field in pass_1. In some cases (array index),
we want to keep it as an enum constant however }
enumconstok: boolean;
function pass_1: tnode; override;
function docompare(p: tnode): boolean; override;
function dogetcopy: tnode; override;
end;
tjvmrealconstnode = class(tcgrealconstnode)
procedure pass_generate_code;override;
end;
@ -43,14 +53,73 @@ interface
implementation
uses
globtype,cutils,widestr,verbose,
globtype,cutils,widestr,verbose,constexp,
symdef,symsym,symtable,symconst,
aasmdata,aasmcpu,defutil,
ncal,
ncal,nld,
cgbase,hlcgobj,hlcgcpu,cgutils,cpubase
;
{*****************************************************************************
TJVMORDCONSTNODE
*****************************************************************************}
function tjvmordconstnode.pass_1: tnode;
var
basedef: tenumdef;
sym: tenumsym;
classfield: tsym;
i: longint;
begin
if (resultdef.typ<>enumdef) or
enumconstok then
begin
result:=inherited pass_1;
exit;
end;
{ convert into JVM class instance }
{ 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;
if not assigned(sym) then
begin
Message(parser_e_range_check_error);
exit;
end;
{ b) find the corresponding class field }
classfield:=search_struct_member(basedef.classdef,sym.name);
if not assigned(classfield) or
(classfield.typ<>staticvarsym) then
internalerror(2011062606);
{ c) create loadnode of the field }
result:=cloadnode.create(classfield,classfield.owner);
end;
function tjvmordconstnode.docompare(p: tnode): boolean;
begin
result:=inherited docompare(p);
if result then
result:=(enumconstok=tjvmordconstnode(p).enumconstok);
end;
function tjvmordconstnode.dogetcopy: tnode;
begin
result:=inherited dogetcopy;
tjvmordconstnode(result).enumconstok:=enumconstok;
end;
{*****************************************************************************
TJVMREALCONSTNODE
*****************************************************************************}
@ -136,6 +205,7 @@ implementation
begin
cordconstnode:=tjvmordconstnode;
crealconstnode:=tjvmrealconstnode;
cstringconstnode:=tjvmstringconstnode;
end.

59
compiler/jvm/njvmflw.pas
View File

@ -26,9 +26,13 @@ unit njvmflw;
interface
uses
aasmbase,node,nflw;
aasmbase,node,nflw,ncgflw;
type
tjvmfornode = class(tcgfornode)
function pass_1: tnode; override;
end;
tjvmraisenode = class(traisenode)
function pass_typecheck: tnode; override;
procedure pass_generate_code;override;
@ -53,11 +57,61 @@ implementation
symconst,symdef,symsym,aasmtai,aasmdata,aasmcpu,defutil,jvmdef,
procinfo,cgbase,pass_2,parabase,
cpubase,cpuinfo,
nld,ncon,
nbas,nld,ncon,ncnv,
tgobj,paramgr,
cgutils,hlcgobj,hlcgcpu
;
{*****************************************************************************
TFJVMFORNODE
*****************************************************************************}
function tjvmfornode.pass_1: tnode;
var
iteratortmp: ttempcreatenode;
olditerator: tnode;
block,
newbody: tblocknode;
stat,
newbodystat: tstatementnode;
begin
{ transform for-loops with enums to:
for tempint:=ord(lowval) to ord(upperval) do
begin
originalctr:=tenum(tempint);
<original loop body>
end;
enums are class instances in Java and hence can't be increased or so.
The type conversion consists of an array lookup in a final method,
so it shouldn't be too expensive.
}
if left.resultdef.typ=enumdef then
begin
block:=internalstatements(stat);
iteratortmp:=ctempcreatenode.create(s32inttype,left.resultdef.size,tt_persistent,true);
addstatement(stat,iteratortmp);
olditerator:=left;
left:=ctemprefnode.create(iteratortmp);
inserttypeconv_explicit(right,s32inttype);
inserttypeconv_explicit(t1,s32inttype);
newbody:=internalstatements(newbodystat);
addstatement(newbodystat,cassignmentnode.create(olditerator,
ctypeconvnode.create_explicit(ctemprefnode.create(iteratortmp),
olditerator.resultdef)));
addstatement(newbodystat,t2);
addstatement(stat,cfornode.create(left,right,t1,newbody,lnf_backward in loopflags));
addstatement(stat,ctempdeletenode.create(iteratortmp));
left:=nil;
right:=nil;
t1:=nil;
t2:=nil;
result:=block
end
else
result:=inherited pass_1;
end;
{*****************************************************************************
SecondRaise
*****************************************************************************}
@ -425,6 +479,7 @@ implementation
end;
begin
cfornode:=tjvmfornode;
craisenode:=tjvmraisenode;
ctryexceptnode:=tjvmtryexceptnode;
ctryfinallynode:=tjvmtryfinallynode;

36
compiler/jvm/njvmmem.pas
View File

@ -57,7 +57,7 @@ implementation
cutils,verbose,constexp,
symconst,symtype,symtable,symsym,symdef,defutil,jvmdef,
htypechk,
nadd,ncal,ncnv,ncon,pass_1,
nadd,ncal,ncnv,ncon,pass_1,njvmcon,
aasmdata,aasmcpu,pass_2,
cgutils,hlcgobj,hlcgcpu;
@ -235,12 +235,21 @@ implementation
exit;
end
else
result:=inherited;
begin
{ keep indices that are enum constants that way, rather than
transforming them into a load of the class instance that
represents this constant (since we then would have to extract
the int constant value again at run time anyway) }
if right.nodetype=ordconstn then
tjvmordconstnode(right).enumconstok:=true;
result:=inherited;
end;
end;
procedure tjvmvecnode.pass_generate_code;
var
psym: tsym;
newsize: tcgsize;
begin
if left.resultdef.typ=stringdef then
@ -269,6 +278,29 @@ implementation
if (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
(right.location.reference.arrayreftype<>art_none) then
hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
{ replace enum class instance with the corresponding integer value }
if (right.resultdef.typ=enumdef) then
begin
if (right.location.loc<>LOC_CONSTANT) then
begin
psym:=search_struct_member(tenumdef(right.resultdef).classdef,'FPCORDINAL');
if not assigned(psym) or
(psym.typ<>procsym) or
(tprocsym(psym).ProcdefList.count<>1) then
internalerror(2011062607);
thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,false);
{ call replaces self parameter with longint result -> no stack
height change }
location_reset(right.location,LOC_REGISTER,OS_S32);
right.location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,s32inttype);
thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,s32inttype,right.location.register);
end;
{ always force to integer location, because enums are handled as
object instances (since that's what they are in Java) }
right.resultdef:=s32inttype;
right.location.size:=OS_S32;
end;
{ adjust index if necessary }
if not is_special_array(left.resultdef) and

64
compiler/jvm/njvmset.pas Normal file
View File

@ -0,0 +1,64 @@
{
Copyright (c) 2011 by Jonas Maebe
Generate JVM bytecode for in set/case nodes
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit njvmset;
{$i fpcdefs.inc}
interface
uses
globtype,
node,nset,ncgset;
type
tjvmcasenode = class(tcgcasenode)
function pass_1: tnode; override;
end;
implementation
uses
symconst,symdef,
pass_1,
ncnv;
{*****************************************************************************
TJVMCASENODE
*****************************************************************************}
function tjvmcasenode.pass_1: tnode;
begin
{ convert case expression to an integer in case it's an enum, since
enums are class instances in the JVM. All labels are stored as
ordinal values, so it doesn't matter that we change the type }
if left.resultdef.typ=enumdef then
inserttypeconv_explicit(left,s32inttype);
result:=inherited pass_1;
end;
begin
ccasenode:=tjvmcasenode;
end.

5
compiler/jvmdef.pas
View File

@ -204,7 +204,10 @@ implementation
result:=false;
end;
end;
enumdef,
enumdef:
begin
result:=jvmaddencodedtype(tenumdef(def).classdef,false,encodedstr,forcesignature,founderror);
end;
orddef :
begin
{ for procedure "results" }

2
compiler/ncgld.pas
View File

@ -309,6 +309,7 @@ implementation
staticvarsym :
begin
gvs:=tstaticvarsym(symtableentry);
{$ifndef jvm}
if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then
begin
{ assume external variables use the default alignment }
@ -319,6 +320,7 @@ implementation
exit;
end
else
{$endif jvm}
begin
location.reference.alignment:=var_align(gvs.vardef.alignment);
end;

8
compiler/ncnv.pas
View File

@ -2221,6 +2221,14 @@ implementation
{ structured types }
if not(
(left.resultdef.typ=formaldef) or
{$ifdef jvm}
{ enums /are/ class instances on the JVM
platform }
(((left.resultdef.typ=enumdef) and
(resultdef.typ=objectdef)) or
((resultdef.typ=enumdef) and
(left.resultdef.typ=objectdef))) or
{$endif}
(
not(is_open_array(left.resultdef)) and
not(is_array_constructor(left.resultdef)) and

12
compiler/ninl.pas
View File

@ -2992,7 +2992,10 @@ implementation
expectloc:=LOC_REGISTER;
{ in case of range/overflow checking, use a regular addnode
because it's too complex to handle correctly otherwise }
{$ifndef jvm}
{ enums are class instances in the JVM -> always need conversion }
if ([cs_check_overflow,cs_check_range]*current_settings.localswitches)<>[] then
{$endif}
begin
{ create constant 1 }
hp:=cordconstnode.create(1,left.resultdef,false);
@ -3053,11 +3056,16 @@ implementation
{ range/overflow checking doesn't work properly }
{ with the inc/dec code that's generated (JM) }
if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) and
if ((current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) and
{ No overflow check for pointer operations, because inc(pointer,-1) will always
trigger an overflow. For uint32 it works because then the operation is done
in 64bit. Range checking is not applicable to pointers either }
(tcallparanode(left).left.resultdef.typ<>pointerdef) then
(tcallparanode(left).left.resultdef.typ<>pointerdef))
{$ifdef jvm}
{ enums are class instances on the JVM -> special treatment }
or (tcallparanode(left).left.resultdef.typ=enumdef)
{$endif}
then
{ convert to simple add (JM) }
begin
newblock := internalstatements(newstatement);

11
compiler/pdecl.pas
View File

@ -71,6 +71,9 @@ implementation
{ parser }
scanner,
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
{$ifdef jvm}
pjvm,
{$endif}
{ cpu-information }
cpuinfo
;
@ -204,6 +207,14 @@ implementation
sym.deprecatedmsg:=deprecatedmsg;
sym.visibility:=symtablestack.top.currentvisibility;
symtablestack.top.insert(sym);
{$ifdef jvm}
{ for the JVM target, some constants need to be
initialized at run time (enums, sets) -> create fake
typed const to do so }
if assigned(tconstsym(sym).constdef) and
(tconstsym(sym).constdef.typ=enumdef) then
jvm_add_typed_const_initializer(tconstsym(sym));
{$endif}
end
else
stringdispose(deprecatedmsg);

47
compiler/pjvm.pas
View File

@ -28,7 +28,7 @@ interface
uses
globtype,
symtype,symbase,symdef;
symtype,symbase,symdef,symsym;
{ the JVM specs require that you add a default parameterless
constructor in case the programmer hasn't specified any }
@ -41,6 +41,7 @@ interface
procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
procedure jvm_add_typed_const_initializer(csym: tconstsym);
implementation
@ -49,9 +50,9 @@ implementation
cutils,cclasses,
verbose,systems,
fmodule,
parabase,
parabase,aasmdata,
pdecsub,
symtable,symconst,symsym,symcreat,defcmp,jvmdef,
symtable,symconst,symcreat,defcmp,jvmdef,
defutil,paramgr;
@ -329,4 +330,44 @@ implementation
restore_scanner(sstate);
end;
procedure jvm_add_typed_const_initializer(csym: tconstsym);
var
ssym: tstaticvarsym;
esym: tenumsym;
i: longint;
sstate: symcreat.tscannerstate;
begin
case csym.constdef.typ of
enumdef:
begin
replace_scanner('jvm_enum_const',sstate);
{ make sure we don't emit a definition for this field (we'll do
that for the constsym already) -> mark as external }
ssym:=tstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,csym.constdef,[vo_is_external]);
csym.owner.insert(ssym);
{ alias storage to the constsym }
ssym.set_mangledname(csym.realname);
for i:=0 to tenumdef(csym.constdef).symtable.symlist.count-1 do
begin
esym:=tenumsym(tenumdef(csym.constdef).symtable.symlist[i]);
if esym.value=csym.value.valueord.svalue then
break;
esym:=nil;
end;
{ can happen in case of explicit typecast from integer constant
to enum type }
if not assigned(esym) then
begin
MessagePos(csym.fileinfo,parser_e_range_check_error);
exit;
end;
str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],esym.name+';',ssym);
restore_scanner(sstate);
end
else
internalerror(2011062701);
end;
end;
end.

30
compiler/symcreat.pas
View File

@ -61,6 +61,15 @@ interface
}
function str_parse_method_impl(str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
{ parses a typed constant assignment to ssym
WARNINGS:
* save the scanner state before calling this routine, and restore when done.
* the code *must* be written in objfpc style
}
procedure str_parse_typedconst(list: TAsmList; str: ansistring; ssym: tstaticvarsym);
{ in the JVM, constructors are not automatically inherited (so you can hide
them). To emulate the Pascal behaviour, we have to automatically add
@ -209,6 +218,27 @@ implementation
end;
procedure str_parse_typedconst(list: TAsmList; str: ansistring; ssym: tstaticvarsym);
var
old_block_type: tblock_type;
old_parse_only: boolean;
begin
Message1(parser_d_internal_parser_string,str);
{ a string that will be interpreted as the start of a new section ->
typed constant parsing will stop }
str:=str+'type ';
old_parse_only:=parse_only;
old_block_type:=block_type;
parse_only:=true;
block_type:=bt_const;
current_scanner.substitutemacro('typed_const_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
current_scanner.readtoken(false);
read_typed_const(list,ssym,ssym.owner.symtabletype in [recordsymtable,objectsymtable]);
parse_only:=old_parse_only;
block_type:=old_block_type;
end;
procedure add_missing_parent_constructors_intf(obj: tobjectdef; forcevis: tvisibility);
var
parent: tobjectdef;

11
compiler/symdef.pas
View File

@ -701,6 +701,8 @@ interface
function min:asizeint;
function max:asizeint;
function getfirstsym:tsym;
{ returns basedef if assigned, otherwise self }
function getbasedef: tenumdef;
end;
tsetdef = class(tstoreddef)
@ -1844,6 +1846,15 @@ implementation
end;
function tenumdef.getbasedef: tenumdef;
begin
if not assigned(basedef) then
result:=self
else
result:=basedef;
end;
procedure tenumdef.buildderef;
begin
inherited buildderef;