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

* fixed some reported bugs

Browse Source
This commit is contained in:
peter 2003-08-10 17:25:23 +00:00
parent e407fb7848
commit 6731abb0db
14 changed files with 85 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/ncal.pas
View File

@ -1137,12 +1137,15 @@ type
{ also, this checking can only be done if the constructor is directly
called, indirect constructor calls cannot be checked.
}
if assigned(methodpointer) and
(methodpointer.resulttype.def.deftype = classrefdef) and
(methodpointer.nodetype in [typen,loadvmtaddrn]) then
if assigned(methodpointer) then
begin
if (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) then
objectdf := tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def);
if (methodpointer.resulttype.def.deftype = objectdef) then
objectdf:=tobjectdef(methodpointer.resulttype.def)
else
if (methodpointer.resulttype.def.deftype = classrefdef) and
(tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) and
(methodpointer.nodetype in [typen,loadvmtaddrn]) then
objectdf:=tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def);
end;
if not assigned(objectdf) then
exit;
@ -2163,7 +2166,7 @@ type
while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
hpt:=tunarynode(hpt).left;
if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
if (procdefinition.proctypeoption=potype_constructor) and
assigned(symtableproc) and
(symtableproc.symtabletype=withsymtable) and
(tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
@ -2646,7 +2649,10 @@ begin
end.
{
$Log$
Revision 1.174 2003-07-25 09:54:57 jonas
Revision 1.175 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.174 2003/07/25 09:54:57 jonas
* fixed bogus abstract method warnings
Revision 1.173 2003/06/25 18:31:23 peter

17
compiler/ncgflw.pas
View File

@ -109,7 +109,7 @@ implementation
lcont,lbreak,lloop,
oldclabel,oldblabel : tasmlabel;
otlabel,oflabel : tasmlabel;
oldflowcontrol : tflowcontrol;
begin
location_reset(location,LOC_VOID,OS_NO);
@ -117,6 +117,7 @@ implementation
objectlibrary.getlabel(lcont);
objectlibrary.getlabel(lbreak);
{ arrange continue and breaklabels: }
oldflowcontrol:=flowcontrol;
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
@ -168,7 +169,7 @@ implementation
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a while/repeat block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue]);
end;
@ -354,10 +355,11 @@ implementation
opsize : tcgsize;
count_var_is_signed,do_loopvar_at_end : boolean;
cmp_const:Tconstexprint;
oldflowcontrol : tflowcontrol;
begin
location_reset(location,LOC_VOID,OS_NO);
oldflowcontrol:=flowcontrol;
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
objectlibrary.getlabel(aktcontinuelabel);
@ -702,8 +704,8 @@ implementation
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a for block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
{ a break/continue in a while/repeat block can't be seen outside }
flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue]);
end;
@ -1539,7 +1541,10 @@ begin
end.
{
$Log$
Revision 1.74 2003-08-09 18:56:54 daniel
Revision 1.75 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.74 2003/08/09 18:56:54 daniel
* cs_regalloc renamed to cs_regvars to avoid confusion with register
allocator
* Some preventive changes to i386 spillinh code

47
compiler/ncgmem.pas
View File

@ -42,10 +42,6 @@ interface
procedure pass_2;override;
end;
tcgdoubleaddrnode = class(tdoubleaddrnode)
procedure pass_2;override;
end;
tcgderefnode = class(tderefnode)
procedure pass_2;override;
end;
@ -185,40 +181,16 @@ implementation
location_release(exprasmlist,left.location);
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=rg.getaddressregister(exprasmlist);
{@ on a procvar means returning an address to the procedure that
is stored in it.}
{ yes but left.symtableentry can be nil
for example on self !! }
{ symtableentry can be also invalid, if left is no tree node }
{ @ on a procvar means returning an address to the procedure that
is stored in it }
if (m_tp_procvar in aktmodeswitches) and
(left.nodetype=loadn) and
(tloadnode(left).resulttype.def.deftype=procvardef) and
assigned(tloadnode(left).symtableentry) and
(tloadnode(left).symtableentry.typ=varsym) and
(tvarsym(tloadnode(left).symtableentry).vartype.def.deftype=procvardef) then
cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,
location.register)
(tloadnode(left).symtableentry.typ=varsym) then
cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,location.register)
else
begin
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,
location.register);
end;
end;
{*****************************************************************************
TCGDOUBLEADDRNODE
*****************************************************************************}
procedure tcgdoubleaddrnode.pass_2;
begin
secondpass(left);
location_release(exprasmlist,left.location);
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=rg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,
location.register);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
end;
@ -479,7 +451,6 @@ implementation
poslabel,
neglabel : tasmlabel;
hreg : tregister;
i:Tsuperregister;
{$ifndef newra}
pushed : tpushedsavedint;
{$endif}
@ -890,7 +861,6 @@ implementation
begin
cloadvmtaddrnode:=tcgloadvmtaddrnode;
caddrnode:=tcgaddrnode;
cdoubleaddrnode:=tcgdoubleaddrnode;
cderefnode:=tcgderefnode;
csubscriptnode:=tcgsubscriptnode;
cwithnode:=tcgwithnode;
@ -898,7 +868,10 @@ begin
end.
{
$Log$
Revision 1.68 2003-08-09 18:56:54 daniel
Revision 1.69 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.68 2003/08/09 18:56:54 daniel
* cs_regalloc renamed to cs_regvars to avoid confusion with register
allocator
* Some preventive changes to i386 spillinh code

7
compiler/ncnv.pas
View File

@ -1294,6 +1294,8 @@ implementation
that has an extra addrn }
if (m_tp_procvar in aktmodeswitches) and
(resulttype.def.deftype<>procvardef) and
{ ignore internal typecasts to access methodpointer fields }
(resulttype.def<>methodpointertype.def) and
(left.resulttype.def.deftype=procvardef) and
(not is_void(tprocvardef(left.resulttype.def).rettype.def)) then
begin
@ -2111,7 +2113,10 @@ begin
end.
{
$Log$
Revision 1.115 2003-06-05 20:05:55 peter
Revision 1.116 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.115 2003/06/05 20:05:55 peter
* removed changesettype because that will change the definition
of the setdef forever and can result in a different between
original interface and current implementation definition

64
compiler/nmem.pas
View File

@ -53,13 +53,6 @@ interface
end;
taddrnodeclass = class of taddrnode;
tdoubleaddrnode = class(tunarynode)
constructor create(l : tnode);virtual;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
end;
tdoubleaddrnodeclass = class of tdoubleaddrnode;
tderefnode = class(tunarynode)
constructor create(l : tnode);virtual;
function pass_1 : tnode;override;
@ -109,7 +102,6 @@ interface
var
cloadvmtaddrnode : tloadvmtaddrnodeclass;
caddrnode : taddrnodeclass;
cdoubleaddrnode : tdoubleaddrnodeclass;
cderefnode : tderefnodeclass;
csubscriptnode : tsubscriptnodeclass;
cvecnode : tvecnodeclass;
@ -405,56 +397,6 @@ implementation
end;
{*****************************************************************************
TDOUBLEADDRNODE
*****************************************************************************}
constructor tdoubleaddrnode.create(l : tnode);
begin
inherited create(doubleaddrn,l);
end;
function tdoubleaddrnode.det_resulttype:tnode;
begin
result:=nil;
resulttypepass(left);
if codegenerror then
exit;
inc(parsing_para_level);
set_varstate(left,false);
dec(parsing_para_level);
if (left.resulttype.def.deftype)<>procvardef then
CGMessage(cg_e_illegal_expression);
resulttype:=voidpointertype;
end;
function tdoubleaddrnode.pass_1 : tnode;
begin
result:=nil;
make_not_regable(left);
firstpass(left);
if codegenerror then
exit;
if (left.expectloc<>LOC_REFERENCE) then
CGMessage(cg_e_illegal_expression);
registers32:=left.registers32;
registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
if registers32<1 then
registers32:=1;
expectloc:=LOC_REGISTER;
end;
{*****************************************************************************
TDEREFNODE
*****************************************************************************}
@ -905,7 +847,6 @@ implementation
begin
cloadvmtaddrnode := tloadvmtaddrnode;
caddrnode := taddrnode;
cdoubleaddrnode := tdoubleaddrnode;
cderefnode := tderefnode;
csubscriptnode := tsubscriptnode;
cvecnode := tvecnode;
@ -913,7 +854,10 @@ begin
end.
{
$Log$
Revision 1.59 2003-06-17 19:24:08 jonas
Revision 1.60 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.59 2003/06/17 19:24:08 jonas
* fixed conversion of fpc_*str_unique to compilerproc
Revision 1.58 2003/06/17 16:34:44 jonas

14
compiler/nobj.pas
View File

@ -1163,14 +1163,9 @@ implementation
{ class abstract and it's not allow to }
{ generates an instance }
if (po_abstractmethod in procdefcoll^.data.procoptions) then
begin
include(_class.objectoptions,oo_has_abstract);
List.concat(Tai_const_symbol.Createname('FPC_ABSTRACTERROR'));
end
List.concat(Tai_const_symbol.Createname('FPC_ABSTRACTERROR'))
else
begin
List.concat(Tai_const_symbol.createname(procdefcoll^.data.mangledname));
end;
List.concat(Tai_const_symbol.createname(procdefcoll^.data.mangledname));
end;
end;
procdefcoll:=procdefcoll^.next;
@ -1333,7 +1328,10 @@ initialization
end.
{
$Log$
Revision 1.44 2003-06-01 21:38:06 peter
Revision 1.45 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.44 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

7
compiler/node.pas
View File

@ -70,7 +70,6 @@ interface
subscriptn, {Field in a record/object}
derefn, {Dereferences a pointer}
addrn, {Represents the @ operator}
doubleaddrn, {Represents the @@ operator}
ordconstn, {Represents an ordinal value}
typeconvn, {Represents type-conversion/typecast}
calln, {Represents a call node}
@ -149,7 +148,6 @@ interface
'subscriptn',
'derefn',
'addrn',
'doubleaddrn',
'ordconstn',
'typeconvn',
'calln',
@ -982,7 +980,10 @@ implementation
end.
{
$Log$
Revision 1.62 2003-05-26 21:17:17 peter
Revision 1.63 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.62 2003/05/26 21:17:17 peter
* procinlinenode removed
* aktexit2label removed, fast exit removed
+ tcallnode.inlined_pass_2 added

6
compiler/pass_2.pas
View File

@ -96,7 +96,6 @@ implementation
'subscriptn', {subscriptn}
'dderef', {derefn}
'addr', {addrn}
'doubleaddr', {doubleaddrn}
'ordconst', {ordconstn}
'typeconv', {typeconvn}
'calln', {calln}
@ -316,7 +315,10 @@ implementation
end.
{
$Log$
Revision 1.61 2003-07-06 17:58:22 peter
Revision 1.62 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.61 2003/07/06 17:58:22 peter
* framepointer fixes for sparc
* parent framepointer code more generic

8
compiler/pexpr.pas
View File

@ -1358,7 +1358,8 @@ implementation
procsym :
begin
{ are we in a class method ? }
possible_error:=(srsym.owner.symtabletype=objectsymtable) and
possible_error:=(srsymtable.symtabletype<>withsymtable) and
(srsym.owner.symtabletype=objectsymtable) and
not(is_interface(tdef(srsym.owner.defowner))) and
assigned(current_procinfo) and
(po_classmethod in current_procinfo.procdef.procoptions);
@ -2412,7 +2413,10 @@ implementation
end.
{
$Log$
Revision 1.123 2003-06-13 21:19:31 peter
Revision 1.124 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.123 2003/06/13 21:19:31 peter
* current_procdef removed, use current_procinfo.procdef instead
Revision 1.122 2003/06/03 21:02:57 peter

8
compiler/pinline.pas
View File

@ -355,9 +355,6 @@ implementation
exit;
end;
classh:=tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def);
{ check for an abstract class }
if (oo_has_abstract in classh.objectoptions) then
Message(sym_e_no_instance_of_abstract_object);
{ use the objectdef for loading the VMT }
p2:=p1;
p1:=ctypenode.create(tpointerdef(p1.resulttype.def).pointertype);
@ -682,7 +679,10 @@ implementation
end.
{
$Log$
Revision 1.15 2003-05-17 13:30:08 jonas
Revision 1.16 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.15 2003/05/17 13:30:08 jonas
* changed tt_persistant to tt_persistent :)
* tempcreatenode now doesn't accept a boolean anymore for persistent
temps, but a ttemptype, so you can also create ansistring temps etc

6
compiler/psystem.pas
View File

@ -385,7 +385,6 @@ implementation
nodeclass[subscriptn]:=csubscriptnode;
nodeclass[derefn]:=cderefnode;
nodeclass[addrn]:=caddrnode;
nodeclass[doubleaddrn]:=cdoubleaddrnode;
nodeclass[ordconstn]:=cordconstnode;
nodeclass[typeconvn]:=ctypeconvnode;
nodeclass[calln]:=ccallnode;
@ -493,7 +492,10 @@ implementation
end.
{
$Log$
Revision 1.52 2003-05-26 21:17:18 peter
Revision 1.53 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.52 2003/05/26 21:17:18 peter
* procinlinenode removed
* aktexit2label removed, fast exit removed
+ tcallnode.inlined_pass_2 added

13
compiler/scanner.pas
View File

@ -2371,13 +2371,7 @@ implementation
'@' :
begin
readchar;
if c='@' then
begin
readchar;
token:=_DOUBLEADDR;
end
else
token:=_KLAMMERAFFE;
token:=_KLAMMERAFFE;
goto exit_label;
end;
@ -2814,7 +2808,10 @@ exit_label:
end.
{
$Log$
Revision 1.59 2003-05-25 10:26:43 peter
Revision 1.60 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.59 2003/05/25 10:26:43 peter
* recursive include depth check
Revision 1.58 2003/04/26 00:30:27 peter

6
compiler/symconst.pas
View File

@ -224,7 +224,6 @@ type
oo_has_vmt, { the object/class has a vmt }
oo_has_msgstr,
oo_has_msgint,
oo_has_abstract, { the object/class has an abstract method => no instances can be created }
oo_can_have_published { the class has rtti, i.e. you can publish properties }
);
tobjectoptions=set of tobjectoption;
@ -356,7 +355,10 @@ implementation
end.
{
$Log$
Revision 1.58 2003-06-25 18:31:23 peter
Revision 1.59 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.58 2003/06/25 18:31:23 peter
* sym,def resolving partly rewritten to support also parent objects
not directly available through the uses clause

7
compiler/tokens.pas
View File

@ -67,7 +67,6 @@ type
_SEMICOLON,
_KLAMMERAFFE,
_POINTPOINT,
_DOUBLEADDR,
_EOF,
_ID,
_NOID,
@ -291,7 +290,6 @@ const
(str:';' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'@' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'..' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'@@' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'end of file' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'identifier' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'non identifier';special:true ;keyword:m_none;op:NOTOKEN),
@ -506,7 +504,10 @@ end;
end.
{
$Log$
Revision 1.21 2003-03-26 12:50:54 armin
Revision 1.22 2003-08-10 17:25:23 peter
* fixed some reported bugs
Revision 1.21 2003/03/26 12:50:54 armin
* avoid problems with the ide in init/dome
Revision 1.20 2002/11/29 22:31:21 carl