Merged revisions 6817-6822,6825-6826,6830 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r6817 | jonas | 2007-03-13 11:17:33 +0100 (Tue, 13 Mar 2007) | 3 lines

  * make variables not regable if they are referenced by an absolute
    variable of a different size

........
r6818 | jonas | 2007-03-13 13:57:06 +0100 (Tue, 13 Mar 2007) | 3 lines

  * fixed missing swapleftright in case of substracting unsigned numbers
    with overflow checking turned on

........
r6819 | jonas | 2007-03-13 15:49:03 +0100 (Tue, 13 Mar 2007) | 2 lines

  * fixed rangecheck define typo

........
r6820 | jonas | 2007-03-13 15:50:26 +0100 (Tue, 13 Mar 2007) | 3 lines

  * never store/restore lr for nostackframe routines, even if debugging
    is turned on

........
r6821 | jonas | 2007-03-13 15:51:47 +0100 (Tue, 13 Mar 2007) | 5 lines

  * don't create debugging entries for generic typesyms, since they
    refer to typedefs which aren't written out either
  * fixed longstring debuginfo and fixed overflow/range errors with
    in creating it on 64 bit systems

........
r6822 | jonas | 2007-03-13 16:15:53 +0100 (Tue, 13 Mar 2007) | 2 lines

  * fixed range check error

........
r6825 | jonas | 2007-03-13 19:54:01 +0100 (Tue, 13 Mar 2007) | 2 lines

  * fixed memory leak in dosimplify

........
r6826 | jonas | 2007-03-13 19:54:27 +0100 (Tue, 13 Mar 2007) | 2 lines

  * fixed memory leak in executeprocess for FPC_USE_FPEXEC

........
r6830 | jonas | 2007-03-13 22:56:25 +0100 (Tue, 13 Mar 2007) | 4 lines

  * nothingn has a complexity of 0
  * stop complexity calculation if we get to the end of a series of a
    statements instead of crashing

........

git-svn-id: branches/fixes_2_2@6842 -

.gitattributes

@@ -8063,6 +8063,7 @@ tests/webtbs/tw8321.pp svneol=native#text/plain
 tests/webtbs/tw8371.pp svneol=native#text/plain
 tests/webtbs/tw8391.pp svneol=native#text/plain
 tests/webtbs/tw8434.pp svneol=native#text/plain
+tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

compiler/dbgdwarf.pas

@@ -1322,13 +1322,14 @@ implementation
 
     procedure TDebugInfoDwarf.appenddef_string(def:tstringdef);
 
-      procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: cardinal);
+      procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: aword);
         var
-          slen : aint;
+          { maxlen can be > high(int64) }
+          slen : aword;
           arr : tasmlabel;
         begin
           { fix length of openshortstring }
-          slen:=def.len;
+          slen:=aword(def.len);
           if slen=0 then
             slen:=maxlen;
 
@@ -1390,7 +1391,11 @@ implementation
             end;
           st_longstring:
             begin
-              addnormalstringdef('LongString',u32inttype,$ffffffff);
+{$ifdef cpu64bit}
+              addnormalstringdef('LongString',u64inttype,qword(-1));
+{$else cpu64bit}
+              addnormalstringdef('LongString',u32inttype,cardinal(-1));
+{$endif cpu64bit}
            end;
          st_ansistring:
            begin
@@ -1945,10 +1950,13 @@ implementation
 
       procedure TDebugInfoDwarf.appendsym_type(sym: ttypesym);
         begin
-          append_entry(DW_TAG_typedef,false,[
-            DW_AT_name,DW_FORM_string,symname(sym)+#0
-          ]);
-          append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.typedef));
+          if not(df_generic in sym.typedef.defoptions) then
+            begin
+              append_entry(DW_TAG_typedef,false,[
+                DW_AT_name,DW_FORM_string,symname(sym)+#0
+              ]);
+              append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.typedef));
+            end;
           finish_entry;
 
           (* Moved fom append sym, do we need this (MWE)

compiler/nutils.pas

@@ -556,7 +556,7 @@ implementation
     function node_complexity(p: tnode): cardinal;
       begin
         result := 0;
-        while true do
+        while assigned(p) do
           begin
             case p.nodetype of
               temprefn,
@@ -629,6 +629,7 @@ implementation
               tempdeleten,
               ordconstn,
               pointerconstn,
+              nothingn,
               niln:
                 exit;
               else
@@ -672,6 +673,7 @@ implementation
         if assigned(hn) then
           begin
             treechanged:=true;
+            n.free;
             n:=hn;
             typecheckpass(n);
           end;

compiler/pdecvar.pas

@@ -51,7 +51,7 @@ implementation
        systems,
        { symtable }
        symconst,symbase,symtype,symtable,defutil,defcmp,
-       fmodule,
+       fmodule,htypechk,
        { pass 1 }
        node,pass_1,aasmdata,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
@@ -814,6 +814,14 @@ implementation
                   abssym.fileinfo:=vs.fileinfo;
                   abssym.abstyp:=tovar;
                   abssym.ref:=node_to_propaccesslist(pt);
+                  { if the sizes are different, can't be a regvar since you }
+                  { can't be "absolute upper 8 bits of a register" (except  }
+                  { if its a record field of the same size of a record      }
+                  { regvar, but in that case pt.resultdef.size will have    }
+                  { the same size since it refers to the field and not to   }
+                  { the whole record -- which is why we use pt and not hp)  }
+                  if (vs.vardef.size <> pt.resultdef.size) then
+                    make_not_regable(pt,vr_addr);
                 end
               else
                 Message(parser_e_absolute_only_to_var_or_const);

compiler/powerpc64/cgcpu.pas

@@ -1438,10 +1438,11 @@ begin
 
   { determine whether we need to save the link register }
   needslinkreg :=
-    ((not (po_assembler in current_procinfo.procdef.procoptions)) and
-      ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
-    ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
-    ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []);
+    not(nostackframe) and
+    (((not (po_assembler in current_procinfo.procdef.procoptions)) and
+       ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
+     ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
+     ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []));
 
   a_reg_alloc(list, NR_STACK_POINTER_REG);
   a_reg_alloc(list, NR_R0);
@@ -1578,10 +1579,11 @@ begin
 
   { determine whether we need to restore the link register }
   needslinkreg :=
-    ((not (po_assembler in current_procinfo.procdef.procoptions)) and
-      ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
-    ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
-    ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []);
+    not(nostackframe) and
+    (((not (po_assembler in current_procinfo.procdef.procoptions)) and
+       ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or
+     ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or
+     ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> []));
 
   { calculate stack frame }
   localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(

compiler/powerpc64/nppcadd.pas

@@ -325,6 +325,8 @@ begin
           end;
         subn:
           begin
+            if (nf_swapped in flags) then
+              swapleftright;
             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB, location.register,
               left.location.register, right.location.register));
             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLD,

compiler/ptconst.pas

@@ -72,7 +72,7 @@ implementation
 
 
 {$ifopt r+}
-{$defined rangeon}
+{$define rangeon}
 {$r-}
 {$endif}
 

packages/extra/bfd/bfd.pas

@@ -1928,7 +1928,7 @@ is in practice already 0 *)
   ); { bfd_error }
 
 const
-  BFD_NO_MORE_SYMBOLS: symindex = not symindex(0);
+  BFD_NO_MORE_SYMBOLS: symindex = symindex(not symindex(0));
 
   bfd_mach_m68000 = 1;
   bfd_mach_m68008 = 2;

rtl/unix/sysutils.pp

@@ -907,6 +907,11 @@ Begin
   { We're in the parent, let's wait. }
   result:=WaitProcess(pid); // WaitPid and result-convert
 
+  {$ifdef FPC_USE_FPEXEC}
+  if Comline<>'' Then
+    freemem(cmdline2);
+  {$endif}
+
   if (result<0) or (result=127) then
     begin
     E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);

tests/webtbs/tw8513.pp

@@ -0,0 +1,54 @@
+type
+  TMyType = cardinal;
+  tr = record
+    a,b,c,d: byte;
+  end;
+
+procedure t(var l: cardinal);
+begin
+  if (l <> $cafebabe) then
+    halt(4);
+  l := $c001d00d;
+end;
+
+var
+  Item: TMyType;
+  ItemAsByte: byte absolute Item;
+
+  r: tr;
+  b: byte absolute r.b;
+
+  l: cardinal;
+  labs: cardinal absolute l;
+begin
+  { Of course I understand fully that this code is bad
+    (unless you really want to read the 1st byte of 4-byte LongInt
+    type, messing with endianess problems).
+
+    In real code, I accessed ItemAsByte only when
+    SizeOf(TMyType) = 1 (the code is
+    used like a simple template, so it must work with any
+    TMyType, and the case when SizeOf(TMyType) = 1 uses some
+    specially optimized versions (e.g. FillChar(..., ItemAsByte)
+    can be used in this case to fill the array of TMyType). }
+
+{$ifdef FPC_BIG_ENDIAN}
+  item:=$deadbeef;
+{$else}
+  item:=$efbeadde;
+{$endif}
+  if (itemasbyte <> $de) then
+    halt(1);
+
+  r.a := $de;
+  r.b := $ad;
+  r.c := $be;
+  r.d := $ef;
+  if (b <> $ad) then
+    halt(2);
+
+  l := $cafebabe;
+  t(labs);
+  if (l <> $c001d00d) then
+    halt(6);
+end.