mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-01-22 11:09:10 +01:00
* rtti/init table updates
* rttisym for reusable global rtti/init info * support published for interfaces
This commit is contained in:
peter
parent
7aff068a92
commit
f88f6eb571
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/22]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/30]
|
||||
#
|
||||
default: all
|
||||
override PATH:=$(subst \,/,$(PATH))
|
||||
@ -681,15 +681,22 @@ override FPCOPT+=-gl
|
||||
override FPCOPTDEF+=DEBUG
|
||||
endif
|
||||
ifdef RELEASE
|
||||
override FPCOPT+=-Xs -OG2p3 -n
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
FPCCPUOPT:=-OG2p3
|
||||
else
|
||||
FPCCPUOPT:=
|
||||
endif
|
||||
override FPCOPT+=-Xs $(FPCCPUOPT) -n
|
||||
override FPCOPTDEF+=RELEASE
|
||||
endif
|
||||
ifdef STRIP
|
||||
override FPCOPT+=-Xs
|
||||
endif
|
||||
ifdef OPTIMIZE
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
override FPCOPT+=-OG2p3
|
||||
endif
|
||||
endif
|
||||
ifdef VERBOSE
|
||||
override FPCOPT+=-vwni
|
||||
endif
|
||||
@ -865,7 +872,7 @@ endif
|
||||
ifdef LIB_NAME
|
||||
-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
|
||||
endif
|
||||
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
|
||||
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
|
||||
fpc_distclean: clean
|
||||
ifdef COMPILER_UNITTARGETDIR
|
||||
TARGETDIRCLEAN=fpc_clean
|
||||
|
||||
@ -1646,11 +1646,10 @@ implementation
|
||||
else
|
||||
begin
|
||||
reset_reference(hr);
|
||||
hr.symbol:=tstoreddef(t).get_inittable_label;
|
||||
hr.symbol:=tstoreddef(t).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(hr);
|
||||
if is_already_ref then
|
||||
exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L,
|
||||
newreference(ref)))
|
||||
exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L,newreference(ref)))
|
||||
else
|
||||
emitpushreferenceaddr(ref);
|
||||
emitcall('FPC_INITIALIZE');
|
||||
@ -1667,7 +1666,7 @@ implementation
|
||||
|
||||
begin
|
||||
if is_ansistring(t) or
|
||||
is_widestring(t) then
|
||||
is_widestring(t) then
|
||||
begin
|
||||
decrstringref(t,ref);
|
||||
end
|
||||
@ -1678,7 +1677,7 @@ implementation
|
||||
else
|
||||
begin
|
||||
reset_reference(r);
|
||||
r.symbol:=tstoreddef(t).get_inittable_label;
|
||||
r.symbol:=tstoreddef(t).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(r);
|
||||
if is_already_ref then
|
||||
exprasmList.concat(Taicpu.Op_ref(A_PUSH,S_L,
|
||||
@ -1751,7 +1750,7 @@ implementation
|
||||
else
|
||||
begin
|
||||
reset_reference(hr);
|
||||
hr.symbol:=tstoreddef(tvarsym(p).vartype.def).get_inittable_label;
|
||||
hr.symbol:=tstoreddef(tvarsym(p).vartype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(hr);
|
||||
emitpushreferenceaddr(hrv);
|
||||
emitcall('FPC_ADDREF');
|
||||
@ -1803,7 +1802,7 @@ implementation
|
||||
else
|
||||
begin
|
||||
reset_reference(hr);
|
||||
hr.symbol:=tstoreddef(tvarsym(p).vartype.def).get_inittable_label;
|
||||
hr.symbol:=tstoreddef(tvarsym(p).vartype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(hr);
|
||||
emitpushreferenceaddr(hrv);
|
||||
emitcall('FPC_DECREF');
|
||||
@ -2561,7 +2560,7 @@ implementation
|
||||
emitinsertcall('FPC_FINALIZE');
|
||||
ungetregister32(R_EDI);
|
||||
exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_ESI));
|
||||
exprasmList.insert(Taicpu.Op_sym(A_PUSH,S_L,procinfo^._class.get_inittable_label));
|
||||
exprasmList.insert(Taicpu.Op_sym(A_PUSH,S_L,procinfo^._class.get_rtti_label(initrtti)));
|
||||
ai:=Taicpu.Op_sym(A_Jcc,S_NO,nofinal);
|
||||
ai.SetCondition(C_Z);
|
||||
exprasmList.insert(ai);
|
||||
@ -2984,7 +2983,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2001-08-29 12:01:47 jonas
|
||||
Revision 1.4 2001-08-30 20:13:57 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.3 2001/08/29 12:01:47 jonas
|
||||
+ support for int64 LOC_REGISTERS in remove_non_regvars_from_loc
|
||||
|
||||
Revision 1.2 2001/08/26 13:36:52 florian
|
||||
|
||||
@ -522,19 +522,16 @@ implementation
|
||||
|
||||
in_typeinfo_x:
|
||||
begin
|
||||
tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).generate_rtti;
|
||||
location.register:=getregister32;
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).rtti_label;
|
||||
r^.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).get_rtti_label(fullrtti);
|
||||
emit_ref_reg(A_LEA,S_L,r,location.register);
|
||||
end;
|
||||
|
||||
in_finalize_x:
|
||||
begin
|
||||
pushusedregisters(pushed,$ff);
|
||||
{ force rtti generation }
|
||||
tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).generate_rtti;
|
||||
{ if a count is passed, push size, typeinfo and count }
|
||||
if assigned(tcallparanode(left).right) then
|
||||
begin
|
||||
@ -547,7 +544,7 @@ implementation
|
||||
|
||||
{ generate a reference }
|
||||
reset_reference(hr);
|
||||
hr.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).rtti_label;
|
||||
hr.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(hr);
|
||||
|
||||
{ data to finalize }
|
||||
@ -642,7 +639,7 @@ implementation
|
||||
emitpushreferenceaddr(hr2);
|
||||
push_int(l);
|
||||
reset_reference(hr2);
|
||||
hr2.symbol:=tstoreddef(def).get_inittable_label;
|
||||
hr2.symbol:=tstoreddef(def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(hr2);
|
||||
emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
|
||||
saveregvars($ff);
|
||||
@ -882,7 +879,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.22 2001-08-28 13:24:47 jonas
|
||||
Revision 1.23 2001-08-30 20:13:57 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.22 2001/08/28 13:24:47 jonas
|
||||
+ compilerproc implementation of most string-related type conversions
|
||||
- removed all code from the compiler which has been replaced by
|
||||
compilerproc implementations (using {$ifdef hascompilerproc} is not
|
||||
|
||||
@ -643,7 +643,7 @@ implementation
|
||||
{ increment source reference counter }
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=tstoreddef(right.resulttype.def).get_inittable_label;
|
||||
r^.symbol:=tstoreddef(right.resulttype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(r^);
|
||||
|
||||
emitpushreferenceaddr(right.location.reference);
|
||||
@ -651,7 +651,7 @@ implementation
|
||||
{ decrement destination reference counter }
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=tstoreddef(left.resulttype.def).get_inittable_label;
|
||||
r^.symbol:=tstoreddef(left.resulttype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(r^);
|
||||
emitpushreferenceaddr(left.location.reference);
|
||||
emitcall('FPC_DECREF');
|
||||
@ -1088,7 +1088,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 2001-08-30 11:57:20 michael
|
||||
Revision 1.21 2001-08-30 20:13:57 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.20 2001/08/30 11:57:20 michael
|
||||
+ Patch for wrong paramsize
|
||||
|
||||
Revision 1.19 2001/08/26 13:36:59 florian
|
||||
|
||||
@ -149,7 +149,7 @@ implementation
|
||||
begin
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_inittable_label;
|
||||
r^.symbol:=tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(r^);
|
||||
dispose(r);
|
||||
{ push pointer we just allocated, we need to initialize the
|
||||
@ -223,7 +223,7 @@ implementation
|
||||
begin
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_inittable_label;
|
||||
r^.symbol:=tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(r^);
|
||||
dispose(r);
|
||||
{ push pointer adress }
|
||||
@ -243,7 +243,7 @@ implementation
|
||||
begin
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_inittable_label;
|
||||
r^.symbol:=tstoreddef(tpointerdef(left.resulttype.def).pointertype.def).get_rtti_label(initrtti);
|
||||
emitpushreferenceaddr(r^);
|
||||
dispose(r);
|
||||
emit_push_loc(left.location);
|
||||
@ -1055,7 +1055,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2001-08-26 13:37:00 florian
|
||||
Revision 1.16 2001-08-30 20:13:57 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.15 2001/08/26 13:37:00 florian
|
||||
* some cg reorganisation
|
||||
* some PPC updates
|
||||
|
||||
|
||||
@ -42,6 +42,7 @@ Type
|
||||
ExeCmd,
|
||||
DllCmd : array[1..3] of string[100];
|
||||
ResName : string[12];
|
||||
ScriptName : string[12];
|
||||
ExtraOptions : string;
|
||||
DynamicLinker : string[100];
|
||||
end;
|
||||
@ -105,6 +106,7 @@ begin
|
||||
{ set generic defaults }
|
||||
FillChar(Info,sizeof(Info),0);
|
||||
Info.ResName:='link.res';
|
||||
Info.ScriptName:='script.res';
|
||||
{ set the linker specific defaults }
|
||||
SetDefaultInfo;
|
||||
{ Allow Parameter overrides for linker info }
|
||||
@ -483,7 +485,12 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 2001-08-19 11:22:22 peter
|
||||
Revision 1.22 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.21 2001/08/19 11:22:22 peter
|
||||
* palmos support from v10 merged
|
||||
|
||||
Revision 1.20 2001/08/13 19:26:03 peter
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/22]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/30]
|
||||
#
|
||||
default: all
|
||||
override PATH:=$(subst \,/,$(PATH))
|
||||
@ -680,15 +680,22 @@ override FPCOPT+=-gl
|
||||
override FPCOPTDEF+=DEBUG
|
||||
endif
|
||||
ifdef RELEASE
|
||||
override FPCOPT+=-Xs -OG2p3 -n
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
FPCCPUOPT:=-OG2p3
|
||||
else
|
||||
FPCCPUOPT:=
|
||||
endif
|
||||
override FPCOPT+=-Xs $(FPCCPUOPT) -n
|
||||
override FPCOPTDEF+=RELEASE
|
||||
endif
|
||||
ifdef STRIP
|
||||
override FPCOPT+=-Xs
|
||||
endif
|
||||
ifdef OPTIMIZE
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
override FPCOPT+=-OG2p3
|
||||
endif
|
||||
endif
|
||||
ifdef VERBOSE
|
||||
override FPCOPT+=-vwni
|
||||
endif
|
||||
@ -864,7 +871,7 @@ endif
|
||||
ifdef LIB_NAME
|
||||
-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
|
||||
endif
|
||||
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
|
||||
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
|
||||
fpc_distclean: clean
|
||||
ifdef COMPILER_UNITTARGETDIR
|
||||
TARGETDIRCLEAN=fpc_clean
|
||||
|
||||
@ -1146,7 +1146,6 @@ implementation
|
||||
{$endif WITHDMT}
|
||||
interfacetable : tasmlabel;
|
||||
begin
|
||||
|
||||
{$ifdef WITHDMT}
|
||||
dmtlabel:=gendmt;
|
||||
{$endif WITHDMT}
|
||||
@ -1160,9 +1159,6 @@ implementation
|
||||
begin
|
||||
methodnametable:=genpublishedmethodstable;
|
||||
fieldtablelabel:=_class.generate_field_table;
|
||||
{ rtti }
|
||||
if (oo_can_have_published in _class.objectoptions) then
|
||||
_class.generate_rtti;
|
||||
{ write class name }
|
||||
getdatalabel(classnamelabel);
|
||||
dataSegment.concat(Tai_label.Create(classnamelabel));
|
||||
@ -1234,20 +1230,11 @@ implementation
|
||||
dataSegment.concat(Tai_const_symbol.Create(fieldtablelabel));
|
||||
{ pointer to type info of published section }
|
||||
if (oo_can_have_published in _class.objectoptions) then
|
||||
dataSegment.concat(Tai_const_symbol.Createname(_class.rtti_name))
|
||||
dataSegment.concat(Tai_const_symbol.Create(_class.get_rtti_label(fullrtti)))
|
||||
else
|
||||
dataSegment.concat(Tai_const.Create_32bit(0));
|
||||
{ inittable for con-/destruction }
|
||||
{
|
||||
if _class.needs_inittable then
|
||||
}
|
||||
{ we generate the init table for classes always, because needs_inittable }
|
||||
{ for classes is always false, it applies only for objects }
|
||||
dataSegment.concat(Tai_const_symbol.Create(_class.get_inittable_label));
|
||||
{
|
||||
else
|
||||
dataSegment.concat(Tai_const.Create_32bit(0));
|
||||
}
|
||||
{ inittable for con-/destruction, for classes this is always generated }
|
||||
dataSegment.concat(Tai_const_symbol.Create(_class.get_rtti_label(initrtti)));
|
||||
{ auto table }
|
||||
dataSegment.concat(Tai_const.Create_32bit(0));
|
||||
{ interface table }
|
||||
@ -1273,7 +1260,12 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2001-08-22 21:16:20 florian
|
||||
Revision 1.3 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.2 2001/08/22 21:16:20 florian
|
||||
* some interfaces related problems regarding
|
||||
mapping of interface implementions fixed
|
||||
|
||||
|
||||
@ -1297,8 +1297,6 @@ end;
|
||||
procedure read_arguments(cmd:string);
|
||||
var
|
||||
configpath : pathstr;
|
||||
s : string;
|
||||
i : integer;
|
||||
begin
|
||||
option:=coption.create;
|
||||
disable_configfile:=false;
|
||||
@ -1597,7 +1595,12 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.56 2001-08-20 10:58:48 florian
|
||||
Revision 1.57 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.56 2001/08/20 10:58:48 florian
|
||||
* renamed messages unit to cmsgs to avoid conflicts with the
|
||||
win32 messages unit
|
||||
|
||||
|
||||
@ -52,11 +52,11 @@ implementation
|
||||
globtype,tokens,verbose,
|
||||
systems,
|
||||
{ aasm }
|
||||
aasm,
|
||||
aasm,fmodule,
|
||||
{ symtable }
|
||||
symconst,symbase,symtype,symdef,symtable,
|
||||
{ pass 1 }
|
||||
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
|
||||
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
|
||||
{ parser }
|
||||
scanner,
|
||||
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj;
|
||||
@ -374,8 +374,10 @@ implementation
|
||||
sym : tsym;
|
||||
srsymtable : tsymtable;
|
||||
tt : ttype;
|
||||
oldfilepos,
|
||||
defpos,storetokenpos : tfileposinfo;
|
||||
old_block_type : tblock_type;
|
||||
ch : tclassheader;
|
||||
begin
|
||||
old_block_type:=block_type;
|
||||
block_type:=bt_type;
|
||||
@ -408,6 +410,7 @@ implementation
|
||||
{ the definition is modified }
|
||||
object_dec(orgtypename,tobjectdef(ttypesym(sym).restype.def));
|
||||
newtype:=ttypesym(sym);
|
||||
tt:=newtype.restype;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -437,15 +440,15 @@ implementation
|
||||
assigned(tt.def) and (tt.def.deftype=recorddef) and (tt.def.size=16) then
|
||||
rec_tguid:=trecorddef(tt.def);
|
||||
end;
|
||||
if assigned(newtype.restype.def) then
|
||||
if assigned(tt.def) then
|
||||
begin
|
||||
case newtype.restype.def.deftype of
|
||||
case tt.def.deftype of
|
||||
pointerdef :
|
||||
begin
|
||||
consume(_SEMICOLON);
|
||||
if try_to_consume(_FAR) then
|
||||
begin
|
||||
tpointerdef(newtype.restype.def).is_far:=true;
|
||||
tpointerdef(tt.def).is_far:=true;
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
end;
|
||||
@ -465,6 +468,47 @@ implementation
|
||||
consume(_SEMICOLON);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Write tables if we are the typesym that defines
|
||||
this type. This will not be done for simple type renamings }
|
||||
if (tt.def.typesym=newtype) then
|
||||
begin
|
||||
{ file position }
|
||||
oldfilepos:=aktfilepos;
|
||||
aktfilepos:=newtype.fileinfo;
|
||||
|
||||
{ generate rtti info for classes, but not for forward classes }
|
||||
if (tt.def.deftype=objectdef) and
|
||||
(oo_can_have_published in tobjectdef(tt.def).objectoptions) and
|
||||
not(oo_is_forward in tobjectdef(tt.def).objectoptions) then
|
||||
generate_rtti(newtype);
|
||||
|
||||
{ generate persistent init/final tables when it's declared in the interface so it can
|
||||
be reused in other used }
|
||||
if (not current_module.in_implementation) and
|
||||
(tt.def.needs_inittable or
|
||||
is_class(tt.def)) then
|
||||
generate_inittable(newtype);
|
||||
|
||||
{ for objects we should write the vmt and interfaces.
|
||||
This need to be done after the rtti has been written, because
|
||||
it can contain a reference to that data (PFV)
|
||||
This is not for forward classes }
|
||||
if (tt.def.deftype=objectdef) and
|
||||
not(oo_is_forward in tobjectdef(tt.def).objectoptions) then
|
||||
begin
|
||||
if (cs_create_smart in aktmoduleswitches) then
|
||||
dataSegment.concat(Tai_cut.Create);
|
||||
ch:=cclassheader.create(tobjectdef(tt.def));
|
||||
if is_interface(tobjectdef(tt.def)) then
|
||||
ch.writeinterfaceids;
|
||||
if (oo_has_vmt in tobjectdef(tt.def).objectoptions) then
|
||||
ch.writevmt;
|
||||
ch.free;
|
||||
end;
|
||||
|
||||
aktfilepos:=oldfilepos;
|
||||
end;
|
||||
until token<>_ID;
|
||||
typecanbeforward:=false;
|
||||
symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}resolve_type_forward);
|
||||
@ -551,7 +595,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 2001-06-03 21:57:35 peter
|
||||
Revision 1.32 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.31 2001/06/03 21:57:35 peter
|
||||
+ hint directive parsing support
|
||||
|
||||
Revision 1.30 2001/05/08 21:06:31 florian
|
||||
|
||||
@ -39,7 +39,7 @@ implementation
|
||||
globals,verbose,systems,tokens,
|
||||
aasm,symconst,symbase,symsym,symtable,types,
|
||||
cgbase,
|
||||
node,nld,ncon,ncnv,nobj,pass_1,
|
||||
node,nld,ncon,ncnv,pass_1,
|
||||
scanner,
|
||||
pbase,pexpr,pdecsub,pdecvar,ptype;
|
||||
|
||||
@ -534,9 +534,10 @@ implementation
|
||||
procedure setclassattributes;
|
||||
|
||||
begin
|
||||
if classtype=odt_class then
|
||||
{ publishable }
|
||||
if classtype in [odt_interfacecom,odt_class] then
|
||||
begin
|
||||
aktclass.objecttype:=odt_class;
|
||||
aktclass.objecttype:=classtype;
|
||||
if (cs_generate_rtti in aktlocalswitches) or
|
||||
(assigned(aktclass.childof) and
|
||||
(oo_can_have_published in aktclass.childof.objectoptions)) then
|
||||
@ -829,7 +830,6 @@ implementation
|
||||
|
||||
var
|
||||
temppd : tprocdef;
|
||||
ch : tclassheader;
|
||||
begin
|
||||
{Nowadays aktprocsym may already have a value, so we need to save
|
||||
it.}
|
||||
@ -1007,9 +1007,6 @@ implementation
|
||||
until false;
|
||||
current_object_option:=[sp_public];
|
||||
end;
|
||||
testcurobject:=0;
|
||||
curobjectname:='';
|
||||
typecanbeforward:=storetypecanbeforward;
|
||||
|
||||
{ generate vmt space if needed }
|
||||
if not(oo_has_vmt in aktclass.objectoptions) and
|
||||
@ -1017,19 +1014,14 @@ implementation
|
||||
(classtype in [odt_class])
|
||||
) then
|
||||
aktclass.insertvmt;
|
||||
if (cs_create_smart in aktmoduleswitches) then
|
||||
dataSegment.concat(Tai_cut.Create);
|
||||
|
||||
ch:=cclassheader.create(aktclass);
|
||||
if is_interface(aktclass) then
|
||||
ch.writeinterfaceids;
|
||||
if (oo_has_vmt in aktclass.objectoptions) then
|
||||
ch.writevmt;
|
||||
ch.free;
|
||||
|
||||
if is_interface(aktclass) then
|
||||
setinterfacemethodoptions;
|
||||
|
||||
{ reset }
|
||||
testcurobject:=0;
|
||||
curobjectname:='';
|
||||
typecanbeforward:=storetypecanbeforward;
|
||||
{ restore old state }
|
||||
symtablestack:=symtablestack.next;
|
||||
aktobjectdef:=nil;
|
||||
@ -1045,7 +1037,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.28 2001-08-26 13:36:44 florian
|
||||
Revision 1.29 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.28 2001/08/26 13:36:44 florian
|
||||
* some cg reorganisation
|
||||
* some PPC updates
|
||||
|
||||
|
||||
@ -170,7 +170,10 @@ implementation
|
||||
end
|
||||
else
|
||||
read_type(tt,'');
|
||||
if (variantrecordlevel>0) and tt.def.needs_inittable then
|
||||
{ types that use init/final are not allowed in variant parts, but
|
||||
classes are allowed }
|
||||
if (variantrecordlevel>0) and
|
||||
(tt.def.needs_inittable and not is_class(tt.def)) then
|
||||
Message(parser_e_cant_use_inittable_here);
|
||||
ignore_equal:=false;
|
||||
symdone:=false;
|
||||
@ -550,7 +553,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 2001-07-01 20:16:16 peter
|
||||
Revision 1.19 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.18 2001/07/01 20:16:16 peter
|
||||
* alignmentinfo record added
|
||||
* -Oa argument supports more alignment settings that can be specified
|
||||
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
|
||||
|
||||
@ -91,6 +91,7 @@ const
|
||||
iblabelsym = 30;
|
||||
ibfuncretsym = 31;
|
||||
ibsyssym = 32;
|
||||
ibrttisym = 33;
|
||||
{definitions}
|
||||
iborddef = 40;
|
||||
ibpointerdef = 41;
|
||||
@ -985,7 +986,12 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 2001-06-27 21:37:36 peter
|
||||
Revision 1.12 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.11 2001/06/27 21:37:36 peter
|
||||
* v10 merges
|
||||
|
||||
Revision 1.10 2001/06/18 20:36:25 peter
|
||||
|
||||
@ -84,9 +84,13 @@ procedure insert_intern_types(p : tsymtable);
|
||||
all the types inserted into the system unit
|
||||
}
|
||||
|
||||
procedure addtype(const s:string;const t:ttype);
|
||||
function addtype(const s:string;const t:ttype):ttypesym;
|
||||
begin
|
||||
p.insert(ttypesym.create(s,t));
|
||||
result:=ttypesym.create(s,t);
|
||||
p.insert(result);
|
||||
{ add init/final table if required }
|
||||
if t.def.needs_inittable then
|
||||
generate_inittable(result);
|
||||
end;
|
||||
|
||||
procedure adddef(const s:string;def:tdef);
|
||||
@ -271,7 +275,12 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 2001-07-30 20:59:27 peter
|
||||
Revision 1.19 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.18 2001/07/30 20:59:27 peter
|
||||
* m68k updates from v10 merged
|
||||
|
||||
Revision 1.17 2001/07/09 21:15:41 peter
|
||||
|
||||
@ -59,6 +59,8 @@ implementation
|
||||
{ global }
|
||||
globals,tokens,verbose,
|
||||
systems,
|
||||
{ aasm }
|
||||
aasm,
|
||||
{ symtable }
|
||||
symconst,symbase,symdef,symsym,symtable,types,
|
||||
{ pass 1 }
|
||||
@ -602,7 +604,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.29 2001-08-12 22:10:16 peter
|
||||
Revision 1.30 2001-08-30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.29 2001/08/12 22:10:16 peter
|
||||
* write name in original case when type not found
|
||||
|
||||
Revision 1.28 2001/07/09 21:15:41 peter
|
||||
|
||||
@ -110,12 +110,8 @@ type
|
||||
sp_static,
|
||||
sp_hint_deprecated,
|
||||
sp_hint_platform,
|
||||
sp_hint_library
|
||||
{ is there any use for this constants }
|
||||
{ else sp_has_overloaded can be moved up FK }
|
||||
,sp_7
|
||||
,sp_8
|
||||
,sp_9
|
||||
sp_hint_library,
|
||||
sp_has_overloaded
|
||||
,sp_10
|
||||
,sp_11
|
||||
,sp_12
|
||||
@ -131,14 +127,13 @@ type
|
||||
,sp_22
|
||||
,sp_23
|
||||
,sp_24
|
||||
,sp_has_overloaded
|
||||
);
|
||||
tsymoptions=set of tsymoption;
|
||||
|
||||
{ flags for a definition }
|
||||
tdefoption=(df_none,
|
||||
df_need_rtti, { the definitions needs rtti }
|
||||
df_has_rtti { the rtti is generated }
|
||||
df_has_inittable, { init data has been generated }
|
||||
df_has_rttitable { rtti data has been generated }
|
||||
,df_3
|
||||
,df_4
|
||||
,df_5
|
||||
@ -393,7 +388,7 @@ type
|
||||
tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,
|
||||
constsym,enumsym,typedconstsym,errorsym,syssym,
|
||||
labelsym,absolutesym,propertysym,funcretsym,
|
||||
macrosym);
|
||||
macrosym,rttisym);
|
||||
|
||||
{ State of the variable, if it's declared, assigned or used }
|
||||
tvarstate=(vs_none,
|
||||
@ -409,6 +404,11 @@ type
|
||||
constresourcestring,constwstring,constwchar
|
||||
);
|
||||
|
||||
{ RTTI information to store }
|
||||
trttitype = (
|
||||
fullrtti,initrtti
|
||||
);
|
||||
|
||||
{$ifdef GDB}
|
||||
type
|
||||
tdefstabstatus = (
|
||||
@ -446,14 +446,19 @@ const
|
||||
('abstractsym','variable','type','proc','unit',
|
||||
'const','enum','typed const','errorsym','system sym',
|
||||
'label','absolute','property','funcret',
|
||||
'macrosym');
|
||||
'macrosym','rttisym');
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.22 2001-08-19 21:11:21 florian
|
||||
Revision 1.23 2001-08-30 20:13:54 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.22 2001/08/19 21:11:21 florian
|
||||
* some bugs fix:
|
||||
- overload; with external procedures fixed
|
||||
- better selection of routine to do an overloaded
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -58,6 +58,7 @@ interface
|
||||
destructor destroy;override;
|
||||
procedure write(ppufile:tcompilerppufile);virtual;abstract;
|
||||
procedure writesym(ppufile:tcompilerppufile);
|
||||
procedure deref;override;
|
||||
function mangledname : string;override;
|
||||
procedure insert_in_data;virtual;
|
||||
{$ifdef GDB}
|
||||
@ -288,6 +289,17 @@ interface
|
||||
{$endif GDB}
|
||||
end;
|
||||
|
||||
{ compiler generated symbol to point to rtti and init/finalize tables }
|
||||
trttisym = class(tstoredsym)
|
||||
lab : tasmsymbol;
|
||||
rttityp : trttitype;
|
||||
constructor create(const n:string;rt:trttitype);
|
||||
constructor load(ppufile:tcompilerppufile);
|
||||
procedure write(ppufile:tcompilerppufile);override;
|
||||
function mangledname:string;override;
|
||||
function get_label:tasmsymbol;
|
||||
end;
|
||||
|
||||
{ register variables }
|
||||
pregvarinfo = ^tregvarinfo;
|
||||
tregvarinfo = record
|
||||
@ -321,6 +333,12 @@ interface
|
||||
current_object_option : tsymoptions = [sp_public];
|
||||
|
||||
|
||||
{ rtti and init/final }
|
||||
procedure generate_rtti(p:tsym);
|
||||
procedure generate_inittable(p:tsym);
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -394,6 +412,11 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tstoredsym.deref;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure tstoredsym.load_references(ppufile:tcompilerppufile;locals:boolean);
|
||||
var
|
||||
pos : tfileposinfo;
|
||||
@ -2237,10 +2260,144 @@ implementation
|
||||
{$endif GDB}
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TRTTISYM
|
||||
****************************************************************************}
|
||||
|
||||
constructor trttisym.create(const n:string;rt:trttitype);
|
||||
const
|
||||
prefix : array[trttitype] of string[5]=('$rtti','$init');
|
||||
begin
|
||||
inherited create(prefix[rt]+n);
|
||||
typ:=rttisym;
|
||||
lab:=nil;
|
||||
rttityp:=rt;
|
||||
end;
|
||||
|
||||
|
||||
constructor trttisym.load(ppufile:tcompilerppufile);
|
||||
begin
|
||||
inherited loadsym(ppufile);
|
||||
typ:=rttisym;
|
||||
lab:=nil;
|
||||
rttityp:=trttitype(ppufile.getbyte);
|
||||
end;
|
||||
|
||||
|
||||
procedure trttisym.write(ppufile:tcompilerppufile);
|
||||
begin
|
||||
inherited writesym(ppufile);
|
||||
ppufile.putbyte(byte(rttityp));
|
||||
ppufile.writeentry(ibrttisym);
|
||||
end;
|
||||
|
||||
|
||||
function trttisym.mangledname : string;
|
||||
const
|
||||
prefix : array[trttitype] of string[5]=('RTTI_','INIT_');
|
||||
var
|
||||
s : string;
|
||||
p : tsymtable;
|
||||
begin
|
||||
s:='';
|
||||
p:=owner;
|
||||
while assigned(p) and (p.symtabletype=localsymtable) do
|
||||
begin
|
||||
s:=s+'_'+p.defowner.name;
|
||||
p:=p.defowner.owner;
|
||||
end;
|
||||
if not(p.symtabletype in [globalsymtable,staticsymtable]) then
|
||||
internalerror(200108265);
|
||||
mangledname:=prefix[rttityp]+p.name^+s+'$_'+Copy(name,5,255);
|
||||
end;
|
||||
|
||||
|
||||
function trttisym.get_label:tasmsymbol;
|
||||
begin
|
||||
{ the label is always a global label }
|
||||
if not assigned(lab) then
|
||||
lab:=newasmsymboltype(mangledname,AB_GLOBAL,AT_DATA);
|
||||
get_label:=lab;
|
||||
end;
|
||||
|
||||
|
||||
{ persistent rtti generation }
|
||||
procedure generate_rtti(p:tsym);
|
||||
var
|
||||
rsym : trttisym;
|
||||
def : tstoreddef;
|
||||
begin
|
||||
{ rtti can only be generated for classes that are always typesyms }
|
||||
if not(p.typ=typesym) then
|
||||
internalerror(200108261);
|
||||
def:=tstoreddef(ttypesym(p).restype.def);
|
||||
{ only create rtti once for each definition }
|
||||
if not(df_has_rttitable in def.defoptions) then
|
||||
begin
|
||||
{ definition should be in the same symtable as the symbol }
|
||||
if p.owner<>def.owner then
|
||||
internalerror(200108262);
|
||||
{ create rttisym }
|
||||
rsym:=trttisym.create(p.name,fullrtti);
|
||||
p.owner.insert(rsym);
|
||||
{ register rttisym in definition }
|
||||
include(def.defoptions,df_has_rttitable);
|
||||
def.rttitablesym:=rsym;
|
||||
{ write rtti data }
|
||||
def.write_child_rtti_data(fullrtti);
|
||||
rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
|
||||
def.write_rtti_data(fullrtti);
|
||||
rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ persistent init table generation }
|
||||
procedure generate_inittable(p:tsym);
|
||||
var
|
||||
rsym : trttisym;
|
||||
def : tstoreddef;
|
||||
begin
|
||||
{ anonymous types are also allowed for records that can be varsym }
|
||||
case p.typ of
|
||||
typesym :
|
||||
def:=tstoreddef(ttypesym(p).restype.def);
|
||||
varsym :
|
||||
def:=tstoreddef(tvarsym(p).vartype.def);
|
||||
else
|
||||
internalerror(200108263);
|
||||
end;
|
||||
{ only create inittable once for each definition }
|
||||
if not(df_has_inittable in def.defoptions) then
|
||||
begin
|
||||
{ definition should be in the same symtable as the symbol }
|
||||
if p.owner<>def.owner then
|
||||
internalerror(200108264);
|
||||
{ create rttisym }
|
||||
rsym:=trttisym.create(p.name,initrtti);
|
||||
p.owner.insert(rsym);
|
||||
{ register rttisym in definition }
|
||||
include(def.defoptions,df_has_inittable);
|
||||
def.inittablesym:=rsym;
|
||||
{ write inittable data }
|
||||
def.write_child_rtti_data(initrtti);
|
||||
rttiList.concat(Tai_symbol.Create(rsym.get_label,0));
|
||||
def.write_rtti_data(initrtti);
|
||||
rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 2001-08-26 13:36:50 florian
|
||||
Revision 1.20 2001-08-30 20:13:54 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.19 2001/08/26 13:36:50 florian
|
||||
* some cg reorganisation
|
||||
* some PPC updates
|
||||
|
||||
|
||||
@ -381,6 +381,7 @@ implementation
|
||||
ibunitsym : sym:=tunitsym.load(ppufile);
|
||||
iblabelsym : sym:=tlabelsym.load(ppufile);
|
||||
ibsyssym : sym:=tsyssym.load(ppufile);
|
||||
ibrttisym : sym:=trttisym.load(ppufile);
|
||||
ibendsyms : break;
|
||||
ibend : Message(unit_f_ppu_read_error);
|
||||
else
|
||||
@ -2071,7 +2072,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.42 2001-08-26 13:36:51 florian
|
||||
Revision 1.43 2001-08-30 20:13:56 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.42 2001/08/26 13:36:51 florian
|
||||
* some cg reorganisation
|
||||
* some PPC updates
|
||||
|
||||
|
||||
@ -64,9 +64,10 @@ interface
|
||||
|
||||
tdef = class(tdefentry)
|
||||
typesym : tsym; { which type the definition was generated this def }
|
||||
defoptions : tdefoptions;
|
||||
constructor create;
|
||||
procedure deref;virtual;
|
||||
procedure derefimpl;virtual;
|
||||
procedure deref;virtual;abstract;
|
||||
procedure derefimpl;virtual;abstract;
|
||||
function typename:string;
|
||||
function gettypename:string;virtual;
|
||||
function size:longint;virtual;abstract;
|
||||
@ -74,7 +75,6 @@ interface
|
||||
function getsymtable(t:tgetsymtable):tsymtable;virtual;
|
||||
function is_publishable:boolean;virtual;abstract;
|
||||
function needs_inittable:boolean;virtual;abstract;
|
||||
function get_rtti_label : string;virtual;abstract;
|
||||
end;
|
||||
|
||||
{************************************************
|
||||
@ -89,7 +89,7 @@ interface
|
||||
constructor create(const n : string);
|
||||
destructor destroy;override;
|
||||
function realname:string;
|
||||
procedure deref;virtual;
|
||||
procedure deref;virtual;abstract;
|
||||
function gettypedef:tdef;virtual;
|
||||
function mangledname : string;virtual;abstract;
|
||||
end;
|
||||
@ -153,6 +153,7 @@ implementation
|
||||
deftype:=abstractdef;
|
||||
owner := nil;
|
||||
typesym := nil;
|
||||
defoptions:=[];
|
||||
end;
|
||||
|
||||
|
||||
@ -174,17 +175,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tdef.deref;
|
||||
begin
|
||||
resolvesym(typesym);
|
||||
end;
|
||||
|
||||
|
||||
procedure tdef.derefimpl;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function tdef.getsymtable(t:tgetsymtable):tsymtable;
|
||||
begin
|
||||
getsymtable:=nil;
|
||||
@ -203,6 +193,7 @@ implementation
|
||||
inherited createname(upper(n));
|
||||
_realname:=stringdup(n);
|
||||
typ:=abstractsym;
|
||||
symoptions:=[];
|
||||
end;
|
||||
|
||||
|
||||
@ -213,11 +204,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tsym.deref;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function tsym.realname : string;
|
||||
begin
|
||||
if assigned(_realname) then
|
||||
@ -501,7 +487,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2001-08-06 21:40:49 peter
|
||||
Revision 1.9 2001-08-30 20:13:57 peter
|
||||
* rtti/init table updates
|
||||
* rttisym for reusable global rtti/init info
|
||||
* support published for interfaces
|
||||
|
||||
Revision 1.8 2001/08/06 21:40:49 peter
|
||||
* funcret moved from tprocinfo to tprocdef
|
||||
|
||||
Revision 1.7 2001/05/06 14:49:19 peter
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/22]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/30]
|
||||
#
|
||||
default: all
|
||||
override PATH:=$(subst \,/,$(PATH))
|
||||
@ -623,15 +623,22 @@ override FPCOPT+=-gl
|
||||
override FPCOPTDEF+=DEBUG
|
||||
endif
|
||||
ifdef RELEASE
|
||||
override FPCOPT+=-Xs -OG2p3 -n
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
FPCCPUOPT:=-OG2p3
|
||||
else
|
||||
FPCCPUOPT:=
|
||||
endif
|
||||
override FPCOPT+=-Xs $(FPCCPUOPT) -n
|
||||
override FPCOPTDEF+=RELEASE
|
||||
endif
|
||||
ifdef STRIP
|
||||
override FPCOPT+=-Xs
|
||||
endif
|
||||
ifdef OPTIMIZE
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
override FPCOPT+=-OG2p3
|
||||
endif
|
||||
endif
|
||||
ifdef VERBOSE
|
||||
override FPCOPT+=-vwni
|
||||
endif
|
||||
@ -828,7 +835,7 @@ endif
|
||||
ifdef LIB_NAME
|
||||
-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
|
||||
endif
|
||||
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
|
||||
-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
|
||||
fpc_distclean: clean
|
||||
ifdef COMPILER_UNITTARGETDIR
|
||||
TARGETDIRCLEAN=fpc_clean
|
||||
|
||||
Loading…
Reference in New Issue
Block a user