mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-06 05:10:52 +02:00
compiler:
- move objname, objrealname fields from tobjectdef to tabstractrecorddef, - load and save them from/to ppu file, - use tabstarctrecorddef in some more places where previously code worked for tobjectdef - change push_nested_hierarchy, pop_nested_hierarchy to handle records too git-svn-id: branches/paul/extended_records@16519 -
This commit is contained in:
paul
parent
d7c8d9e620
commit
26cef34005
@ -65,10 +65,10 @@ interface
|
||||
{ helper functions - they insert nested objects hierarcy to the symtablestack
|
||||
with object hierarchy
|
||||
}
|
||||
function push_child_hierarcy(obj:tobjectdef):integer;
|
||||
function pop_child_hierarchy(obj:tobjectdef):integer;
|
||||
function push_nested_hierarchy(obj:tobjectdef):integer;
|
||||
function pop_nested_hierarchy(obj:tobjectdef):integer;
|
||||
function push_child_hierarcy(obj:tabstractrecorddef):integer;
|
||||
function pop_child_hierarchy(obj:tabstractrecorddef):integer;
|
||||
function push_nested_hierarchy(obj:tabstractrecorddef):integer;
|
||||
function pop_nested_hierarchy(obj:tabstractrecorddef):integer;
|
||||
|
||||
implementation
|
||||
|
||||
@ -97,15 +97,21 @@ implementation
|
||||
Declaring it as string here results in an error when compiling (PFV) }
|
||||
current_procinfo = 'error';
|
||||
|
||||
function push_child_hierarcy(obj:tobjectdef):integer;
|
||||
function push_child_hierarcy(obj:tabstractrecorddef):integer;
|
||||
var
|
||||
_class,hp : tobjectdef;
|
||||
begin
|
||||
if obj.typ=recorddef then
|
||||
begin
|
||||
symtablestack.push(obj.symtable);
|
||||
result:=1;
|
||||
exit;
|
||||
end;
|
||||
result:=0;
|
||||
{ insert class hierarchy in the reverse order }
|
||||
hp:=nil;
|
||||
repeat
|
||||
_class:=obj;
|
||||
_class:=tobjectdef(obj);
|
||||
while _class.childof<>hp do
|
||||
_class:=_class.childof;
|
||||
hp:=_class;
|
||||
@ -114,20 +120,26 @@ implementation
|
||||
until hp=obj;
|
||||
end;
|
||||
|
||||
function push_nested_hierarchy(obj:tobjectdef):integer;
|
||||
function push_nested_hierarchy(obj:tabstractrecorddef):integer;
|
||||
begin
|
||||
result:=0;
|
||||
if obj.owner.symtabletype=ObjectSymtable then
|
||||
inc(result,push_nested_hierarchy(tobjectdef(obj.owner.defowner)));
|
||||
if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then
|
||||
inc(result,push_nested_hierarchy(tabstractrecorddef(obj.owner.defowner)));
|
||||
inc(result,push_child_hierarcy(obj));
|
||||
end;
|
||||
|
||||
function pop_child_hierarchy(obj:tobjectdef):integer;
|
||||
function pop_child_hierarchy(obj:tabstractrecorddef):integer;
|
||||
var
|
||||
_class : tobjectdef;
|
||||
begin
|
||||
if obj.typ=recorddef then
|
||||
begin
|
||||
symtablestack.pop(obj.symtable);
|
||||
result:=1;
|
||||
exit;
|
||||
end;
|
||||
result:=0;
|
||||
_class:=obj;
|
||||
_class:=tobjectdef(obj);
|
||||
while assigned(_class) do
|
||||
begin
|
||||
symtablestack.pop(_class.symtable);
|
||||
@ -136,11 +148,11 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
function pop_nested_hierarchy(obj:tobjectdef):integer;
|
||||
function pop_nested_hierarchy(obj:tabstractrecorddef):integer;
|
||||
begin
|
||||
result:=pop_child_hierarchy(obj);
|
||||
if obj.owner.symtabletype=ObjectSymtable then
|
||||
inc(result,pop_nested_hierarchy(tobjectdef(obj.owner.defowner)));
|
||||
if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then
|
||||
inc(result,pop_nested_hierarchy(tabstractrecorddef(obj.owner.defowner)));
|
||||
end;
|
||||
|
||||
procedure insert_funcret_para(pd:tabstractprocdef);
|
||||
|
||||
@ -1608,8 +1608,8 @@ implementation
|
||||
Message(type_e_ordinal_expr_expected);
|
||||
consume(_OF);
|
||||
|
||||
UnionSymtable:=trecordsymtable.create(current_settings.packrecords);
|
||||
UnionDef:=trecorddef.create(unionsymtable);
|
||||
UnionSymtable:=trecordsymtable.create('',current_settings.packrecords);
|
||||
UnionDef:=trecorddef.create('',unionsymtable);
|
||||
uniondef.isunion:=true;
|
||||
startvarrecsize:=UnionSymtable.datasize;
|
||||
{ align the bitpacking to the next byte }
|
||||
|
||||
@ -43,7 +43,7 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
CurrentPPUVersion = 121;
|
||||
CurrentPPUVersion = 122;
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
|
||||
@ -347,8 +347,8 @@ implementation
|
||||
end;
|
||||
addtype('$s64currency',s64currencytype);
|
||||
{ Add a type for virtual method tables }
|
||||
hrecst:=trecordsymtable.create(current_settings.packrecords);
|
||||
vmttype:=trecorddef.create(hrecst);
|
||||
hrecst:=trecordsymtable.create('',current_settings.packrecords);
|
||||
vmttype:=trecorddef.create('',hrecst);
|
||||
pvmttype:=tpointerdef.create(vmttype);
|
||||
{ can't use addtype for pvmt because the rtti of the pointed
|
||||
type is not available. The rtti for pvmt will be written implicitly
|
||||
@ -371,10 +371,10 @@ implementation
|
||||
tarraydef(vmtarraytype).elementdef:=pvmttype;
|
||||
addtype('$vtblarray',vmtarraytype);
|
||||
{ Add a type for methodpointers }
|
||||
hrecst:=trecordsymtable.create(1);
|
||||
hrecst:=trecordsymtable.create('',1);
|
||||
addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
|
||||
addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
|
||||
methodpointertype:=trecorddef.create(hrecst);
|
||||
methodpointertype:=trecorddef.create('',hrecst);
|
||||
addtype('$methodpointer',methodpointertype);
|
||||
symtablestack.pop(systemunit);
|
||||
end;
|
||||
|
||||
@ -871,15 +871,15 @@ implementation
|
||||
end;
|
||||
|
||||
{ reads a record declaration }
|
||||
function record_dec : tdef;
|
||||
function record_dec(const n:tidstring):tdef;
|
||||
var
|
||||
old_current_structdef : tabstractrecorddef;
|
||||
recst : trecordsymtable;
|
||||
begin
|
||||
old_current_structdef:=current_structdef;
|
||||
{ create recdef }
|
||||
recst:=trecordsymtable.create(current_settings.packrecords);
|
||||
current_structdef:=trecorddef.create(recst);
|
||||
recst:=trecordsymtable.create(n,current_settings.packrecords);
|
||||
current_structdef:=trecorddef.create(n,recst);
|
||||
result:=current_structdef;
|
||||
{ insert in symtablestack }
|
||||
symtablestack.push(recst);
|
||||
@ -890,8 +890,7 @@ implementation
|
||||
recst.addalignmentpadding;
|
||||
{ restore symtable stack }
|
||||
symtablestack.pop(recst);
|
||||
if trecorddef(record_dec).is_packed and
|
||||
is_managed_type(record_dec) then
|
||||
if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then
|
||||
Message(type_e_no_packed_inittable);
|
||||
current_structdef:=old_current_structdef;
|
||||
end;
|
||||
@ -1314,7 +1313,7 @@ implementation
|
||||
end;
|
||||
_RECORD:
|
||||
begin
|
||||
def:=record_dec;
|
||||
def:=record_dec(name);
|
||||
end;
|
||||
_PACKED,
|
||||
_BITPACKED:
|
||||
@ -1349,7 +1348,7 @@ implementation
|
||||
def:=object_dec(odt_object,name,genericdef,genericlist,nil);
|
||||
end;
|
||||
else
|
||||
def:=record_dec;
|
||||
def:=record_dec(name);
|
||||
end;
|
||||
current_settings.packrecords:=oldpackrecords;
|
||||
end;
|
||||
|
||||
@ -171,9 +171,15 @@ interface
|
||||
{ tabstractrecorddef }
|
||||
|
||||
tabstractrecorddef= class(tstoreddef)
|
||||
objname,
|
||||
objrealname: PShortString;
|
||||
symtable : TSymtable;
|
||||
cloneddef : tabstractrecorddef;
|
||||
cloneddefderef : tderef;
|
||||
constructor create(const n:string; dt:tdeftyp);
|
||||
constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
|
||||
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
||||
destructor destroy; override;
|
||||
function GetSymtable(t:tGetSymtable):TSymtable;override;
|
||||
function is_packed:boolean;
|
||||
function RttiName: string;
|
||||
@ -182,7 +188,7 @@ interface
|
||||
trecorddef = class(tabstractrecorddef)
|
||||
public
|
||||
isunion : boolean;
|
||||
constructor create(p : TSymtable);
|
||||
constructor create(const n:string; p:TSymtable);
|
||||
constructor ppuload(ppufile:tcompilerppufile);
|
||||
destructor destroy;override;
|
||||
function getcopy : tstoreddef;override;
|
||||
@ -246,8 +252,6 @@ interface
|
||||
|
||||
{ for C++ classes: name of the library this class is imported from }
|
||||
import_lib,
|
||||
objname,
|
||||
objrealname,
|
||||
{ for Objective-C: protocols and classes can have the same name there }
|
||||
objextname : pshortstring;
|
||||
objectoptions : tobjectoptions;
|
||||
@ -274,7 +278,7 @@ interface
|
||||
classref_created_in_current_module : boolean;
|
||||
{ store implemented interfaces defs and name mappings }
|
||||
ImplementedInterfaces : TFPObjectList;
|
||||
constructor create(ot : tobjecttyp;const n : string;c : tobjectdef);
|
||||
constructor create(ot:tobjecttyp;const n:string;c:tobjectdef);
|
||||
constructor ppuload(ppufile:tcompilerppufile);
|
||||
destructor destroy;override;
|
||||
function getcopy : tstoreddef;override;
|
||||
@ -869,11 +873,11 @@ implementation
|
||||
st:=st.defowner.owner;
|
||||
end;
|
||||
{ object/classes symtable, nested type definitions in classes require the while loop }
|
||||
while st.symtabletype=ObjectSymtable do
|
||||
while st.symtabletype in [ObjectSymtable,recordsymtable] do
|
||||
begin
|
||||
if st.defowner.typ<>objectdef then
|
||||
if not (st.defowner.typ in [objectdef,recorddef]) then
|
||||
internalerror(200204174);
|
||||
prefix:=tobjectdef(st.defowner).objname^+'_$_'+prefix;
|
||||
prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
|
||||
st:=st.defowner.owner;
|
||||
end;
|
||||
{ symtable must now be static or global }
|
||||
@ -2554,6 +2558,33 @@ implementation
|
||||
tabstractrecorddef
|
||||
***************************************************************************}
|
||||
|
||||
constructor tabstractrecorddef.create(const n:string; dt:tdeftyp);
|
||||
begin
|
||||
inherited create(dt);
|
||||
objname:=stringdup(upper(n));
|
||||
objrealname:=stringdup(n);
|
||||
end;
|
||||
|
||||
constructor tabstractrecorddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
|
||||
begin
|
||||
inherited ppuload(dt,ppufile);
|
||||
objrealname:=stringdup(ppufile.getstring);
|
||||
objname:=stringdup(upper(objrealname^));
|
||||
end;
|
||||
|
||||
procedure tabstractrecorddef.ppuwrite(ppufile: tcompilerppufile);
|
||||
begin
|
||||
inherited ppuwrite(ppufile);
|
||||
ppufile.putstring(objrealname^);
|
||||
end;
|
||||
|
||||
destructor tabstractrecorddef.destroy;
|
||||
begin
|
||||
stringdispose(objname);
|
||||
stringdispose(objrealname);
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
function tabstractrecorddef.GetSymtable(t:tGetSymtable):TSymtable;
|
||||
begin
|
||||
if t=gs_record then
|
||||
@ -2572,14 +2603,14 @@ implementation
|
||||
var
|
||||
tmp: tabstractrecorddef;
|
||||
begin
|
||||
Result:=typename;
|
||||
Result:=objrealname^;
|
||||
tmp:=self;
|
||||
repeat
|
||||
if tmp.owner.symtabletype in [ObjectSymtable,recordsymtable] then
|
||||
tmp:=tabstractrecorddef(tmp.owner.defowner)
|
||||
else
|
||||
break;
|
||||
Result:=tmp.typename+'.'+Result;
|
||||
Result:=tmp.objrealname^+'.'+Result;
|
||||
until tmp=nil;
|
||||
end;
|
||||
|
||||
@ -2588,9 +2619,9 @@ implementation
|
||||
trecorddef
|
||||
***************************************************************************}
|
||||
|
||||
constructor trecorddef.create(p : TSymtable);
|
||||
constructor trecorddef.create(const n:string; p:TSymtable);
|
||||
begin
|
||||
inherited create(recorddef);
|
||||
inherited create(n,recorddef);
|
||||
symtable:=p;
|
||||
{ we can own the symtable only if nobody else owns a copy so far }
|
||||
if symtable.refcount=1 then
|
||||
@ -2606,7 +2637,7 @@ implementation
|
||||
ppufile.getderef(cloneddefderef)
|
||||
else
|
||||
begin
|
||||
symtable:=trecordsymtable.create(0);
|
||||
symtable:=trecordsymtable.create(objrealname^,0);
|
||||
trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
|
||||
trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
|
||||
trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
|
||||
@ -2633,7 +2664,7 @@ implementation
|
||||
|
||||
function trecorddef.getcopy : tstoreddef;
|
||||
begin
|
||||
result:=trecorddef.create(symtable.getcopy);
|
||||
result:=trecorddef.create(objrealname^,symtable.getcopy);
|
||||
trecorddef(result).isunion:=isunion;
|
||||
include(trecorddef(result).defoptions,df_copied_def);
|
||||
end;
|
||||
@ -3933,9 +3964,9 @@ implementation
|
||||
TOBJECTDEF
|
||||
***************************************************************************}
|
||||
|
||||
constructor tobjectdef.create(ot : tobjecttyp;const n : string;c : tobjectdef);
|
||||
constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef);
|
||||
begin
|
||||
inherited create(objectdef);
|
||||
inherited create(n,objectdef);
|
||||
fcurrent_dispid:=0;
|
||||
objecttype:=ot;
|
||||
objectoptions:=[];
|
||||
@ -3945,8 +3976,6 @@ implementation
|
||||
vmtentries:=TFPList.Create;
|
||||
vmt_offset:=0;
|
||||
set_parent(c);
|
||||
objname:=stringdup(upper(n));
|
||||
objrealname:=stringdup(n);
|
||||
if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
|
||||
prepareguid;
|
||||
{ setup implemented interfaces }
|
||||
@ -3968,8 +3997,6 @@ implementation
|
||||
begin
|
||||
inherited ppuload(objectdef,ppufile);
|
||||
objecttype:=tobjecttyp(ppufile.getbyte);
|
||||
objrealname:=stringdup(ppufile.getstring);
|
||||
objname:=stringdup(upper(objrealname^));
|
||||
objextname:=stringdup(ppufile.getstring);
|
||||
{ only used for external Objective-C classes/protocols }
|
||||
if (objextname^='') then
|
||||
@ -4054,8 +4081,6 @@ implementation
|
||||
symtable.free;
|
||||
symtable:=nil;
|
||||
end;
|
||||
stringdispose(objname);
|
||||
stringdispose(objrealname);
|
||||
stringdispose(objextname);
|
||||
stringdispose(import_lib);
|
||||
stringdispose(iidstr);
|
||||
@ -4088,14 +4113,10 @@ implementation
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
result:=tobjectdef.create(objecttype,objname^,childof);
|
||||
result:=tobjectdef.create(objecttype,objrealname^,childof);
|
||||
{ the constructor allocates a symtable which we release to avoid memory leaks }
|
||||
tobjectdef(result).symtable.free;
|
||||
tobjectdef(result).symtable:=symtable.getcopy;
|
||||
if assigned(objname) then
|
||||
tobjectdef(result).objname:=stringdup(objname^);
|
||||
if assigned(objrealname) then
|
||||
tobjectdef(result).objrealname:=stringdup(objrealname^);
|
||||
if assigned(objextname) then
|
||||
tobjectdef(result).objextname:=stringdup(objextname^);
|
||||
if assigned(import_lib) then
|
||||
@ -4141,7 +4162,6 @@ implementation
|
||||
ppufile.do_indirect_crc:=true;
|
||||
inherited ppuwrite(ppufile);
|
||||
ppufile.putbyte(byte(objecttype));
|
||||
ppufile.putstring(objrealname^);
|
||||
if assigned(objextname) then
|
||||
ppufile.putstring(objextname^)
|
||||
else
|
||||
|
||||
@ -104,7 +104,7 @@ interface
|
||||
|
||||
trecordsymtable = class(tabstractrecordsymtable)
|
||||
public
|
||||
constructor create(usealign:shortint);
|
||||
constructor create(const n:string;usealign:shortint);
|
||||
procedure insertunionst(unionst : trecordsymtable;offset : longint);
|
||||
end;
|
||||
|
||||
@ -1047,9 +1047,9 @@ implementation
|
||||
TRecordSymtable
|
||||
****************************************************************************}
|
||||
|
||||
constructor trecordsymtable.create(usealign:shortint);
|
||||
constructor trecordsymtable.create(const n:string;usealign:shortint);
|
||||
begin
|
||||
inherited create('',usealign);
|
||||
inherited create(n,usealign);
|
||||
symtabletype:=recordsymtable;
|
||||
end;
|
||||
|
||||
@ -1622,7 +1622,7 @@ implementation
|
||||
function generate_nested_name(symtable:tsymtable;delimiter:string):string;
|
||||
begin
|
||||
result:='';
|
||||
while assigned(symtable) and (symtable.symtabletype=ObjectSymtable) do
|
||||
while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do
|
||||
begin
|
||||
if (result='') then
|
||||
result:=symtable.name^
|
||||
|
||||
@ -2091,6 +2091,7 @@ begin
|
||||
ibrecorddef :
|
||||
begin
|
||||
readcommondef('Record definition',defoptions);
|
||||
writeln(space,' Name of Record : ',getstring);
|
||||
writeln(space,' FieldAlign : ',getbyte);
|
||||
writeln(space,' RecordAlign : ',getbyte);
|
||||
writeln(space,' PadAlign : ',getbyte);
|
||||
@ -2108,6 +2109,7 @@ begin
|
||||
ibobjectdef :
|
||||
begin
|
||||
readcommondef('Object/Class definition',defoptions);
|
||||
writeln(space,' Name of Class : ',getstring);
|
||||
b:=getbyte;
|
||||
write (space,' Type : ');
|
||||
case tobjecttyp(b) of
|
||||
@ -2121,7 +2123,6 @@ begin
|
||||
odt_objcprotocol : writeln('objcprotocol');
|
||||
else writeln('!! Warning: Invalid object type ',b);
|
||||
end;
|
||||
writeln(space,' Name of Class : ',getstring);
|
||||
writeln(space,' External name : ',getstring);
|
||||
writeln(space,' Import lib : ',getstring);
|
||||
writeln(space,' DataSize : ',getaint);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user