* merges from fixes

compiler/ag386bin.pas

@@ -977,15 +977,28 @@ unit ag386bin;
 
 
    destructor ti386binasmlist.done;
+{$ifdef MEMDEBUG}
+      var
+        d : tmemdebug;
+{$endif}
       begin
+{$ifdef MEMDEBUG}
+         d.init('agbin');
+{$endif}
         dispose(objectoutput,done);
         dispose(objectalloc,done);
+{$ifdef MEMDEBUG}
+         d.done;
+{$endif}
       end;
 
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:24  michael
+  Revision 1.4  2000-08-04 22:00:50  peter
+    * merges from fixes
+
+  Revision 1.3  2000/07/13 12:08:24  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:29  michael

compiler/cg386add.pas

@@ -673,7 +673,7 @@ implementation
          pushed,mboverflow,cmpop : boolean;
          op,op2 : tasmop;
          flags : tresflags;
-         otl,ofl,hl : pasmlabel;
+         otl,ofl : pasmlabel;
          power : longint;
          opsize : topsize;
          hl4: pasmlabel;
@@ -2324,7 +2324,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-07-27 09:25:05  jonas
+  Revision 1.4  2000-08-04 22:00:50  peter
+    * merges from fixes
+
+  Revision 1.3  2000/07/27 09:25:05  jonas
     * moved locflags2reg() procedure from cg386add to cgai386
     + added locjump2reg() procedure to cgai386
     * fixed internalerror(2002) when the result of a case expression has
@@ -2334,4 +2337,4 @@ end.
   Revision 1.2  2000/07/13 11:32:32  michael
   + removed logs
 
-}
+}

compiler/cg386inl.pas

@@ -898,7 +898,7 @@ implementation
          l : longint;
          ispushed : boolean;
          hregister : tregister;
-         otlabel,oflabel,l1   : pasmlabel;
+         otlabel,oflabel{,l1}   : pasmlabel;
          oldpushedparasize : longint;
 
       begin
@@ -1468,7 +1468,7 @@ implementation
                          else
                            emit_none(A_FCOS,S_NO);
                          {
-			 getlabel(l1);
+                         getlabel(l1);
                          emit_reg(A_FNSTSW,S_NO,R_AX);
                          emit_none(A_SAHF,S_NO);
                          emitjmp(C_NP,l1);
@@ -1528,7 +1528,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-07-29 18:27:53  sg
+  Revision 1.5  2000-08-04 22:00:50  peter
+    * merges from fixes
+
+  Revision 1.4  2000/07/29 18:27:53  sg
   * Applied patch by Markus Kaemmerer which removes a tiny memory leak
     for the generation of code for in_[sin|cos]_extended code
     (a label has been created but never used afterwards)

compiler/compiler.pas

@@ -342,6 +342,9 @@ begin
   Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
 {$endif newcg}
 {$endif EXTDEBUG}
+{$ifdef MEMDEBUG}
+  Writeln('Memory used: ',system.Heapsize);
+{$endif}
 {$ifdef fixLeaksOnError}
  {$ifdef tp}
   do_stop;
@@ -355,7 +358,9 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:38  michael
-  + removed logs
+  Revision 1.3  2000-08-04 22:00:50  peter
+    * merges from fixes
 
+  Revision 1.2  2000/07/13 11:32:38  michael
+  + removed logs
 }

compiler/comprsrc.pas

@@ -66,17 +66,21 @@ end;
 
 procedure tresourcefile.compile;
 var
+  respath : pathstr;
+  n       : namestr;
+  e       : extstr;
   s,
   resobj,
-  respath,
-  resbin : string;
+  resbin   : string;
   resfound : boolean;
 begin
+  resbin:='';
   if utilsdirectory<>'' then
-   respath:=FindFile(target_res.resbin+source_os.exeext,utilsdirectory,resfound)
-  else
-   respath:=FindExe(target_res.resbin,resfound);
-  resbin:=respath+target_res.resbin+source_os.exeext;
+   resbin:=FindFile(target_res.resbin+source_os.exeext,utilsdirectory,resfound)+target_res.resbin+source_os.exeext;
+  if resbin='' then
+   resbin:=FindExe(target_res.resbin,resfound);
+  { get also the path to be searched for the windres.h }
+  fsplit(resbin,respath,n,e);
   if (not resfound) and not(cs_link_extern in aktglobalswitches) then
    begin
      Message(exec_w_res_not_found);
@@ -136,7 +140,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:38  michael
+  Revision 1.3  2000-08-04 22:00:51  peter
+    * merges from fixes
+
+  Revision 1.2  2000/07/13 11:32:38  michael
   + removed logs
 
 }

compiler/pexpr.pas

@@ -141,7 +141,7 @@ unit pexpr;
                do_firstpass(p);
                set_varstate(p,false);
                { reset varstateset to maybe set used state later web bug769 PM }
-               p^.varstateset:=false;
+               unset_varstate(p);
                if not(getprocvar) and (p^.resulttype^.deftype=procvardef) then
                  begin
                     p1:=gencallnode(nil,nil);
@@ -2170,7 +2170,9 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:44  michael
-  + removed logs
+  Revision 1.3  2000-08-04 22:00:52  peter
+    * merges from fixes
 
+  Revision 1.2  2000/07/13 11:32:44  michael
+  + removed logs
 }

compiler/popt386.pas

@@ -101,7 +101,7 @@ Procedure PeepHoleOptPass1(Asml: PAasmOutput; BlockStart, BlockEnd: Pai);
 {First pass of peepholeoptimizations}
 
 Var
-  l, l1 : longint;
+  l : longint;
   p,hp1,hp2 : pai;
   hp3,hp4: pai;
 
@@ -1945,7 +1945,10 @@ End.
 
 {
   $Log$
-  Revision 1.6  2000-07-31 08:44:05  jonas
+  Revision 1.7  2000-08-04 22:00:52  peter
+    * merges from fixes
+
+  Revision 1.6  2000/07/31 08:44:05  jonas
     - removed imul support from -dfoldarithops since "imull [reg32],[mem32]"
       doesn't exist (merged from fixes branch)
 

compiler/tcmem.pas

@@ -607,10 +607,7 @@ implementation
          if assigned(p^.left) and assigned(p^.right) then
             begin
                firstpass(p^.left);
-               { is this correct ?  At least after is like if used
-               set_varstate(p^.left,false);
-                 already done in _with_statment }
-               p^.left^.varstateset:=false;
+               unset_varstate(p^.left);
                set_varstate(p^.left,true);
                if codegenerror then
                  exit;
@@ -642,7 +639,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-02 19:49:59  peter
+  Revision 1.5  2000-08-04 22:00:52  peter
+    * merges from fixes
+
+  Revision 1.4  2000/08/02 19:49:59  peter
     * first things for default parameters
 
   Revision 1.3  2000/07/13 12:08:28  michael

compiler/tree.pas

@@ -342,6 +342,7 @@ unit tree;
       vsr_is_used_after,vsr_must_be_valid_and_is_used_after); }
 
     { sets varsym varstate field correctly }
+    procedure unset_varstate(p : ptree);
     procedure set_varstate(p : ptree;must_be_valid : boolean);
 
     { gibt den ordinalen Werten der Node zurueck oder falls sie }
@@ -1808,6 +1809,24 @@ unit tree;
            end;
       end;
 
+
+    procedure unset_varstate(p : ptree);
+      begin
+        while assigned(p) do
+         begin
+           p^.varstateset:=false;
+           case p^.treetype of
+             typeconvn,
+             subscriptn,
+             vecn :
+               p:=p^.left;
+             else
+               break;
+           end;
+         end;
+      end;
+
+
     procedure set_varstate(p : ptree;must_be_valid : boolean);
 
       begin
@@ -1838,18 +1857,10 @@ unit tree;
              set_varstate(p^.left,must_be_valid);
            vecn:
              begin
-             {$IFDEF NEWST}
-               if (typeof(p^.left^.resulttype^)=typeof(Tstringdef)) or
-                (typeof(p^.left^.resulttype^)=typeof(Tarraydef)) then
-                 set_varstate(p^.left,must_be_valid)
-               else
-                 set_varstate(p^.left,true);
-             {$ELSE}
                if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then
                  set_varstate(p^.left,must_be_valid)
                else
                  set_varstate(p^.left,true);
-             {$ENDIF NEWST}
                set_varstate(p^.right,true);
              end;
            { do not parse calln }
@@ -1860,50 +1871,6 @@ unit tree;
                set_varstate(p^.right,must_be_valid);
              end;
            loadn :
-         {$IFDEF NEWST}
-         if (typeof(p^.symtableentry^)=typeof(Tvarsym)) or
-           (typeof(p^.symtableentry^)=typeof(Tparamsym)) then
-          begin
-            if must_be_valid and p^.is_first then
-              begin
-                if (pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found) or
-                   (pvarsym(p^.symtableentry)^.state=vs_set_but_first_not_passed) then
-                 if (assigned(pvarsym(p^.symtableentry)^.owner) and
-                    assigned(aktprocsym) and
-                    (pvarsym(p^.symtableentry)^.owner=
-                     Pcontainingsymtable(aktprocdef^.localst))) then
-                  begin
-                    if typeof(p^.symtable^)=typeof(Tprocsymtable) then
-                     CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
-                    else
-                     CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
-                  end;
-              end;
-          if (p^.is_first) then
-           begin
-             if pvarsym(p^.symtableentry)^.state=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)^.state:=vs_assigned
-              else
-               pvarsym(p^.symtableentry)^.state:=vs_used;
-             if pvarsym(p^.symtableentry)^.state=vs_set_but_first_not_passed then
-               pvarsym(p^.symtableentry)^.state:=vs_used;
-             p^.is_first:=false;
-           end
-         else
-           begin
-             if (pvarsym(p^.symtableentry)^.state=vs_assigned) and
-                (must_be_valid or (parsing_para_level>0) or
-                 (typeof(p^.resulttype^)=typeof(Tprocvardef))) then
-               pvarsym(p^.symtableentry)^.state:=vs_used;
-             if (pvarsym(p^.symtableentry)^.state=vs_declared_and_first_found) and
-                (must_be_valid or (parsing_para_level>0) or
-                (typeof(p^.resulttype^)=typeof(Tprocvardef))) then
-               pvarsym(p^.symtableentry)^.state:=vs_set_but_first_not_passed;
-           end;
-         end;
-         {$ELSE}
          if (p^.symtableentry^.typ=varsym) then
           begin
             if must_be_valid and p^.is_first then
@@ -1944,7 +1911,6 @@ unit tree;
                pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
            end;
          end;
-         {$ENDIF NEWST}
          funcretn:
          begin
          { no claim if setting higher return value_str }
@@ -2121,7 +2087,9 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:52  michael
-  + removed logs
+  Revision 1.3  2000-08-04 22:00:52  peter
+    * merges from fixes
 
+  Revision 1.2  2000/07/13 11:32:52  michael
+  + removed logs
 }

compiler/utils/samplecfg

@@ -4,18 +4,26 @@
 #
 #  Generate Sample Free Pascal configuration file
 #
-if [ $# != 1 ]; then
+if [ $# == 0 ]; then
   echo 'Usage :'
-  echo 'samplecfg fpcdir'
+  echo 'samplecfg fpcdir confdir'
   echo 'fpcdir = Path where FPC is installed'
+  echo 'confdir = Path to /etc'
   exit 1
 fi
+if [ $2 ]; then
+  sysdir=$2
+  [ -d $sysdir ] || mkdir $sysdir 
+else
+  sysdir=/etc
+fi
+
 # Detect if we have write permission in root.
-if [ -w /etc ] ; then
-  echo Write permission in /etc.
-  thefile=/etc/ppc386.cfg
+if [ -w $sysdir ] ; then
+  echo Write permission in $sysdir.
+  thefile=$sysdir/ppc386.cfg
 else
-  echo No write premission in /etc.
+  echo No write premission in $sysdir.
   thefile=$HOME/.ppc386.cfg
 fi
 #
@@ -38,7 +46,7 @@ echo Found libgcc.a in $GCCDIR
 echo Writing sample configuration file to $thefile
 cat <<EOFCFG > $thefile
 #
-# Example ppc386.cfg for Free Pascal Compiler Version 1.00
+# Example ppc386.cfg for Free Pascal Compiler
 #
 
 # ----------------------
@@ -193,7 +201,7 @@ cat <<EOFCFG > $thefile
 # a : Show everything             0 : Show nothing (except errors)
 
 # Display Info, Warnings, Notes and Hints
--viwnh
+-viwn
 # If you don't want so much verbosity use
 #-vw