mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 20:19:34 +01:00
* wrong stabs info corrected once again !!
+ variable vmt offset with vmt field only if required
implemented now !!!
This commit is contained in:
pierre
parent
5c9acf66ad
commit
a5f0168fbb
@ -565,7 +565,7 @@ implementation
|
||||
{ will be made }
|
||||
{ con- and destructors need a pointer to the vmt }
|
||||
if is_con_or_destructor and
|
||||
((pobjectdef(p^.methodpointer^.resulttype)^.options and oois_class)=0) and
|
||||
((pobjectdef(p^.methodpointer^.resulttype)^.options and oo_is_class)=0) and
|
||||
assigned(aktprocsym) then
|
||||
begin
|
||||
if not ((aktprocsym^.definition^.options
|
||||
@ -578,7 +578,7 @@ implementation
|
||||
{ classes need the mem ! }
|
||||
if ((pobjectdef(p^.methodpointer^.resulttype)^.options and
|
||||
|
||||
oois_class)=0) then
|
||||
oo_is_class)=0) then
|
||||
push_int(0)
|
||||
else
|
||||
begin
|
||||
@ -1052,7 +1052,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1998-10-16 13:12:46 pierre
|
||||
Revision 1.12 1998-10-19 08:54:53 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.11 1998/10/16 13:12:46 pierre
|
||||
* added vmt_offsets in destructors code also !!!
|
||||
* vmt_offset code for m68k
|
||||
|
||||
|
||||
@ -201,7 +201,7 @@ implementation
|
||||
end;
|
||||
{ should be dereferenced later (FK)
|
||||
if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
|
||||
((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
|
||||
((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oo_is_class)<>0) then
|
||||
begin
|
||||
simple_loadn:=false;
|
||||
if hregister=R_NO then
|
||||
@ -510,7 +510,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-10-14 08:47:16 pierre
|
||||
Revision 1.7 1998-10-19 08:54:55 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.6 1998/10/14 08:47:16 pierre
|
||||
* bugs in secondfuncret for result in subprocedures removed
|
||||
|
||||
Revision 1.5 1998/10/14 08:08:53 pierre
|
||||
|
||||
@ -277,7 +277,11 @@ unit pdecl;
|
||||
(token=ID) and (orgpattern='__asmname__') then
|
||||
begin
|
||||
consume(ID);
|
||||
C_name:=get_stringconst;
|
||||
C_name:=pattern;
|
||||
if token=CCHAR then
|
||||
consume(CCHAR)
|
||||
else
|
||||
consume(CSTRING);
|
||||
Is_gpc_name:=true;
|
||||
end;
|
||||
p:=read_type('');
|
||||
@ -325,13 +329,13 @@ unit pdecl;
|
||||
symtablestack^.insert(abssym);
|
||||
end
|
||||
else
|
||||
if token=CSTRING then
|
||||
if (token=CSTRING) or (token=CCHAR) then
|
||||
begin
|
||||
storetokenpos:=tokenpos;
|
||||
tokenpos:=declarepos;
|
||||
abssym:=new(pabsolutesym,init(s,p));
|
||||
s:=pattern;
|
||||
consume(CSTRING);
|
||||
consume(token);
|
||||
abssym^.typ:=absolutesym;
|
||||
abssym^.abstyp:=toasm;
|
||||
abssym^.asmname:=stringdup(s);
|
||||
@ -691,7 +695,7 @@ unit pdecl;
|
||||
aktclass^.options:=aktclass^.options or oo_hasconstructor;
|
||||
consume(SEMICOLON);
|
||||
begin
|
||||
if (aktclass^.options and oois_class)<>0 then
|
||||
if (aktclass^.options and oo_is_class)<>0 then
|
||||
begin
|
||||
{ CLASS constructors return the created instance }
|
||||
aktprocsym^.definition^.retdef:=aktclass;
|
||||
@ -753,7 +757,7 @@ unit pdecl;
|
||||
|
||||
begin
|
||||
{ check for a class }
|
||||
if (aktclass^.options and oois_class=0) then
|
||||
if (aktclass^.options and oo_is_class=0) then
|
||||
Message(parser_e_syntax_error);
|
||||
consume(_PROPERTY);
|
||||
propertyparas:=nil;
|
||||
@ -1090,7 +1094,7 @@ unit pdecl;
|
||||
the forward is resolved)
|
||||
}
|
||||
((hp1^.deftype=objectdef) and (
|
||||
(pobjectdef(hp1)^.options and oois_class)<>0)) then
|
||||
(pobjectdef(hp1)^.options and oo_is_class)<>0)) then
|
||||
begin
|
||||
pcrd:=new(pclassrefdef,init(hp1));
|
||||
object_dec:=pcrd;
|
||||
@ -1129,7 +1133,7 @@ unit pdecl;
|
||||
end
|
||||
else
|
||||
aktclass:=new(pobjectdef,init(n,class_tobject));
|
||||
aktclass^.options:=aktclass^.options or oois_class or oo_isforward;
|
||||
aktclass^.options:=aktclass^.options or oo_is_class or oo_isforward;
|
||||
object_dec:=aktclass;
|
||||
exit;
|
||||
end;
|
||||
@ -1154,8 +1158,8 @@ unit pdecl;
|
||||
childof:=nil;
|
||||
end;
|
||||
{ a mix of class and object isn't allowed }
|
||||
if (((childof^.options and oois_class)<>0) and not is_a_class) or
|
||||
(((childof^.options and oois_class)=0) and is_a_class) then
|
||||
if (((childof^.options and oo_is_class)<>0) and not is_a_class) or
|
||||
(((childof^.options and oo_is_class)=0) and is_a_class) then
|
||||
Message(parser_e_mix_of_classes_and_objects);
|
||||
if assigned(fd) then
|
||||
begin
|
||||
@ -1199,16 +1203,12 @@ unit pdecl;
|
||||
if (childof^.options and oo_isforward)<>0 then
|
||||
Message1(parser_e_forward_declaration_must_be_resolved,childof^.name^);
|
||||
aktclass:=fd;
|
||||
aktclass^.childof:=childof;
|
||||
{ ajust the size, because the child could be also
|
||||
forward defined
|
||||
}
|
||||
aktclass^.publicsyms^.datasize:=
|
||||
aktclass^.publicsyms^.datasize-4+childof^.publicsyms^.datasize;
|
||||
aktclass^.set_parent(childof);
|
||||
end
|
||||
else
|
||||
begin
|
||||
aktclass:=new(pobjectdef,init(n,childof));
|
||||
aktclass^.set_parent(childof);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
@ -1218,7 +1218,7 @@ unit pdecl;
|
||||
{ set the class attribute }
|
||||
if is_a_class then
|
||||
begin
|
||||
aktclass^.options:=aktclass^.options or oois_class;
|
||||
aktclass^.options:=aktclass^.options or oo_is_class;
|
||||
|
||||
if (cs_generate_rtti in aktlocalswitches) or
|
||||
(assigned(aktclass^.childof) and
|
||||
@ -1340,7 +1340,7 @@ unit pdecl;
|
||||
consume(SEMICOLON);
|
||||
end;
|
||||
_OVERRIDE : begin
|
||||
if (aktclass^.options and oois_class=0) then
|
||||
if (aktclass^.options and oo_is_class=0) then
|
||||
Message(parser_e_constructor_cannot_be_not_virtual)
|
||||
else
|
||||
aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
|
||||
@ -1390,6 +1390,13 @@ unit pdecl;
|
||||
curobjectname:='';
|
||||
typecanbeforward:=storetypeforwardsallowed;
|
||||
|
||||
{ generate vmt space if needed }
|
||||
if ((aktclass^.options and
|
||||
(oo_hasvirtual or oo_hasconstructor or
|
||||
oo_hasdestructor or oo_is_class))<>0) and
|
||||
((aktclass^.options and
|
||||
oo_hasvmt)=0) then
|
||||
aktclass^.insertvmt;
|
||||
if (cs_smartlink in aktmoduleswitches) then
|
||||
datasegment^.concat(new(pai_cut,init));
|
||||
{ write extended info for classes }
|
||||
@ -1431,7 +1438,8 @@ unit pdecl;
|
||||
end;
|
||||
{$ifdef GDB}
|
||||
{ generate the VMT }
|
||||
if cs_debuginfo in aktmoduleswitches then
|
||||
if (cs_debuginfo in aktmoduleswitches) and
|
||||
((aktclass^.options and oo_hasvmt)<>0) then
|
||||
begin
|
||||
do_count_dbx:=true;
|
||||
if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
|
||||
@ -1439,31 +1447,37 @@ unit pdecl;
|
||||
typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
|
||||
end;
|
||||
{$endif GDB}
|
||||
datasegment^.concat(new(pai_symbol,init_global(aktclass^.vmt_mangledname)));
|
||||
|
||||
{ determine the size with publicsyms^.datasize, because }
|
||||
{ size gives back 4 for CLASSes }
|
||||
datasegment^.concat(new(pai_const,init_32bit(aktclass^.publicsyms^.datasize)));
|
||||
datasegment^.concat(new(pai_const,init_32bit(-aktclass^.publicsyms^.datasize)));
|
||||
|
||||
{ write pointer to parent VMT, this isn't implemented in TP }
|
||||
{ but this is not used in FPC ? (PM) }
|
||||
{ it's not used yet, but the delphi-operators as and is need it (FK) }
|
||||
if assigned(aktclass^.childof) then
|
||||
if ((aktclass^.options and oo_hasvmt)<>0) then
|
||||
begin
|
||||
datasegment^.concat(new(pai_const,init_symbol(strpnew(aktclass^.childof^.vmt_mangledname))));
|
||||
if aktclass^.childof^.owner^.symtabletype=unitsymtable then
|
||||
concat_external(aktclass^.childof^.vmt_mangledname,EXT_NEAR);
|
||||
end
|
||||
else
|
||||
datasegment^.concat(new(pai_const,init_32bit(0)));
|
||||
|
||||
{ this generates the entries }
|
||||
genvmt(aktclass);
|
||||
|
||||
datasegment^.concat(new(pai_symbol,init_global(aktclass^.vmt_mangledname)));
|
||||
|
||||
{ determine the size with publicsyms^.datasize, because }
|
||||
{ size gives back 4 for classes }
|
||||
datasegment^.concat(new(pai_const,init_32bit(aktclass^.publicsyms^.datasize)));
|
||||
datasegment^.concat(new(pai_const,init_32bit(-aktclass^.publicsyms^.datasize)));
|
||||
|
||||
{ write pointer to parent VMT, this isn't implemented in TP }
|
||||
{ but this is not used in FPC ? (PM) }
|
||||
{ it's not used yet, but the delphi-operators as and is need it (FK) }
|
||||
{ it is not written for parents that don't have any vmt !! }
|
||||
if assigned(aktclass^.childof) and
|
||||
((aktclass^.childof^.options and oo_hasvmt)<>0) then
|
||||
begin
|
||||
datasegment^.concat(new(pai_const,init_symbol(strpnew(aktclass^.childof^.vmt_mangledname))));
|
||||
if aktclass^.childof^.owner^.symtabletype=unitsymtable then
|
||||
concat_external(aktclass^.childof^.vmt_mangledname,EXT_NEAR);
|
||||
end
|
||||
else
|
||||
datasegment^.concat(new(pai_const,init_32bit(0)));
|
||||
|
||||
{ this generates the entries }
|
||||
genvmt(aktclass);
|
||||
end;
|
||||
|
||||
{ restore old state }
|
||||
symtablestack:=symtablestack^.next;
|
||||
procinfo._class:=nil;
|
||||
aktobjectdef:=nil;
|
||||
{Restore the aktprocsym.}
|
||||
aktprocsym:=oldprocsym;
|
||||
|
||||
@ -1945,7 +1959,7 @@ unit pdecl;
|
||||
(srsym^.typ=typesym) and
|
||||
(ptypesym(srsym)^.definition^.deftype=objectdef) and
|
||||
((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_isforward)<>0) and
|
||||
((pobjectdef(ptypesym(srsym)^.definition)^.options and oois_class)<>0) then
|
||||
((pobjectdef(ptypesym(srsym)^.definition)^.options and oo_is_class)<>0) then
|
||||
begin
|
||||
{ we can ignore the result }
|
||||
{ the definition is modified }
|
||||
@ -2064,7 +2078,12 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.72 1998-10-16 13:12:51 pierre
|
||||
Revision 1.73 1998-10-19 08:54:56 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.72 1998/10/16 13:12:51 pierre
|
||||
* added vmt_offsets in destructors code also !!!
|
||||
* vmt_offset code for m68k
|
||||
|
||||
|
||||
@ -872,7 +872,7 @@ unit pexpr;
|
||||
else
|
||||
if (token=POINT) and
|
||||
(pd^.deftype=objectdef) and
|
||||
((pobjectdef(pd)^.options and oois_class)=0) then
|
||||
((pobjectdef(pd)^.options and oo_is_class)=0) then
|
||||
begin
|
||||
consume(POINT);
|
||||
if assigned(procinfo._class) then
|
||||
@ -925,7 +925,7 @@ unit pexpr;
|
||||
begin
|
||||
{ class reference ? }
|
||||
if (pd^.deftype=objectdef)
|
||||
and ((pobjectdef(pd)^.options and oois_class)<>0) then
|
||||
and ((pobjectdef(pd)^.options and oo_is_class)<>0) then
|
||||
begin
|
||||
p1:=genzeronode(typen);
|
||||
p1^.resulttype:=pd;
|
||||
@ -1399,7 +1399,7 @@ unit pexpr;
|
||||
{ determines the current object defintion }
|
||||
classh:=pobjectdef(ppointerdef(pd)^.definition);
|
||||
{ check for an abstract class }
|
||||
if (classh^.options and oois_abstract)<>0 then
|
||||
if (classh^.options and oo_is_abstract)<>0 then
|
||||
Message(sym_e_no_instance_of_abstract_object);
|
||||
|
||||
{ search the constructor also in the symbol tables of
|
||||
@ -1863,7 +1863,12 @@ unit pexpr;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.66 1998-10-15 15:13:28 pierre
|
||||
Revision 1.67 1998-10-19 08:54:57 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.66 1998/10/15 15:13:28 pierre
|
||||
+ added oo_hasconstructor and oo_hasdestructor
|
||||
for objects options
|
||||
|
||||
|
||||
@ -794,6 +794,12 @@ unit pmodules;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ reset ranges/stabs in exported definitions }
|
||||
{ If I find who removed this line !!!!!!!
|
||||
I AM TIRED OF THIS !!!!!!!!!!!
|
||||
DONT TOUCH WITHOUT ASKING ME Pierre Muller }
|
||||
|
||||
reset_global_defs;
|
||||
{ All units are read, now give them a number }
|
||||
numberunits;
|
||||
|
||||
@ -1074,7 +1080,12 @@ unit pmodules;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.67 1998-10-13 13:10:25 peter
|
||||
Revision 1.68 1998-10-19 08:54:59 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.67 1998/10/13 13:10:25 peter
|
||||
* new style for m68k/i386 infos and enums
|
||||
|
||||
Revision 1.66 1998/10/09 16:36:05 pierre
|
||||
|
||||
@ -812,7 +812,7 @@ unit pstatmnt;
|
||||
end;
|
||||
{ check, if the first parameter is a pointer to a _class_ }
|
||||
classh:=pobjectdef(ppointerdef(pd)^.definition);
|
||||
if (classh^.options and oois_class)<>0 then
|
||||
if (classh^.options and oo_is_class)<>0 then
|
||||
begin
|
||||
Message(parser_e_no_new_or_dispose_for_classes);
|
||||
new_dispose_statement:=factor(false);
|
||||
@ -1215,7 +1215,12 @@ unit pstatmnt;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.44 1998-10-13 13:10:27 peter
|
||||
Revision 1.45 1998-10-19 08:55:01 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.44 1998/10/13 13:10:27 peter
|
||||
* new style for m68k/i386 infos and enums
|
||||
|
||||
Revision 1.43 1998/10/08 13:46:22 peter
|
||||
|
||||
@ -63,6 +63,8 @@ unit ptconst;
|
||||
ca : pchar;
|
||||
aktpos : longint;
|
||||
pd : pprocdef;
|
||||
obj : pobjectdef;
|
||||
symt : psymtable;
|
||||
hp1,hp2 : pdefcoll;
|
||||
value : bestreal;
|
||||
|
||||
@ -540,6 +542,69 @@ unit ptconst;
|
||||
datasegment^.concat(new(pai_const,init_8bit(0)));
|
||||
consume(RKLAMMER);
|
||||
end;
|
||||
{ reads a typed object }
|
||||
objectdef:
|
||||
begin
|
||||
if (pobjectdef(def)^.options and (oo_hasvmt or oo_is_class))<>0 then
|
||||
begin
|
||||
Message(parser_e_type_const_not_possible);
|
||||
consume_all_until(RKLAMMER);
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(LKLAMMER);
|
||||
aktpos:=0;
|
||||
while token<>RKLAMMER do
|
||||
begin
|
||||
s:=pattern;
|
||||
consume(ID);
|
||||
consume(COLON);
|
||||
srsym:=nil;
|
||||
obj:=pobjectdef(def);
|
||||
symt:=obj^.publicsyms;
|
||||
while (srsym=nil) and assigned(symt) do
|
||||
begin
|
||||
srsym:=symt^.search(s);
|
||||
if assigned(obj) then
|
||||
obj:=obj^.childof;
|
||||
if assigned(obj) then
|
||||
symt:=obj^.publicsyms
|
||||
else
|
||||
symt:=nil;
|
||||
end;
|
||||
|
||||
if srsym=nil then
|
||||
begin
|
||||
Message1(sym_e_id_not_found,s);
|
||||
consume_all_until(SEMICOLON);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ check position }
|
||||
if pvarsym(srsym)^.address<aktpos then
|
||||
Message(parser_e_invalid_record_const);
|
||||
|
||||
{ if needed fill }
|
||||
if pvarsym(srsym)^.address>aktpos then
|
||||
for i:=1 to pvarsym(srsym)^.address-aktpos do
|
||||
datasegment^.concat(new(pai_const,init_8bit(0)));
|
||||
|
||||
{ new position }
|
||||
aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.definition^.size;
|
||||
|
||||
{ read the data }
|
||||
readtypedconst(pvarsym(srsym)^.definition,nil);
|
||||
|
||||
if token=SEMICOLON then
|
||||
consume(SEMICOLON)
|
||||
else break;
|
||||
end;
|
||||
end;
|
||||
for i:=1 to def^.size-aktpos do
|
||||
datasegment^.concat(new(pai_const,init_8bit(0)));
|
||||
consume(RKLAMMER);
|
||||
end;
|
||||
end;
|
||||
else Message(parser_e_type_const_not_possible);
|
||||
end;
|
||||
end;
|
||||
@ -547,7 +612,12 @@ unit ptconst;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 1998-10-16 08:51:49 peter
|
||||
Revision 1.21 1998-10-19 08:55:03 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.20 1998/10/16 08:51:49 peter
|
||||
+ target_os.stackalignment
|
||||
+ stack can be aligned at 2 or 4 byte boundaries
|
||||
|
||||
|
||||
@ -2470,7 +2470,14 @@
|
||||
strpcopy(nss,'f'+retdef^.numberstring+','+tostr(i)+';');
|
||||
param := para1;
|
||||
i := 0;
|
||||
while assigned(param) do
|
||||
{ this confuses gdb !!
|
||||
we should use 'F' instead of 'f' but
|
||||
as we use c++ language mode
|
||||
it does not like that either
|
||||
Please do not remove this part
|
||||
might be used once
|
||||
gdb for pascal is ready PM }
|
||||
(* while assigned(param) do
|
||||
begin
|
||||
inc(i);
|
||||
if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
|
||||
@ -2479,7 +2486,7 @@
|
||||
strcat(nss,pst);
|
||||
strdispose(pst);
|
||||
param := param^.next;
|
||||
end;
|
||||
end; *)
|
||||
{strpcopy(strend(nss),';');}
|
||||
stabstring := strnew(nss);
|
||||
freemem(nss,1024);
|
||||
@ -2529,12 +2536,18 @@
|
||||
tdef.init;
|
||||
deftype:=objectdef;
|
||||
options:=0;
|
||||
vmt_offset:=0;
|
||||
publicsyms:=new(psymtable,init(objectsymtable));
|
||||
publicsyms^.name := stringdup(n);
|
||||
{ create space for vmt !! }
|
||||
{$ifdef OLDVMTSTYLE}
|
||||
publicsyms^.datasize:=Sizeof(pointer);
|
||||
options:=oo_hasvmt;
|
||||
vmt_offset:=0;
|
||||
{$else }
|
||||
options:=0;
|
||||
vmt_offset:=0;
|
||||
publicsyms^.datasize:=0;
|
||||
{$endif }
|
||||
publicsyms^.defowner:=@self;
|
||||
set_parent(c);
|
||||
name:=stringdup(n);
|
||||
@ -2609,13 +2622,20 @@
|
||||
else
|
||||
begin
|
||||
{ first round up to multiple of 4 }
|
||||
if (publicsyms^.datasize mod 4) <> 0 then
|
||||
publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
|
||||
if (aktpackrecords=2) then
|
||||
begin
|
||||
if (publicsyms^.datasize and 1)<>0 then
|
||||
inc(publicsyms^.datasize);
|
||||
end;
|
||||
if (aktpackrecords>=4) then
|
||||
begin
|
||||
if (publicsyms^.datasize mod 4) <> 0 then
|
||||
publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
|
||||
end;
|
||||
vmt_offset:=publicsyms^.datasize;
|
||||
publicsyms^.datasize:=publicsyms^.datasize+sizeof(pointer);
|
||||
options:=options and oo_hasvmt;
|
||||
options:=options or oo_hasvmt;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure tobjectdef.check_forwards;
|
||||
@ -2667,7 +2687,7 @@
|
||||
|
||||
function tobjectdef.size : longint;
|
||||
begin
|
||||
if (options and oois_class)<>0 then
|
||||
if (options and oo_is_class)<>0 then
|
||||
size:=sizeof(pointer)
|
||||
|
||||
else
|
||||
@ -2710,6 +2730,8 @@
|
||||
var
|
||||
s1,s2:string;
|
||||
begin
|
||||
if (options and oo_hasvmt)=0 then
|
||||
internalerror(12346);
|
||||
if owner^.name=nil then
|
||||
s1:=''
|
||||
else
|
||||
@ -2740,7 +2762,7 @@
|
||||
|
||||
function tobjectdef.isclass : boolean;
|
||||
begin
|
||||
isclass:=(options and oois_class)<>0;
|
||||
isclass:=(options and oo_is_class)<>0;
|
||||
end;
|
||||
|
||||
|
||||
@ -2868,21 +2890,21 @@
|
||||
{$else}
|
||||
publicsyms^.foreach(@addname);
|
||||
{$endif tp}
|
||||
if (options and oo_hasvirtual) <> 0 then
|
||||
if not assigned(childof) or ((childof^.options and oo_hasvirtual) = 0) then
|
||||
if (options and oo_hasvmt) <> 0 then
|
||||
if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
|
||||
begin
|
||||
str_end:='$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;';
|
||||
strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;');
|
||||
strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
|
||||
+','+tostr(vmt_offset*8)+';');
|
||||
end;
|
||||
{$ifdef tp}
|
||||
publicsyms^.foreach(addprocname);
|
||||
{$else}
|
||||
publicsyms^.foreach(@addprocname);
|
||||
{$endif tp }
|
||||
if (options and oo_hasvirtual) <> 0 then
|
||||
if (options and oo_hasvmt) <> 0 then
|
||||
begin
|
||||
anc := @self;
|
||||
while assigned(anc^.childof) and ((anc^.childof^.options and oo_hasvirtual) <> 0) do
|
||||
while assigned(anc^.childof) and ((anc^.childof^.options and oo_hasvmt) <> 0) do
|
||||
anc := anc^.childof;
|
||||
str_end:=';~%'+anc^.numberstring+';';
|
||||
end
|
||||
@ -3119,7 +3141,12 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.60 1998-10-16 13:12:53 pierre
|
||||
Revision 1.61 1998-10-19 08:55:05 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.60 1998/10/16 13:12:53 pierre
|
||||
* added vmt_offsets in destructors code also !!!
|
||||
* vmt_offset code for m68k
|
||||
|
||||
|
||||
@ -1001,7 +1001,7 @@
|
||||
{ check for instance of an abstract object or class }
|
||||
{
|
||||
if (pvarsym(sym)^.definition^.deftype=objectdef) and
|
||||
((pobjectdef(pvarsym(sym)^.definition)^.options and oois_abstract)<>0) then
|
||||
((pobjectdef(pvarsym(sym)^.definition)^.options and oo_is_abstract)<>0) then
|
||||
Message(sym_e_no_instance_of_abstract_object);
|
||||
}
|
||||
|
||||
@ -1712,7 +1712,12 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.53 1998-10-16 08:51:53 peter
|
||||
Revision 1.54 1998-10-19 08:55:07 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.53 1998/10/16 08:51:53 peter
|
||||
+ target_os.stackalignment
|
||||
+ stack can be aligned at 2 or 4 byte boundaries
|
||||
|
||||
|
||||
@ -370,7 +370,7 @@ implementation
|
||||
|
||||
{ this must be a _class_ }
|
||||
if (p^.left^.resulttype^.deftype<>objectdef) or
|
||||
((pobjectdef(p^.left^.resulttype)^.options and oois_class)=0) then
|
||||
((pobjectdef(p^.left^.resulttype)^.options and oo_is_class)=0) then
|
||||
CGMessage(type_e_mismatch);
|
||||
|
||||
p^.registersfpu:=p^.left^.registersfpu;
|
||||
@ -482,7 +482,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1998-10-06 20:49:10 peter
|
||||
Revision 1.3 1998-10-19 08:55:10 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.2 1998/10/06 20:49:10 peter
|
||||
* m68k compiler compiles again
|
||||
|
||||
Revision 1.1 1998/09/23 20:42:24 peter
|
||||
|
||||
@ -116,7 +116,7 @@ implementation
|
||||
appropriate tree node (FK)
|
||||
|
||||
if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
|
||||
((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
|
||||
((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oo_is_class)<>0) then
|
||||
p^.registers32:=1;
|
||||
}
|
||||
|
||||
@ -399,7 +399,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1998-10-06 20:49:12 peter
|
||||
Revision 1.6 1998-10-19 08:55:12 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.5 1998/10/06 20:49:12 peter
|
||||
* m68k compiler compiles again
|
||||
|
||||
Revision 1.4 1998/09/28 11:07:40 peter
|
||||
|
||||
@ -326,7 +326,7 @@ unit types;
|
||||
ret_in_param:=(def^.deftype in [arraydef,recorddef]) or
|
||||
((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_shortstring,st_longstring])) or
|
||||
((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
|
||||
((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oois_class)=0)) or
|
||||
((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oo_is_class)=0)) or
|
||||
((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
|
||||
end;
|
||||
|
||||
@ -944,7 +944,7 @@ unit types;
|
||||
{ generates an instance }
|
||||
if (procdefcoll^.data^.options and poabstractmethod)<>0 then
|
||||
begin
|
||||
_class^.options:=_class^.options or oois_abstract;
|
||||
_class^.options:=_class^.options or oo_is_abstract;
|
||||
datasegment^.concat(new(pai_const,init_symbol('FPC_ABSTRACTERROR')));
|
||||
end
|
||||
else
|
||||
@ -982,7 +982,12 @@ unit types;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.34 1998-10-12 09:50:06 florian
|
||||
Revision 1.35 1998-10-19 08:55:13 pierre
|
||||
* wrong stabs info corrected once again !!
|
||||
+ variable vmt offset with vmt field only if required
|
||||
implemented now !!!
|
||||
|
||||
Revision 1.34 1998/10/12 09:50:06 florian
|
||||
+ support of <procedure var type>:=<pointer> in delphi mode added
|
||||
|
||||
Revision 1.33 1998/10/06 20:43:30 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user