From 03a9699ce32322a76fbaf3b73389396f4ddf23bf Mon Sep 17 00:00:00 2001 From: peter Date: Mon, 6 Dec 1999 18:17:09 +0000 Subject: [PATCH] * newcg compiler compiles again --- compiler/new/Makefile | 36 ++++++++---- compiler/new/nmem.pas | 11 ++-- compiler/new/pass_2.pas | 15 +++-- compiler/new/tree.pas | 119 ++++++++++++++++++++++++++++++++++++++-- compiler/psub.pas | 7 ++- 5 files changed, 160 insertions(+), 28 deletions(-) diff --git a/compiler/new/Makefile b/compiler/new/Makefile index cc648b57a9..bb6d8ec771 100644 --- a/compiler/new/Makefile +++ b/compiler/new/Makefile @@ -1,5 +1,5 @@ # -# Makefile generated by fpcmake v0.99.13 on 1999-11-25 23:47 +# Makefile generated by fpcmake v0.99.13 on 1999-12-06 18:34 # defaultrule: all @@ -65,12 +65,17 @@ endif # What compiler to use ? ifndef FPC +# Compatibility with old makefiles +ifdef PP +export FPC=$(PP) +else ifdef inOS2 export FPC=ppos2$(EXEEXT) else export FPC=ppc386$(EXEEXT) endif endif +endif # Target OS ifndef OS_TARGET @@ -282,6 +287,7 @@ endif # create fcldir,rtldir,unitdir ifdef FPCDIR +override FPCDIR:=$(subst \,/,$(FPCDIR)) ifneq ($(FPCDIR),.) override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET) override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET) @@ -429,7 +435,15 @@ ifdef CFGFILE override FPCOPT+=@$(CFGFILE) endif -override COMPILER=$(FPC) $(FPCOPT) +# For win32 the options are passed using the environment variable FPCEXTCMD +ifeq ($(OS_SOURCE),win32) +override FPCEXTCMD:=$(FPCOPT) +override FPCOPT:=!FPCEXTCMD +export FPCEXTCMD +endif + +# Compiler commandline +override COMPILER:=$(FPC) $(FPCOPT) ##################################################################### # Shell tools @@ -521,7 +535,7 @@ endif ifeq (,$(findstring -s ,$(COMPILER))) EXECPPAS= else -EXECPPAS=@$(PPAS) +EXECPPAS:=@$(PPAS) endif # ldconfig to rebuild .so cache @@ -810,7 +824,7 @@ fpc_debug: # Default sharedlib units are all unit objects ifndef SHAREDLIBUNITOBJECTS -SHAREDLIBUNITOBJECTS=$(UNITOBJECTS) +SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS) endif fpc_smart: @@ -840,13 +854,13 @@ endif ifdef INSTALLPPUFILES ifdef PPUFILES ifdef inlinux -INSTALLPPULINKFILES=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)) -INSTALLPPULIBFILES=$(shell $(PPUFILES) -L $(INSTALLPPUFILES)) +INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)) +INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES)) else -INSTALLPPULINKFILES=$(shell $(PPUFILES) $(INSTALLPPUFILES)) +INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES)) endif else -INSTALLPPULINKFILES=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) +INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) endif endif @@ -920,7 +934,7 @@ endif # Test dir if none specified ifndef DESTZIPDIR -DESTZIPDIR=$(BASEDIR) +DESTZIPDIR:=$(BASEDIR) endif # Add .zip/.tar.gz extension @@ -975,9 +989,9 @@ endif ifdef CLEANPPUFILES ifdef PPUFILES -CLEANPPULINKFILES=$(shell $(PPUFILES) $(CLEANPPUFILES)) +CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES)) else -CLEANPPULINKFILES=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) +CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) endif endif diff --git a/compiler/new/nmem.pas b/compiler/new/nmem.pas index b5a201bbd5..669302692d 100644 --- a/compiler/new/nmem.pas +++ b/compiler/new/nmem.pas @@ -45,7 +45,7 @@ unit nmem; passignmentnode = ^tassignmentnode; tassignmentnode = object(tbinarynode) assigntyp : tassigntyp; - concat_string : boolean; + concat_string : boolean; constructor init(l,r : pnode); destructor done;virtual; procedure det_temp;virtual; @@ -79,7 +79,7 @@ unit nmem; inherited init; treetype:=loadn; if v^.typ=varsym then - resulttype:=pvarsym(v)^.definition; + resulttype:=pvarsym(v)^.vartype.def; symtableentry:=v; symtable:=st; is_first := False; @@ -183,7 +183,7 @@ unit nmem; location.reference.base:=procinfo.framepointer; location.reference.offset:=pvarsym(symtableentry)^.address; if (symtabletype in [localsymtable,inlinelocalsymtable]) and - not(use_esp_stackframe) then + not(use_esp_stackframe) then location.reference.offset:=-location.reference.offset; if (lexlevel>(symtable^.symtablelevel)) then begin @@ -711,7 +711,10 @@ unit nmem; end. { $Log$ - Revision 1.14 1999-10-12 21:20:46 florian + Revision 1.15 1999-12-06 18:17:10 peter + * newcg compiler compiles again + + Revision 1.14 1999/10/12 21:20:46 florian * new codegenerator compiles again Revision 1.13 1999/09/15 20:35:46 florian diff --git a/compiler/new/pass_2.pas b/compiler/new/pass_2.pas index 60e281bdd9..b3a3375e19 100644 --- a/compiler/new/pass_2.pas +++ b/compiler/new/pass_2.pas @@ -172,12 +172,12 @@ implementation while assigned(hp) do begin if assigned(hp^.parent) then - begin + begin if nf_needs_truefalselabel in hp^.parent^.flags then begin - if not(assigned(punarynode(hp^.parent)^.truelabel)) then + if not(assigned(punarynode(hp^.parent)^.truelabel)) then getlabel(punarynode(hp^.parent)^.truelabel); - if not(assigned(punarynode(hp^.parent)^.falselabel)) then + if not(assigned(punarynode(hp^.parent)^.falselabel)) then getlabel(punarynode(hp^.parent)^.falselabel); truelabel:=punarynode(hp^.parent)^.truelabel; falselabel:=punarynode(hp^.parent)^.falselabel; @@ -315,8 +315,8 @@ implementation { is this correct ???} { retoffset can be negativ for results in eax !! } { the value should be decreased only if positive } - if procinfo^.retoffset>=0 then - dec(procinfo^.retoffset,4); + if procinfo^.return_offset>=0 then + dec(procinfo^.return_offset,4); dec(procinfo^.call_offset,4); aktprocsym^.definition^.parast^.address_fixup:=procinfo^.call_offset; @@ -464,7 +464,10 @@ implementation end. { $Log$ - Revision 1.8 1999-10-12 21:20:47 florian + Revision 1.9 1999-12-06 18:17:10 peter + * newcg compiler compiles again + + Revision 1.8 1999/10/12 21:20:47 florian * new codegenerator compiles again Revision 1.7 1999/08/25 12:00:13 jonas diff --git a/compiler/new/tree.pas b/compiler/new/tree.pas index 1215026d62..c275a23787 100644 --- a/compiler/new/tree.pas +++ b/compiler/new/tree.pas @@ -68,7 +68,7 @@ unit tree; callparan, {Represents a parameter.} realconstn, {Represents a real value.} fixconstn, {Represents a fixed value.} - umminusn, {Represents a sign change (i.e. -2).} + unaryminusn, {Represents a sign change (i.e. -2).} asmn, {Represents an assembler node } vecn, {Represents array indexing.} stringconstn, {Represents a string constant.} @@ -181,6 +181,8 @@ unit tree; treetype : ttreetyp; { the location of the result of this node } location : tlocation; + { do we need to parse childs to set var state } + varstateset : boolean; { the parent node of this is node } { this field is set by concattolist } parent : pnode; @@ -231,6 +233,9 @@ unit tree; { is true, if the right and left operand are swaped } swaped : boolean; + { do we need to parse childs to set var state } + varstateset : boolean; + { the location of the result of this node } location : tlocation; @@ -265,7 +270,7 @@ unit tree; ordconstn : (value : longint); realconstn : (value_real : bestreal;lab_real : pasmlabel); fixconstn : (value_fix: longint); - funcretn : (funcretprocinfo : pointer;retdef : pdef); + funcretn : (funcretprocinfo : pointer;rettype : ttype;is_first_funcret : boolean); subscriptn : (vs : pvarsym); vecn : (memindex,memseg:boolean;callunique : boolean); stringconstn : (value_str : pchar;length : longint; lab_str : pasmlabel;stringtype : tstringtype); @@ -413,6 +418,14 @@ unit tree; { takes care of type casts etc. } procedure set_unique(p : pnode); + { + type + tvarstaterequire = (vsr_can_be_undefined,vsr_must_be_valid, + vsr_is_used_after,vsr_must_be_valid_and_is_used_after); } + + { sets varsym varstate field correctly } + procedure set_varstate(p : ptree;must_be_valid : boolean); + { gibt den ordinalen Werten der Node zurueck oder falls sie } { keinen ordinalen Wert hat, wird ein Fehler erzeugt } function get_ordinal_value(p : ptree) : longint; @@ -432,7 +445,7 @@ unit tree; uses systems, - globals,verbose,files,types; + globals,verbose,files,types,cgbase; {$ifdef EXTDEBUG} @@ -1654,6 +1667,99 @@ unit tree; gensetconstnode:=p; end; + procedure set_varstate(p : ptree;must_be_valid : boolean); + + begin + if not assigned(p) then + exit + else + begin + if p^.varstateset then + exit; + case p^.treetype of + typeconvn,subscriptn : + set_varstate(p^.left,must_be_valid); + vecn: + begin + if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then + set_varstate(p^.left,must_be_valid) + else + set_varstate(p^.left,true); + set_varstate(p^.right,true); + end; + { do not parse calln } + calln : ; + callparan: + begin + set_varstate(p^.left,must_be_valid); + set_varstate(p^.right,must_be_valid); + end; + loadn : + if (p^.symtableentry^.typ=varsym) then + begin + if must_be_valid and p^.is_first then + begin + if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) or + (pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed) then + if (assigned(pvarsym(p^.symtableentry)^.owner) and + assigned(aktprocsym) and + (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then + begin + if p^.symtable^.symtabletype=localsymtable then + Message1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name) + else + Message1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name); + end; + end; + if (p^.is_first) then + begin + if pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found then + { this can only happen at left of an assignment, no ? PM } + if (parsing_para_level=0) and not must_be_valid then + pvarsym(p^.symtableentry)^.varstate:=vs_assigned + else + pvarsym(p^.symtableentry)^.varstate:=vs_used; + if pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed then + pvarsym(p^.symtableentry)^.varstate:=vs_used; + p^.is_first:=false; + end + else + begin + if (pvarsym(p^.symtableentry)^.varstate=vs_assigned) and + (must_be_valid or (parsing_para_level>0) or + (p^.resulttype^.deftype=procvardef)) then + pvarsym(p^.symtableentry)^.varstate:=vs_used; + if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) and + (must_be_valid or (parsing_para_level>0) or + (p^.resulttype^.deftype=procvardef)) then + pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed; + end; + end; + funcretn: + begin + { no claim if setting higher return value_str } + if must_be_valid and + (procinfo=pprocinfo(p^.funcretprocinfo)) and + ((procinfo^.funcret_state=vs_declared) or + ((p^.is_first_funcret) and + (procinfo^.funcret_state=vs_declared_and_first_found))) then + begin + Message(sym_w_function_result_not_set); + { avoid multiple warnings } + procinfo^.funcret_state:=vs_assigned; + end; + if p^.is_first_funcret and not must_be_valid then + pprocinfo(p^.funcretprocinfo)^.funcret_state:=vs_assigned; + end; + else + begin + {internalerror(565656);} + end; + end;{case } + p^.varstateset:=true; + end; + end; + procedure set_location(var destloc,sourceloc : tlocation); begin @@ -1931,7 +2037,7 @@ unit tree; equal_trees:=(equal_trees(t1^.left,t2^.left) and equal_trees(t1^.right,t2^.right)); end; - umminusn, + unaryminusn, notn, derefn, addrn: @@ -2044,7 +2150,10 @@ unit tree; end. { $Log$ - Revision 1.17 1999-12-01 12:42:34 peter + Revision 1.18 1999-12-06 18:17:10 peter + * newcg compiler compiles again + + Revision 1.17 1999/12/01 12:42:34 peter * fixed bug 698 * removed some notes about unused vars diff --git a/compiler/psub.pas b/compiler/psub.pas index b21402e2c9..4137c096ae 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -1501,7 +1501,7 @@ begin aktlocalswitches:=entryswitches; {$ifndef NOPASS2} {$ifdef newcg} - tg.setfirsttemp(procinfo^.firsttemp); + tg.setfirsttemp(procinfo^.firsttemp_offset); {$else newcg} if assigned(code) then generatecode(code); @@ -1941,7 +1941,10 @@ end. { $Log$ - Revision 1.37 1999-11-30 10:40:48 peter + Revision 1.38 1999-12-06 18:17:09 peter + * newcg compiler compiles again + + Revision 1.37 1999/11/30 10:40:48 peter + ttype, tsymlist Revision 1.36 1999/11/22 00:23:09 pierre