* newcg compiler compiles again

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))
+INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES=$(shell $(PPUFILES) -L $(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
 

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

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
+                         if procinfo^.return_offset>=0 then
-                           dec(procinfo^.retoffset,4);
+                           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

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
 

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