Merged revisions 8909,9274,9290,9294,9315,9323,9325,9332,9381,9413,9415,9419,9422,9445 via svnmerge from

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

........
r8909 | peter | 2007-10-22 18:36:41 +0200 (Mon, 22 Oct 2007) | 2 lines

  * fix 32bit truncation in type determination of constant operands

........
r9274 | jonas | 2007-11-17 20:53:33 +0100 (Sat, 17 Nov 2007) | 3 lines

  * fixed GetDirs in case the last character of the passed directory
    = PathDelim (called like that from the compiler)

........
r9290 | peter | 2007-11-18 22:40:17 +0100 (Sun, 18 Nov 2007) | 5 lines

  * all functions use DirSeparators. This is required to be able to have consistent
    result values that can be used as input values. A problem with inconsitency was
    in ForceDirectories where excludetrailingpathdelimiter did not remove a / under win32
    and ExtractFilePath found the / as a separator. With the end result an infinite loop.

........
r9294 | jonas | 2007-11-19 10:45:11 +0100 (Mon, 19 Nov 2007) | 3 lines

  * solaris has to link to libsocket and libnsl when using socket
    functions

........
r9315 | jonas | 2007-11-22 10:03:35 +0100 (Thu, 22 Nov 2007) | 3 lines

  - removed some unnecessary cg. prefixes when calling tcg methods
    from inside other tcg methods

........
r9323 | jonas | 2007-11-24 17:43:47 +0100 (Sat, 24 Nov 2007) | 4 lines

  - no longer pass "-read_only_relocs suppress" to the darwin linker when
    compiling shared libraries as we no longer generate relocations in
    read-only sections

........
r9325 | jonas | 2007-11-24 19:06:01 +0100 (Sat, 24 Nov 2007) | 7 lines

  * fixed handling of directories with spaces for LdSupportsNoResponseFile-
    targets (a.o. darwin) in case no ppas.sh is generated (need to generate
    a temporary script in that case as well to use the IFS trick)
  * fixed exit code checking of ld when using IFS trick (have to check it
    before restoring IFS, otherwise we check the "error result" of this
    restoration, which will always be 0)

........
r9332 | marco | 2007-11-25 19:08:08 +0100 (Sun, 25 Nov 2007) | 1 line

 * asmscript stuff under if ldnoresponsfile. Fixes FreeBSD breakage
........
r9381 | jonas | 2007-12-02 16:58:48 +0100 (Sun, 02 Dec 2007) | 4 lines

  * don't handle dynamic arrays using fpc_copy_proc(), because it 
    takes the address of its parameters and a dynamic array can
    be in a register (e.g. as function result, mantis #10320)

........
r9413 | jonas | 2007-12-07 19:24:57 +0100 (Fri, 07 Dec 2007) | 3 lines

  * flush pending local switch changes before evaluating ifopt
    (mantis #10350)

........
r9415 | jonas | 2007-12-08 16:43:36 +0100 (Sat, 08 Dec 2007) | 2 lines

  * updated svn:ignore properties

........
r9419 | jonas | 2007-12-08 23:56:58 +0100 (Sat, 08 Dec 2007) | 5 lines

  + call fpc_cpucodeinit, so sse_support gets initialised for *bsd/darwin
  + support for catching sigill on FreeBSD in case not running on
    an SSE2-capable cpu (untested) -- Darwin only runs on SSE2-capable 
    cpus

........
r9422 | jonas | 2007-12-09 19:06:44 +0100 (Sun, 09 Dec 2007) | 2 lines

  * fixed location.size for divmodn (in particular the sign)

........
r9445 | jonas | 2007-12-13 22:48:06 +0100 (Thu, 13 Dec 2007) | 2 lines

  * moved to the correct location

........

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

.gitattributes

@@ -7277,7 +7277,6 @@ tests/test/tunroll1.pp svneol=native#text/plain
 tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tvarset1.pp svneol=native#text/plain
-tests/test/tw6727.pp svneol=native#text/plain
 tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
 tests/test/twide3.pp svneol=native#text/plain
@@ -7750,6 +7749,8 @@ tests/webtbs/tw10013.pp svneol=native#text/plain
 tests/webtbs/tw10072.pp svneol=native#text/plain
 tests/webtbs/tw1021.pp svneol=native#text/plain
 tests/webtbs/tw1023.pp svneol=native#text/plain
+tests/webtbs/tw10320.pp svneol=native#text/plain
+tests/webtbs/tw10350.pp svneol=native#text/plain
 tests/webtbs/tw1041.pp svneol=native#text/plain
 tests/webtbs/tw1044.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain
@@ -8449,6 +8450,7 @@ tests/webtbs/tw6686.pp svneol=native#text/plain
 tests/webtbs/tw6687.pp svneol=native#text/plain
 tests/webtbs/tw6690.pp svneol=native#text/plain
 tests/webtbs/tw6700.pp svneol=native#text/plain
+tests/webtbs/tw6727.pp svneol=native#text/plain
 tests/webtbs/tw6735.pp svneol=native#text/plain
 tests/webtbs/tw6737.pp -text
 tests/webtbs/tw6742.pp svneol=native#text/plain

.gitignore

@@ -87,6 +87,7 @@ compiler/powerpc/*.ppu
 compiler/powerpc/*.s
 compiler/powerpc/fpcmade.*
 compiler/powerpc/units
+compiler/powerpc64/units
 compiler/ppc1
 compiler/ppc2
 compiler/ppc3
@@ -114,11 +115,14 @@ compiler/utils/*.exe
 compiler/utils/*.o
 compiler/utils/*.ppu
 compiler/utils/*.s
+compiler/utils/dummyas
 compiler/utils/fpc
 compiler/utils/fpcmade.*
 compiler/utils/fpcmkcfg
 compiler/utils/fpcsubst
 compiler/utils/fppkg
+compiler/utils/mkx86ins
+compiler/utils/mkx86reg
 compiler/utils/ppudump
 compiler/utils/ppufiles
 compiler/utils/ppumove

compiler/cgobj.pas

@@ -1895,7 +1895,7 @@ implementation
 
         tmpreg:=getintregister(list,bitnumbersize);
         a_op_const_reg_reg(list,OP_SHR,bitnumbersize,3,bitnumber,tmpreg);
-        tmpaddrreg:=cg.getaddressregister(list);
+        tmpaddrreg:=getaddressregister(list);
         a_load_reg_reg(list,bitnumbersize,OS_ADDR,tmpreg,tmpaddrreg);
         if (result.ref.base=NR_NO) then
           result.ref.base:=tmpaddrreg
@@ -1918,7 +1918,7 @@ implementation
       var
         tmpvalue: tregister;
       begin
-        tmpvalue:=cg.getintregister(list,valuesize);
+        tmpvalue:=getintregister(list,valuesize);
 
         if (target_info.endian=endian_little) then
           begin
@@ -2029,7 +2029,7 @@ implementation
       var
         tmpvalue: tregister;
       begin
-        tmpvalue:=cg.getintregister(list,destsize);
+        tmpvalue:=getintregister(list,destsize);
 
         if (target_info.endian=endian_little) then
           begin
@@ -2102,7 +2102,7 @@ implementation
           LOC_CSUBSETREG:
             begin
               { hard to do in-place in a generic way, so operate on a copy }
-              tmpreg:=cg.getintregister(list,loc.size);
+              tmpreg:=getintregister(list,loc.size);
               a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg);
               a_bit_set_reg_reg(list,doset,bitnumbersize,loc.size,bitnumber,tmpreg);
               a_load_reg_subsetreg(list,loc.size,loc.size,tmpreg,loc.sreg);

compiler/nld.pas

@@ -609,7 +609,8 @@ implementation
          end
         { call helpers for composite types containing automated types }
         else if (left.resultdef.needs_inittable) and
-            (left.resultdef.typ in [arraydef,objectdef,recorddef]) then
+            (left.resultdef.typ in [arraydef,objectdef,recorddef]) and
+            not is_dynamic_array(left.resultdef) then
          begin
            hp:=ccallparanode.create(caddrnode.create_internal(
                   crttinode.create(tstoreddef(left.resultdef),initrtti)),

compiler/scanner.pas

@@ -487,6 +487,11 @@ implementation
 
     procedure dir_ifopt;
       begin
+        if localswitcheschanged then
+          begin
+            current_settings.localswitches:=nextlocalswitches;
+            localswitcheschanged:=false;
+          end;
         current_scanner.ifpreprocstack(pp_ifopt,@opt_check,scan_c_ifopt_found);
       end;
 

compiler/script.pas

@@ -382,8 +382,8 @@ begin
   Add('IFS="');
   Add('"');
   Add(maybequoted(command)+' '+Options);
-  Add('IFS=$OFS');
   Add('if [ $? != 0 ]; then DoExitLink '+ScriptFixFileName(FileName)+'; fi');
+  Add('IFS=$OFS');
 end;
 
 

compiler/systems/t_bsd.pas

@@ -545,13 +545,6 @@ begin
         LinkRes.Add(')');
       end;
    end;
-  { ignore the fact that our relocations are in non-writable sections, }
-  { will be fixed once we have pic support                             }
-  if isdll and IsDarwin Then
-    begin
-      LinkRes.Add('-read_only_relocs');
-      LinkRes.Add('suppress');
-    end;
 { Write and Close response }
   linkres.writetodisk;
   linkres.Free;
@@ -564,11 +557,12 @@ function TLinkerBSD.MakeExecutable:boolean;
 var
   binstr,
   cmdstr  : TCmdStr;
-  success : boolean;
+  linkscript: TAsmScript;
   DynLinkStr : string[60];
   GCSectionsStr,
   StaticStr,
   StripStr   : string[40];
+  success : boolean;
 begin
   if not(cs_link_nolink in current_settings.globalswitches) then
    Message1(exec_i_linking,current_module.exefilename^);
@@ -625,11 +619,33 @@ begin
   Replace(cmdstr,'$STRIP',StripStr);
   Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
   Replace(cmdstr,'$DYNLINK',DynLinkStr);
-  success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,LdSupportsNoResponseFile);
+  BinStr:=FindUtil(utilsprefix+BinStr);
+
+  if (LdSupportsNoResponseFile) and
+     not(cs_link_nolink in current_settings.globalswitches) then
+    begin
+      { we have to use a script to use the IFS hack }
+      linkscript:=TAsmScriptUnix.create(outputexedir+'ppaslink');
+      linkscript.AddLinkCommand(BinStr,CmdStr,'');
+      linkscript.WriteToDisk;
+      BinStr:=linkscript.fn;
+      if not path_absolute(BinStr) then
+        BinStr:='./'+BinStr;
+      CmdStr:='';
+    end;
+
+  success:=DoExec(BinStr,CmdStr,true,LdSupportsNoResponseFile);
 
 { Remove ReponseFile }
   if (success) and not(cs_link_nolink in current_settings.globalswitches) then
-   DeleteFile(outputexedir+Info.ResName);
+   begin
+     DeleteFile(outputexedir+Info.ResName);
+     if LdSupportsNoResponseFile Then
+       begin
+         DeleteFile(linkscript.fn);
+         linkscript.free
+       end; 
+   end;
 
   MakeExecutable:=success;   { otherwise a recursive call to link method }
 end;
@@ -640,6 +656,7 @@ var
   InitStr,
   FiniStr,
   SoNameStr : string[80];
+  linkscript: TAsmScript;
   binstr,
   cmdstr  : TCmdStr;
   success : boolean;
@@ -667,8 +684,22 @@ begin
   Replace(cmdstr,'$INIT',InitStr);
   Replace(cmdstr,'$FINI',FiniStr);
   Replace(cmdstr,'$SONAME',SoNameStr);
+  BinStr:=FindUtil(utilsprefix+BinStr);
 
-  success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,LdSupportsNoResponseFile);
+  if (LdSupportsNoResponseFile) and
+     not(cs_link_nolink in current_settings.globalswitches) then
+    begin
+      { we have to use a script to use the IFS hack }
+      linkscript:=TAsmScriptUnix.create(outputexedir+'ppaslink');
+      linkscript.AddLinkCommand(BinStr,CmdStr,'');
+      linkscript.WriteToDisk;
+      BinStr:=linkscript.fn;
+      if not path_absolute(BinStr) then
+        BinStr:='./'+BinStr;
+      CmdStr:='';
+    end;
+
+  success:=DoExec(BinStr,cmdstr,true,LdSupportsNoResponseFile);
 
 { Strip the library ? }
   if success and (cs_link_strip in current_settings.globalswitches) then
@@ -680,7 +711,11 @@ begin
 
 { Remove ReponseFile }
   if (success) and not(cs_link_nolink in current_settings.globalswitches) then
-   DeleteFile(outputexedir+Info.ResName);
+    begin
+      DeleteFile(outputexedir+Info.ResName);
+//      DeleteFile(linkscript.fn);
+      linkscript.free
+    end;     
 
   MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
 end;

compiler/x86/aasmcpu.pas

@@ -998,7 +998,7 @@ implementation
                   { allow 2nd or 3rd operand being a constant and expect no size for shuf* etc. }
                   if (opsize=S_NO) and not(i in [1,2]) then
                     message(asmr_e_invalid_opcode_and_operand);
-                  if (opsize<>S_W) and (longint(val)>=-128) and (val<=127) then
+                  if (opsize<>S_W) and (aint(val)>=-128) and (val<=127) then
                     ot:=OT_IMM8 or OT_SIGNED
                   else
                     ot:=OT_IMMEDIATE or opsize_2_type[i,opsize];

compiler/x86_64/nx64mat.pas

@@ -73,8 +73,8 @@ implementation
           exit;
 
         { put numerator in register }
-        location_reset(location,LOC_REGISTER,OS_INT);
-        location_force_reg(current_asmdata.CurrAsmList,left.location,OS_INT,false);
+        location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+        location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,false);
         hreg1:=left.location.register;
 
         if (nodetype=divn) and (right.nodetype=ordconstn) and

rtl/bsd/system.pp

@@ -277,6 +277,9 @@ Begin
   StackBottom := Sptr - StackLength;
   { Set up signals handlers }
   InstallSignals;
+{$if defined(cpui386) or defined(cpuarm)}
+  fpc_cpucodeinit;
+{$endif cpui386}
   { Setup heap }
   InitHeap;
   SysInitExceptions;

rtl/freebsd/i386/sighnd.inc

@@ -34,10 +34,19 @@ begin
                 End;
              sysResetFPU;
           End;
-    SIGILL,
-    SIGBUS,
-    SIGSEGV :
+    SIGILL:
+      if sse_check then
+        begin
+          os_supports_sse:=false;
+          res:=0;
+          inc(sigcontext^.sc_eip,3);
+        end
+      else
         res:=216;
+    SIGBUS:
+      res:=214;
+    SIGSEGV :
+      res:=216;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);

rtl/objpas/sysutils/fina.inc

@@ -21,10 +21,13 @@
 }
 
 function ChangeFileExt(const FileName, Extension: string): string;
-var i: longint;
+var
+  i : longint;
+  EndSep : Set of Char;
 begin
-  I := Length(FileName);
-  while (I > 0) and not(FileName[I] in ['/', '.', '\', ':']) do
+  i := Length(FileName);
+  EndSep:=DirSeparators+[':','.'];
+  while (I > 0) and not(FileName[I] in EndSep) do
     Dec(I);
   if (I = 0) or (FileName[I] <> '.') then
     I := Length(FileName)+1;
@@ -32,24 +35,33 @@ begin
 end;
 
 function ExtractFilePath(const FileName: string): string;
-var i: longint;
+var
+  i : longint;
+  EndSep : Set of Char;
 begin
-i := Length(FileName);
-while (i > 0) and not (FileName[i] in ['/', '\', ':']) do Dec(i);
-If I>0 then
-  Result := Copy(FileName, 1, i)
-else
-  Result:='';
+  i := Length(FileName);
+  EndSep:=DirSeparators+[':'];
+  while (i > 0) and not (FileName[i] in EndSep) do
+    Dec(i);
+  If I>0 then
+    Result := Copy(FileName, 1, i)
+  else
+    Result:='';
 end;
 
 function ExtractFileDir(const FileName: string): string;
-var i: longint;
+var
+  i : longint;
+  EndSep : Set of Char;
 begin
-I := Length(FileName);
-while (I > 0) and not (FileName[I] in ['/', '\', ':']) do Dec(I);
-if (I > 1) and (FileName[I] in ['\', '/']) and
-   not (FileName[I - 1] in ['/', '\', ':']) then Dec(I);
-Result := Copy(FileName, 1, I);
+  I := Length(FileName);
+  EndSep:=DirSeparators+[':'];
+  while (I > 0) and not (FileName[I] in EndSep) do
+    Dec(I);
+  if (I > 1) and (FileName[I] in DirSeparators) and
+     not (FileName[I - 1] in EndSep) then
+    Dec(I);
+  Result := Copy(FileName, 1, I);
 end;
 
 function ExtractFileDrive(const FileName: string): string;
@@ -60,37 +72,45 @@ var
 begin
   Result := '';
   l:=Length(FileName);
-  if (L>=2) then
+  if (L<2) then
+    exit;
+  If (FileName[2]=':') then
+    result:=Copy(FileName,1,2)
+  else if (FileName[1] in DirSeparators) and
+          (FileName[2] in DirSeparators) then
     begin
-    If (FileName[2]=':') then
-      result:=Copy(FileName,1,2)
-    else if (FileName[1] in ['/','\']) and
-            (FileName[2] in ['/','\']) then
-      begin
       i := 2;
-      While (i<L) and Not (Filename[i+1] in ['/', '\']) do
+      While (i<L) and Not (Filename[i+1] in DirSeparators) do
         inc(i);
       Result:=Copy(FileName,1,i);
-      end;
     end;
 end;
 
 function ExtractFileName(const FileName: string): string;
-var i: longint;
+var
+  i : longint;
+  EndSep : Set of Char;
 begin
-I := Length(FileName);
-while (I > 0) and not (FileName[I] in ['/', '\', ':']) do Dec(I);
-Result := Copy(FileName, I + 1, MaxInt);
+  I := Length(FileName);
+  EndSep:=DirSeparators+[':'];
+  while (I > 0) and not (FileName[I] in EndSep) do
+    Dec(I);
+  Result := Copy(FileName, I + 1, MaxInt);
 end;
 
 function ExtractFileExt(const FileName: string): string;
-var i: longint;
+var
+  i : longint;
+  EndSep : Set of Char;
 begin
-I := Length(FileName);
-while (I > 0) and not (FileName[I] in ['.', '/', '\', ':']) do Dec(I);
-if (I > 0) and (FileName[I] = '.') then
-   Result := Copy(FileName, I, MaxInt)
-else Result := '';
+  I := Length(FileName);
+  EndSep:=DirSeparators+['.', ':'];
+  while (I > 0) and not (FileName[I] in EndSep) do
+    Dec(I);
+  if (I > 0) and (FileName[I] = '.') then
+    Result := Copy(FileName, I, MaxInt)
+  else
+    Result := '';
 end;
 
 
@@ -192,7 +212,9 @@ begin
   Result:=-1;
   While I<=Length(DirName) do
     begin
-    If DirName[i]=PathDelim then
+    If (DirName[i]=PathDelim) and
+       { avoid error in case last char=pathdelim }
+       (length(dirname)>i) then
       begin
       DirName[i]:=#0;
       Inc(Result);
@@ -211,7 +233,7 @@ Var
 begin
   Result:=Path;
   l:=Length(Result);
-  If (L=0) or (Result[l]<>PathDelim) then
+  If (L=0) or not(Result[l] in DirSeparators) then
     Result:=Result+PathDelim;
 end;
 
@@ -234,7 +256,7 @@ Var
 
 begin
   L:=Length(Path);
-  If (L>0) and (Path[L]=PathDelim) then
+  If (L>0) and (Path[L] in DirSeparators) then
     Dec(L);
   Result:=Copy(Path,1,L);
 end;
@@ -242,7 +264,7 @@ end;
 function IsPathDelimiter(Const Path: string; Index: Integer): Boolean;
 
 begin
-  Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index]=PathDelim);
+  Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index] in DirSeparators);
 end;
 
 Function GetFileHandle(var f : File):Longint;

rtl/solaris/unxsockh.inc

@@ -13,6 +13,8 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 
+{$linklib libsocket.so}
+{$linklib libnsl.so}
 
 const
   {

tests/webtbs/tw10320.pp

@@ -0,0 +1,51 @@
+program foo;
+
+{$mode DELPHI}
+
+type
+  TRgb = record
+    R,G,B : Byte;
+  end;
+  
+  TRgbArray = array of TRgb;
+  
+  TSomeClass = class
+    a: TRgbArray;
+    function GetP(Index : integer) : Pointer;
+    constructor create;
+  public
+    property P[Index: LongInt]: Pointer read GetP;
+  end;
+  
+var a : TRgbArray;
+    c : TSomeClass;
+
+constructor tsomeclass.create;
+begin
+  setlength(a,2);
+  a[0].r:=1;
+  a[0].g:=2;
+  a[0].b:=3;
+  a[1].r:=4;
+  a[1].g:=5;
+  a[1].b:=6;
+end;
+
+function TSomeClass.GetP(Index : integer) : Pointer;
+begin
+  result := pointer(a);
+end;
+    
+begin
+  c := TSomeClass.Create;
+  a := TRgbArray(c.P[1]); // Fatal: Internal error 2006111510
+  if (length(a)<>2) or
+     (a[0].r<>1) or
+     (a[0].g<>2) or
+     (a[0].b<>3) or
+     (a[1].r<>4) or
+     (a[1].g<>5) or
+     (a[1].b<>6) then
+    halt(1);
+  c.free;
+end.

tests/webtbs/tw10350.pp

@@ -0,0 +1,15 @@
+{ %norun }
+
+program TestLocal;
+var i: longint;
+begin
+{$R+}
+{$ifopt R+}
+{$define local_RangeCheck}
+{$R-}
+{$endif}
+  i:= longword( -1);
+{$ifdef local_RangeCheck}
+{$R+}
+{$endif}
+end.