Merged revisions 6382-6385,6387-6390 via svnmerge from

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

........
r6382 | tom_at_work | 2007-02-08 23:11:27 +0100 (Thu, 08 Feb 2007) | 1 line

* fix incorrect generation of huge static arrays on 64 bit systems; however, GAS only supports 2^31-1 sized ones
........
r6383 | tom_at_work | 2007-02-08 23:52:11 +0100 (Thu, 08 Feb 2007) | 1 line

* merged some code which was ifdefed separately for POWERPC and POWERPC64 code but is equal
........
r6384 | peter | 2007-02-09 13:28:22 +0100 (Fri, 09 Feb 2007) | 2 lines

  * fix concat_multi for widestrings, patch was already done for ansistrings fixes 8292

........
r6385 | peter | 2007-02-09 13:34:13 +0100 (Fri, 09 Feb 2007) | 2 lines

  * cleanup r6369

........
r6387 | florian | 2007-02-09 20:12:59 +0100 (Fri, 09 Feb 2007) | 2 lines

* several flaws in headers fixed, resolves #8285

........
r6388 | marco | 2007-02-09 21:07:20 +0100 (Fri, 09 Feb 2007) | 1 line

 * bug #8279
........
r6389 | marco | 2007-02-09 21:11:47 +0100 (Fri, 09 Feb 2007) | 1 line

 * uncommented refefs for bug #8267, var versions of findfirstfile/nextfile
........
r6390 | marco | 2007-02-09 21:24:56 +0100 (Fri, 09 Feb 2007) | 1 line

 * openfilename updated to NT5 struct, keeping the old struct with _NT4 suffix
........

git-svn-id: branches/fpc_2_3@6392 -

compiler/aasmtai.pas

@@ -369,9 +369,9 @@ interface
        tai_datablock = class(tailineinfo)
           is_global : boolean;
           sym       : tasmsymbol;
-          size      : longint;
-          constructor Create(const _name : string;_size : longint);
-          constructor Create_global(const _name : string;_size : longint);
+          size      : aint;
+          constructor Create(const _name : string;_size : aint);
+          constructor Create_global(const _name : string;_size : aint);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure derefimpl;override;
@@ -854,7 +854,7 @@ implementation
                              TAI_DATABLOCK
  ****************************************************************************}
 
-    constructor tai_datablock.Create(const _name : string;_size : longint);
+    constructor tai_datablock.Create(const _name : string;_size : aint);
 
       begin
          inherited Create;
@@ -862,20 +862,20 @@ implementation
          sym:=current_asmdata.DefineAsmSymbol(_name,AB_LOCAL,AT_DATA);
          { keep things aligned }
          if _size<=0 then
-           _size:=4;
+           _size:=sizeof(aint);
          size:=_size;
          is_global:=false;
       end;
 
 
-    constructor tai_datablock.Create_global(const _name : string;_size : longint);
+    constructor tai_datablock.Create_global(const _name : string;_size : aint);
       begin
          inherited Create;
          typ:=ait_datablock;
          sym:=current_asmdata.DefineAsmSymbol(_name,AB_GLOBAL,AT_DATA);
          { keep things aligned }
          if _size<=0 then
-           _size:=4;
+           _size:=sizeof(aint);
          size:=_size;
          is_global:=true;
       end;
@@ -885,7 +885,7 @@ implementation
       begin
         inherited Create;
         sym:=ppufile.getasmsymbol;
-        size:=ppufile.getlongint;
+        size:=ppufile.getaint;
         is_global:=boolean(ppufile.getbyte);
       end;
 
@@ -894,7 +894,7 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putasmsymbol(sym);
-        ppufile.putlongint(size);
+        ppufile.putaint(size);
         ppufile.putbyte(byte(is_global));
       end;
 

compiler/pmodules.pas

@@ -715,7 +715,6 @@ implementation
       var
         ps  : tprocsym;
         pd  : tprocdef;
-        store_pocall : tproccalloption;
       begin
         { there should be no current_procinfo available }
         if assigned(current_procinfo) then
@@ -732,15 +731,11 @@ implementation
         { set procdef options }
         pd.proctypeoption:=potype;
         pd.proccalloption:=pocall_default;
+        include(pd.procoptions,po_hascallingconvention);
         pd.forwarddef:=false;
         pd.setmangledname(target_info.cprefix+name);
         pd.aliasnames.insert(pd.mangledname);
-        { We should leave it as pocall_default
-          see webbug 8270 PM }
-        store_pocall:=current_settings.defproccall;
-        current_settings.defproccall:=pocall_default;
         handle_calling_convention(pd);
-        current_settings.defproccall:=store_pocall;
         { We don't need is a local symtable. Change it into the static
           symtable }
         pd.localst.free;

compiler/psub.pas

@@ -1021,12 +1021,9 @@ implementation
             current_filepos:=exitpos;
             gen_proc_symbol_end(templist);
             aktproccode.concatlist(templist);
-{$ifdef POWERPC}
+{$if defined(POWERPC) or defined(POWERPC64)}
             fixup_jmps(aktproccode);
-{$endif POWERPC}
-{$ifdef POWERPC64}
-            fixup_jmps(aktproccode);
-{$endif POWERPC64}
+{$endif}
             { insert line debuginfo }
             if (cs_debuginfo in current_settings.moduleswitches) or
                (cs_use_lineinfo in current_settings.globalswitches) then

compiler/raatt.pas

@@ -245,7 +245,7 @@ unit raatt;
               firsttoken:=true;
               exit;
             end;
-{$ifdef POWERPC}
+{$if defined(POWERPC) or defined(POWERPC64)}
            { some PowerPC instructions can have the postfix -, + or .
              this code could be moved to is_asmopcode but I think
              it's better to ifdef it here (FK)
@@ -258,19 +258,6 @@ unit raatt;
                end
            end;
 {$endif POWERPC}
-{$ifdef POWERPC64}
-           { some PowerPC instructions can have the postfix -, + or .
-             this code could be moved to is_asmopcode but I think
-             it's better to ifdef it here (FK)
-           }
-           case c of
-             '.', '-', '+':
-               begin
-                 actasmpattern:=actasmpattern+c;
-                 c:=current_scanner.asmgetchar;
-               end
-           end;
-{$endif POWERPC64}
            { Opcode ? }
            If is_asmopcode(upper(actasmpattern)) then
             Begin

compiler/symsym.pas

@@ -129,7 +129,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
-          function  getsize : longint;
+          function  getsize : aint;
           function  getpackedbitsize : longint;
           function  is_regvar(refpara: boolean):boolean;
           procedure trigger_notifications(what:Tnotification_flag);
@@ -231,7 +231,7 @@ interface
           constructor create(const n : string);
           destructor  destroy;override;
           constructor ppuload(ppufile:tcompilerppufile);
-          function  getsize : longint;
+          function  getsize : aint;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
@@ -880,7 +880,7 @@ implementation
       end;
 
 
-    function tpropertysym.getsize : longint;
+    function tpropertysym.getsize : aint;
       begin
          getsize:=0;
       end;
@@ -971,7 +971,7 @@ implementation
       end;
 
 
-    function tabstractvarsym.getsize : longint;
+    function tabstractvarsym.getsize : aint;
       begin
         if assigned(vardef) and
            ((vardef.typ<>arraydef) or

compiler/tgobj.pas

@@ -160,15 +160,11 @@ implementation
        tempfreelist:=nil;
        templist:=nil;
        { we could create a new child class for this but I don't if it is worth the effort (FK) }
-{$ifdef powerpc}
+{$if defined(powerpc) or defined(powerpc64)}
        direction:=1;
-{$else powerpc}
-{$ifdef POWERPC64}
-       direction:=1;
-{$else POWERPC64}
+{$else}
        direction:=-1;
-{$endif POWERPC64}
-{$endif powerpc}
+{$endif}
      end;
 
 

packages/extra/zlib/zlib.pp

@@ -11,6 +11,9 @@ interface
 {$endif}
 {$PACKRECORDS 4}
 
+uses
+  ctypes;
+
 const
   ZLIB_VERSION = '1.1.3';
 
@@ -110,9 +113,9 @@ function deflateParams(var strm:TZStream; level:longint; strategy:longint):longi
 function inflateSetDictionary(var strm:TZStream;dictionary : pbytef; dictLength:uInt):longint;cdecl;external libz name 'inflateSetDictionary';
 function inflateSync(var strm:TZStream):longint;cdecl;external libz name 'inflateSync';
 function inflateReset(var strm:TZStream):longint;cdecl;external libz name 'inflateReset';
-function compress(dest:pbytef;destLen:uLongf; source : pbytef; sourceLen:uLong):longint;cdecl;external libz name 'compress';
-function compress2(dest:pbytef;destLen:uLongf; source : pbytef; sourceLen:uLong; level:longint):longint;cdecl;external libz name 'compress2';
-function uncompress(dest:pbytef;destLen:uLongf; source : pbytef; sourceLen:uLong):longint;cdecl;external libz name 'uncompress';
+function compress(dest:pbytef;destLen:puLongf; source : pbytef; sourceLen:uLong):cint;cdecl;external libz name 'compress';
+function compress2(dest:pbytef;destLen:puLongf; source : pbytef; sourceLen:uLong; level:cint):cint;cdecl;external libz name 'compress2';
+function uncompress(dest:pbytef;destLen:puLongf; source : pbytef; sourceLen:uLong):cint;cdecl;external libz name 'uncompress';
 function gzopen(path:pchar; mode:pchar):gzFile;cdecl;external libz name 'gzopen';
 function gzdopen(fd:longint; mode:pchar):gzFile;cdecl;external libz name 'gzdopen';
 function gzsetparams(thefile:gzFile; level:longint; strategy:longint):longint;cdecl;external libz name 'gzsetparams';

rtl/inc/wstrings.inc

@@ -501,6 +501,7 @@ Var
   p,pc        : pointer;
   Size,NewLen,
   OldDestLen  : SizeInt;
+  destcopy    : widestring;
 begin
   if high(sarr)=0 then
     begin
@@ -509,17 +510,19 @@ begin
     end;
   lowstart:=low(sarr);
   if Pointer(DestS)=Pointer(sarr[lowstart]) then
+    inc(lowstart);
+  { Check for another reuse, then we can't use
+    the append optimization }
+  for i:=lowstart to high(sarr) do
     begin
-      inc(lowstart);
-      { Check for another reuse, then we can't use
-        the append optimization }
-      for i:=lowstart to high(sarr) do
+      if Pointer(DestS)=Pointer(sarr[i]) then
         begin
-          if Pointer(DestS)=Pointer(sarr[i]) then
-            begin
-              lowstart:=low(sarr);
-              break;
-            end;
+          { if DestS is used somewhere in the middle of the expression,
+            we need to make sure the original string still exists after
+            we empty/modify DestS                                       }
+          destcopy:=dests;
+          lowstart:=low(sarr);
+          break;
         end;
     end;
   { Start with empty DestS if we start with concatting

rtl/win/wininc/defines.inc

@@ -352,11 +352,14 @@
      IMAGE_CURSOR = 2;
      IMAGE_ENHMETAFILE = 1;
      IMAGE_ICON = 1;
-     LR_COPYDELETEORG = 8;
-     LR_COPYRETURNORG = 4;
-     LR_MONOCHROME = 1;
+     LR_MONOCHROME 	 = 1;
+     LR_COLOR            = 2;
+     LR_COPYRETURNORG    = 4;
+     LR_COPYDELETEORG    = 8;
+     LR_DEFAULTSIZE      = 64;
      LR_CREATEDIBSECTION = 8192;
-     LR_DEFAULTSIZE = 64;
+     LR_COPYFROMRESOURCE = $4000;
+     LR_SHARED           = $8000;
   { CreateDesktop  }
      DF_ALLOWOTHERACCOUNTHOOK = $1;
      DESKTOP_CREATEMENU = $4;
@@ -2040,7 +2043,6 @@ Const
      LR_LOADFROMFILE = 16;
      LR_LOADMAP3DCOLORS = 4096;
      LR_LOADTRANSPARENT = 32;
-     {LR_MONOCHROME = 1;already above }
   { ImmConfigureIME  }
      IME_CONFIG_GENERAL = 1;
      IME_CONFIG_REGISTERWORD = 2;

rtl/win/wininc/redef.inc

@@ -385,11 +385,11 @@ function FillConsoleOutputCharacterW(hConsoleOutput: THandle; cCharacter: WideCh
 //function FillRect(hDC: HDC; const lprc: TRect; hbr: HBRUSH): Integer; external 'user32' name 'FillRect';
 function FindFirstFile(lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle;external 'kernel32' name 'FindFirstFileA';
 function FindFirstFileA(lpFileName: LPCSTR; var lpFindFileData: TWIN32FindDataA): THandle; external 'kernel32' name 'FindFirstFileA';
-//function FindFirstFileW(lpFileName: LPWSTR; var lpFindFileData: TWIN32FindDataW): THandle; external 'kernel32' name 'FindFirstFileW';
+function FindFirstFileW(lpFileName: LPWSTR; var lpFindFileData: TWIN32FindDataW): THandle; external 'kernel32' name 'FindFirstFileW';
 //function FindFirstFreeAce(var pAcl: TACL; var pAce: Pointer): BOOL; external 'advapi32' name 'FindFirstFreeAce';
 function FindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL;external 'kernel32' name 'FindNextFileA';
 function FindNextFileA(hFindFile: THandle; var lpFindFileData: TWIN32FindDataA): BOOL; external 'kernel32' name 'FindNextFileA';
-//function FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL; external 'kernel32' name 'FindNextFileW';
+function FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL; external 'kernel32' name 'FindNextFileW';
 //function FlushInstructionCache(hProcess: THandle; const lpBaseAddress: Pointer; dwSize: DWORD): BOOL; external 'kernel32' name 'FlushInstructionCache';
 //function FlushViewOfFile(const lpBaseAddress: Pointer; dwNumberOfBytesToFlush: DWORD): BOOL; external 'kernel32' name 'FlushViewOfFile';
 //function FrameRect(hDC: HDC; const lprc: TRect; hbr: HBRUSH): Integer; external 'user32' name 'FrameRect';

rtl/win/wininc/struct.inc

@@ -4831,6 +4831,32 @@
      TOFSTRUCT = OFSTRUCT;
      POFSTRUCT = ^OFSTRUCT;
 
+     OPENFILENAME_NT4 = record
+          lStructSize : DWORD;
+          hwndOwner : HWND;
+          hInstance : HINST;
+          lpstrFilter : LPCTSTR;
+          lpstrCustomFilter : LPTSTR;
+          nMaxCustFilter : DWORD;
+          nFilterIndex : DWORD;
+          lpstrFile : LPTSTR;
+          nMaxFile : DWORD;
+          lpstrFileTitle : LPTSTR;
+          nMaxFileTitle : DWORD;
+          lpstrInitialDir : LPCTSTR;
+          lpstrTitle : LPCTSTR;
+          Flags : DWORD;
+          nFileOffset : WORD;
+          nFileExtension : WORD;
+          lpstrDefExt : LPCTSTR;
+          lCustData : LPARAM;
+          lpfnHook : LPOFNHOOKPROC;
+          lpTemplateName : LPCTSTR;
+       end;
+     LPOPENFILENAME_NT4 = ^OPENFILENAME_NT4;
+     TOPENFILENAME_NT4 = OPENFILENAME_NT4;
+     POPENFILENAME_NT4 = ^OPENFILENAME_NT4;
+
      OPENFILENAME = record
           lStructSize : DWORD;
           hwndOwner : HWND;
@@ -4852,6 +4878,9 @@
           lCustData : LPARAM;
           lpfnHook : LPOFNHOOKPROC;
           lpTemplateName : LPCTSTR;
+          pvReserved : pointer;
+          dwreserved : dword;
+          FlagsEx    : dword; 
        end;
      LPOPENFILENAME = ^OPENFILENAME;
      TOPENFILENAME = OPENFILENAME;