From 1ba12c259ecec56c05a3114e344851964f7e7180 Mon Sep 17 00:00:00 2001 From: peter Date: Wed, 27 Nov 2002 02:31:17 +0000 Subject: [PATCH] * fixed inlinetree parsing in det_resulttype --- compiler/ncal.pas | 88 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 70 insertions(+), 18 deletions(-) diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 1fb88e6618..e51ed088d9 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -168,7 +168,7 @@ type objinfo : tobjectdef; constructor create(def : tobjectdef); end; - + {**************************************************************************** HELPERS @@ -865,8 +865,8 @@ type { If this is an abstract method insert into the list } if (po_abstractmethod in hp.procoptions) then AbstractMethodsList.Insert(hp.procsym.name) - else - { If this symbol is already in the list, and it is + else + { If this symbol is already in the list, and it is an overriding method or dynamic, then remove it from the list } begin @@ -876,7 +876,7 @@ type if po_overridingmethod in hp.procoptions then AbstractMethodsList.Remove(hp.procsym.name); end; - + end; end; end; @@ -894,30 +894,30 @@ type objectdf := nil; { verify if trying to create an instance of a class which contains non-implemented abstract methods } - + { first verify this class type, no class than exit } - { also, this checking can only be done if the constructor is directly - called, indirect constructor calls cannot be checked. + { also, this checking can only be done if the constructor is directly + called, indirect constructor calls cannot be checked. } if assigned(methodpointer) and assigned(methodpointer.resulttype.def) then - if (methodpointer.resulttype.def.deftype = classrefdef) and + if (methodpointer.resulttype.def.deftype = classrefdef) and (methodpointer.nodetype in [typen,loadvmtn]) then begin if (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) then objectdf := tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def); - + end; if not assigned(objectdf) then exit; - if assigned(objectdf.symtable.name) then + if assigned(objectdf.symtable.name) then _classname := objectdf.symtable.name^ else _classname := ''; - + parents := tlinkedlist.create; AbstractMethodsList := tstringlist.create; - { insert all parents in this class : the first item in the - list will be the base parent of the class . + { insert all parents in this class : the first item in the + list will be the base parent of the class . } while assigned(objectdf) do begin @@ -925,7 +925,7 @@ type parents.insert(objectinfo); objectdf := objectdf.childof; end; - { now all parents are in the correct order + { now all parents are in the correct order insert all abstract methods in the list, and remove those which are overriden by parent classes. } @@ -944,9 +944,9 @@ type while assigned(stritem) do begin if assigned(stritem.fpstr) then - Message2(type_w_instance_with_abstract,lower(_classname),lower(stritem.fpstr^)); + Message2(type_w_instance_with_abstract,lower(_classname),lower(stritem.fpstr^)); stritem := tstringlistitem(stritem.next); - end; + end; if assigned(AbstractMethodsList) then AbstractMethodsList.Free; end; @@ -2756,15 +2756,64 @@ type function tprocinlinenode.det_resulttype : tnode; + var + storesymtablelevel : longint; + storeparasymtable, + storelocalsymtable : tsymtabletype; + oldprocdef : tprocdef; + oldprocinfo : tprocinfo; + oldinlining_procedure : boolean; begin + result:=nil; + oldinlining_procedure:=inlining_procedure; + oldprocdef:=aktprocdef; + oldprocinfo:=procinfo; + { we're inlining a procedure } + inlining_procedure:=true; + aktprocdef:=inlineprocdef; + + { clone procinfo, but not the asmlists } + procinfo:=tprocinfo(cprocinfo.newinstance); + move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize); + procinfo.aktentrycode:=nil; + procinfo.aktexitcode:=nil; + procinfo.aktproccode:=nil; + procinfo.aktlocaldata:=nil; + + { set new procinfo } + procinfo.return_offset:=retoffset; + procinfo.para_offset:=para_offset; + procinfo.no_fast_exit:=false; + + { set it to the same lexical level } + storesymtablelevel:=aktprocdef.localst.symtablelevel; + storelocalsymtable:=aktprocdef.localst.symtabletype; + storeparasymtable:=aktprocdef.parast.symtabletype; + aktprocdef.localst.symtablelevel:=oldprocdef.localst.symtablelevel; + aktprocdef.localst.symtabletype:=inlinelocalsymtable; + aktprocdef.parast.symtabletype:=inlineparasymtable; + + { pass inlinetree } + resulttypepass(inlinetree); resulttype:=inlineprocdef.rettype; + { retrieve info from inlineprocdef } retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) } para_offset:=0; para_size:=inlineprocdef.para_size(target_info.alignment.paraalign); if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then inc(para_size,POINTER_SIZE); - result:=nil; + + { restore procinfo } + procinfo.free; + procinfo:=oldprocinfo; + { restore symtable } + aktprocdef.localst.symtablelevel:=storesymtablelevel; + aktprocdef.localst.symtabletype:=storelocalsymtable; + aktprocdef.parast.symtabletype:=storeparasymtable; + { restore } + aktprocdef:=oldprocdef; + inlining_procedure:=oldinlining_procedure; end; @@ -2795,7 +2844,10 @@ begin end. { $Log$ - Revision 1.110 2002-11-25 18:43:32 carl + Revision 1.111 2002-11-27 02:31:17 peter + * fixed inlinetree parsing in det_resulttype + + Revision 1.110 2002/11/25 18:43:32 carl - removed the invalid if <> checking (Delphi is strange on this) + implemented abstract warning on instance creation of class with abstract methods.