* unified some win32/win64 code

git-svn-id: trunk@11745 -

.gitattributes

@@ -6173,6 +6173,7 @@ rtl/win/sysos.inc svneol=native#text/plain
 rtl/win/sysosh.inc svneol=native#text/plain
 rtl/win/systhrd.inc svneol=native#text/plain
 rtl/win/sysutils.pp svneol=native#text/plain
+rtl/win/syswin.inc svneol=native#text/plain
 rtl/win/tthread.inc svneol=native#text/plain
 rtl/win/varutils.pp svneol=native#text/plain
 rtl/win/video.pp svneol=native#text/plain

rtl/win/syswin.inc

@@ -0,0 +1,188 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2008 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    FPC Pascal system unit part shared by win32/win64.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+                    Error Message writing using messageboxes
+****************************************************************************}
+
+function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
+   stdcall;external 'user32' name 'MessageBoxA';
+
+const
+  ErrorBufferLength = 1024;
+var
+  ErrorBuf : array[0..ErrorBufferLength] of char;
+  ErrorLen : SizeInt;
+
+Function ErrorWrite(Var F: TextRec): Integer;
+{
+  An error message should always end with #13#10#13#10
+}
+var
+  i : SizeInt;
+Begin
+  while F.BufPos>0 do
+    begin
+      begin
+        if F.BufPos+ErrorLen>ErrorBufferLength then
+          i:=ErrorBufferLength-ErrorLen
+        else
+          i:=F.BufPos;
+        Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
+        inc(ErrorLen,i);
+        ErrorBuf[ErrorLen]:=#0;
+      end;
+      if ErrorLen=ErrorBufferLength then
+        begin
+          MessageBox(0,@ErrorBuf,pchar('Error'),0);
+          ErrorLen:=0;
+        end;
+      Dec(F.BufPos,i);
+    end;
+  ErrorWrite:=0;
+End;
+
+
+Function ErrorClose(Var F: TextRec): Integer;
+begin
+  if ErrorLen>0 then
+   begin
+     MessageBox(0,@ErrorBuf,pchar('Error'),0);
+     ErrorLen:=0;
+   end;
+  ErrorLen:=0;
+  ErrorClose:=0;
+end;
+
+
+Function ErrorOpen(Var F: TextRec): Integer;
+Begin
+  TextRec(F).InOutFunc:=@ErrorWrite;
+  TextRec(F).FlushFunc:=@ErrorWrite;
+  TextRec(F).CloseFunc:=@ErrorClose;
+  ErrorLen:=0;
+  ErrorOpen:=0;
+End;
+
+
+procedure AssignError(Var T: Text);
+begin
+  Assign(T,'');
+  TextRec(T).OpenFunc:=@ErrorOpen;
+  Rewrite(T);
+end;
+
+
+procedure SysInitStdIO;
+begin
+  { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+    displayed in a messagebox }
+  StdInputHandle:=longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
+  StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
+  StdErrorHandle:=longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
+  if not IsConsole then
+   begin
+     AssignError(stderr);
+     AssignError(StdOut);
+     Assign(Output,'');
+     Assign(Input,'');
+     Assign(ErrOutput,'');
+   end
+  else
+   begin
+     OpenStdIO(Input,fmInput,StdInputHandle);
+     OpenStdIO(Output,fmOutput,StdOutputHandle);
+     OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+     OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+     OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+   end;
+end;
+
+{ ProcessID cached to avoid repeated calls to GetCurrentProcess. }
+
+var
+  ProcessID: SizeUInt;
+
+function GetProcessID: SizeUInt;
+  begin
+    GetProcessID := ProcessID;
+  end;
+  
+
+{******************************************************************************
+                              Unicode
+ ******************************************************************************}
+
+procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
+  var
+    destlen: SizeInt;
+  begin
+    // retrieve length including trailing #0
+    // not anymore, because this must also be usable for single characters
+    destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
+    // this will null-terminate
+    setlength(dest, destlen);
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
+  end;
+
+procedure Win32Ansi2UnicodeMove(source:pchar;var dest:UnicodeString;len:SizeInt);
+  var
+    destlen: SizeInt;
+  begin
+    // retrieve length including trailing #0
+    // not anymore, because this must also be usable for single characters
+    destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
+    // this will null-terminate
+    setlength(dest, destlen);
+    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], destlen);
+  end;
+
+
+function Win32UnicodeUpper(const s : UnicodeString) : UnicodeString;
+  begin
+    result:=s;
+    UniqueString(result);
+    if length(result)>0 then
+      CharUpperBuff(LPWSTR(result),length(result));
+  end;
+
+
+function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
+  begin
+    result:=s;
+    UniqueString(result);
+    if length(result)>0 then
+      CharLowerBuff(LPWSTR(result),length(result));
+  end;
+
+  
+{ there is a similiar procedure in sysutils which inits the fields which
+  are only relevant for the sysutils units }
+procedure InitWin32Widestrings;
+  begin
+    { Widestring }
+    widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
+    widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
+    widestringmanager.UpperWideStringProc:=@Win32WideUpper;
+    widestringmanager.LowerWideStringProc:=@Win32WideLower;
+{$ifndef VER2_2}
+    { Unicode }
+    widestringmanager.Unicode2AnsiMoveProc:=@Win32Unicode2AnsiMove;
+    widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove;
+    widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
+    widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
+{$endif VER2_2}
+  end;

rtl/win32/system.pp

@@ -958,253 +958,81 @@ function Win32WideLower(const s : WideString) : WideString;
       CharLowerBuff(LPWSTR(result),length(result));
   end;
 
-{******************************************************************************
-                              Unicode
- ******************************************************************************}
-
-procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
-  var
-    destlen: SizeInt;
-  begin
-    // retrieve length including trailing #0
-    // not anymore, because this must also be usable for single characters
-    destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
-    // this will null-terminate
-    setlength(dest, destlen);
-    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
-  end;
-
-procedure Win32Ansi2UnicodeMove(source:pchar;var dest:UnicodeString;len:SizeInt);
-  var
-    destlen: SizeInt;
-  begin
-    // retrieve length including trailing #0
-    // not anymore, because this must also be usable for single characters
-    destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
-    // this will null-terminate
-    setlength(dest, destlen);
-    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], destlen);
-  end;
-
-
-function Win32UnicodeUpper(const s : UnicodeString) : UnicodeString;
-  begin
-    result:=s;
-    UniqueString(result);
-    if length(result)>0 then
-      CharUpperBuff(LPWSTR(result),length(result));
-  end;
-
-
-function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
-  begin
-    result:=s;
-    UniqueString(result);
-    if length(result)>0 then
-      CharLowerBuff(LPWSTR(result),length(result));
-  end;
-
-
-{ there is a similiar procedure in sysutils which inits the fields which
-  are only relevant for the sysutils units }
-procedure InitWin32Widestrings;
-  begin
-    { Widestring }
-    widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
-    widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
-    widestringmanager.UpperWideStringProc:=@Win32WideUpper;
-    widestringmanager.LowerWideStringProc:=@Win32WideLower;
-{$ifndef VER2_2}
-    { Unicode }
-    widestringmanager.Unicode2AnsiMoveProc:=@Win32Unicode2AnsiMove;
-    widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove;
-    widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper;
-    widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
-{$endif VER2_2}
-  end;
-
-
-
-{****************************************************************************
-                    Error Message writing using messageboxes
-****************************************************************************}
+{******************************************************************************}
+{ include code common with win64 }
 
-function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
-   stdcall;external 'user32' name 'MessageBoxA';
+{$I syswin.inc}
+{******************************************************************************}
 
-const
-  ErrorBufferLength = 1024;
-var
-  ErrorBuf : array[0..ErrorBufferLength] of char;
-  ErrorLen : longint;
-
-Function ErrorWrite(Var F: TextRec): Integer;
-{
-  An error message should always end with #13#10#13#10
-}
-var
-  i : longint;
-Begin
-  while F.BufPos>0 do
-    begin
-      begin
-        if F.BufPos+ErrorLen>ErrorBufferLength then
-          i:=ErrorBufferLength-ErrorLen
-        else
-          i:=F.BufPos;
-        Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
-        inc(ErrorLen,i);
-        ErrorBuf[ErrorLen]:=#0;
-      end;
-      if ErrorLen=ErrorBufferLength then
-        begin
-          MessageBox(0,@ErrorBuf,pchar('Error'),0);
-          ErrorLen:=0;
-        end;
-      Dec(F.BufPos,i);
-    end;
-  ErrorWrite:=0;
-End;
-
-
-Function ErrorClose(Var F: TextRec): Integer;
-begin
-  if ErrorLen>0 then
-   begin
-     MessageBox(0,@ErrorBuf,pchar('Error'),0);
-     ErrorLen:=0;
-   end;
-  ErrorLen:=0;
-  ErrorClose:=0;
-end;
-
-
-Function ErrorOpen(Var F: TextRec): Integer;
-Begin
-  TextRec(F).InOutFunc:=@ErrorWrite;
-  TextRec(F).FlushFunc:=@ErrorWrite;
-  TextRec(F).CloseFunc:=@ErrorClose;
-  ErrorLen:=0;
-  ErrorOpen:=0;
-End;
-
-
-procedure AssignError(Var T: Text);
-begin
-  Assign(T,'');
-  TextRec(T).OpenFunc:=@ErrorOpen;
-  Rewrite(T);
-end;
-
-
-procedure SysInitStdIO;
-begin
-  { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
-    displayed in a messagebox }
-  StdInputHandle:=longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
-  StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
-  StdErrorHandle:=longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
-  if not IsConsole then
-   begin
-     AssignError(stderr);
-     AssignError(StdOut);
-     Assign(Output,'');
-     Assign(Input,'');
-     Assign(ErrOutput,'');
-   end
-  else
-   begin
-     OpenStdIO(Input,fmInput,StdInputHandle);
-     OpenStdIO(Output,fmOutput,StdOutputHandle);
-     OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
-     OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-     OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-   end;
-end;
-
-{ ProcessID cached to avoid repeated calls to GetCurrentProcess. }
-
-var
-  ProcessID: SizeUInt;
-
-function GetProcessID: SizeUInt;
-begin
- GetProcessID := ProcessID;
-end;
 
 function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
-type
-  tdosheader = packed record
-     e_magic : word;
-     e_cblp : word;
-     e_cp : word;
-     e_crlc : word;
-     e_cparhdr : word;
-     e_minalloc : word;
-     e_maxalloc : word;
-     e_ss : word;
-     e_sp : word;
-     e_csum : word;
-     e_ip : word;
-     e_cs : word;
-     e_lfarlc : word;
-     e_ovno : word;
-     e_res : array[0..3] of word;
-     e_oemid : word;
-     e_oeminfo : word;
-     e_res2 : array[0..9] of word;
-     e_lfanew : longint;
-  end;
-  tpeheader = packed record
-     PEMagic : longint;
-     Machine : word;
-     NumberOfSections : word;
-     TimeDateStamp : longint;
-     PointerToSymbolTable : longint;
-     NumberOfSymbols : longint;
-     SizeOfOptionalHeader : word;
-     Characteristics : word;
-     Magic : word;
-     MajorLinkerVersion : byte;
-     MinorLinkerVersion : byte;
-     SizeOfCode : longint;
-     SizeOfInitializedData : longint;
-     SizeOfUninitializedData : longint;
-     AddressOfEntryPoint : longint;
-     BaseOfCode : longint;
-     BaseOfData : longint;
-     ImageBase : longint;
-     SectionAlignment : longint;
-     FileAlignment : longint;
-     MajorOperatingSystemVersion : word;
-     MinorOperatingSystemVersion : word;
-     MajorImageVersion : word;
-     MinorImageVersion : word;
-     MajorSubsystemVersion : word;
-     MinorSubsystemVersion : word;
-     Reserved1 : longint;
-     SizeOfImage : longint;
-     SizeOfHeaders : longint;
-     CheckSum : longint;
-     Subsystem : word;
-     DllCharacteristics : word;
-     SizeOfStackReserve : longint;
-     SizeOfStackCommit : longint;
-     SizeOfHeapReserve : longint;
-     SizeOfHeapCommit : longint;
-     LoaderFlags : longint;
-     NumberOfRvaAndSizes : longint;
-     DataDirectory : array[1..$80] of byte;
-  end;
-begin
-  result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
-end;
+	type
+	  tdosheader = packed record
+	     e_magic : word;
+	     e_cblp : word;
+	     e_cp : word;
+	     e_crlc : word;
+	     e_cparhdr : word;
+	     e_minalloc : word;
+	     e_maxalloc : word;
+	     e_ss : word;
+	     e_sp : word;
+	     e_csum : word;
+	     e_ip : word;
+	     e_cs : word;
+	     e_lfarlc : word;
+	     e_ovno : word;
+	     e_res : array[0..3] of word;
+	     e_oemid : word;
+	     e_oeminfo : word;
+	     e_res2 : array[0..9] of word;
+	     e_lfanew : longint;
+	  end;
+	  tpeheader = packed record
+	     PEMagic : longint;
+	     Machine : word;
+	     NumberOfSections : word;
+	     TimeDateStamp : longint;
+	     PointerToSymbolTable : longint;
+	     NumberOfSymbols : longint;
+	     SizeOfOptionalHeader : word;
+	     Characteristics : word;
+	     Magic : word;
+	     MajorLinkerVersion : byte;
+	     MinorLinkerVersion : byte;
+	     SizeOfCode : longint;
+	     SizeOfInitializedData : longint;
+	     SizeOfUninitializedData : longint;
+	     AddressOfEntryPoint : longint;
+	     BaseOfCode : longint;
+	     BaseOfData : longint;
+	     ImageBase : longint;
+	     SectionAlignment : longint;
+	     FileAlignment : longint;
+	     MajorOperatingSystemVersion : word;
+	     MinorOperatingSystemVersion : word;
+	     MajorImageVersion : word;
+	     MinorImageVersion : word;
+	     MajorSubsystemVersion : word;
+	     MinorSubsystemVersion : word;
+	     Reserved1 : longint;
+	     SizeOfImage : longint;
+	     SizeOfHeaders : longint;
+	     CheckSum : longint;
+	     Subsystem : word;
+	     DllCharacteristics : word;
+	     SizeOfStackReserve : longint;
+	     SizeOfStackCommit : longint;
+	     SizeOfHeapReserve : longint;
+	     SizeOfHeapCommit : longint;
+	     LoaderFlags : longint;
+	     NumberOfRvaAndSizes : longint;
+	     DataDirectory : array[1..$80] of byte;
+	  end;
+	begin
+	  result:=tpeheader((pointer(SysInstance)+(tdosheader(pointer(SysInstance)^).e_lfanew))^).SizeOfStackReserve;
+	end;
 
-{
-const
-   Exe_entry_code : pointer = @Exe_entry;
-   Dll_entry_code : pointer = @Dll_entry;
-}
 
 begin
   { get some helpful informations }

rtl/win64/system.pp

@@ -996,127 +996,11 @@ function Win32WideLower(const s : WideString) : WideString;
       CharLowerBuff(LPWSTR(result),length(result));
   end;
 
+{******************************************************************************}
+{ include code common with win64 }
 
-{ there is a similiar procedure in sysutils which inits the fields which
-  are only relevant for the sysutils units }
-procedure InitWin32Widestrings;
-  begin
-    widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
-    widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;
-    widestringmanager.UpperWideStringProc:=@Win32WideUpper;
-    widestringmanager.LowerWideStringProc:=@Win32WideLower;
-  end;
-
-
-
-{****************************************************************************
-                    Error Message writing using messageboxes
-****************************************************************************}
-
-function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
-   stdcall;external 'user32' name 'MessageBoxA';
-
-const
-  ErrorBufferLength = 1024;
-var
-  ErrorBuf : array[0..ErrorBufferLength] of char;
-  ErrorLen : longint;
-
-Function ErrorWrite(Var F: TextRec): Integer;
-{
-  An error message should always end with #13#10#13#10
-}
-var
-  p : pchar;
-  i : longint;
-Begin
-  while F.BufPos>0 do
-    begin
-      begin
-        if F.BufPos+ErrorLen>ErrorBufferLength then
-          i:=ErrorBufferLength-ErrorLen
-        else
-          i:=F.BufPos;
-        Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
-        inc(ErrorLen,i);
-        ErrorBuf[ErrorLen]:=#0;
-      end;
-      if ErrorLen=ErrorBufferLength then
-        begin
-          MessageBox(0,@ErrorBuf,pchar('Error'),0);
-          ErrorLen:=0;
-        end;
-      Dec(F.BufPos,i);
-    end;
-  ErrorWrite:=0;
-End;
-
-
-Function ErrorClose(Var F: TextRec): Integer;
-begin
-  if ErrorLen>0 then
-   begin
-     MessageBox(0,@ErrorBuf,pchar('Error'),0);
-     ErrorLen:=0;
-   end;
-  ErrorLen:=0;
-  ErrorClose:=0;
-end;
-
-
-Function ErrorOpen(Var F: TextRec): Integer;
-Begin
-  TextRec(F).InOutFunc:=@ErrorWrite;
-  TextRec(F).FlushFunc:=@ErrorWrite;
-  TextRec(F).CloseFunc:=@ErrorClose;
-  ErrorLen:=0;
-  ErrorOpen:=0;
-End;
-
-
-procedure AssignError(Var T: Text);
-begin
-  Assign(T,'');
-  TextRec(T).OpenFunc:=@ErrorOpen;
-  Rewrite(T);
-end;
-
-
-procedure SysInitStdIO;
-begin
-  { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
-    displayed in a messagebox }
-  StdInputHandle:=THandle(GetStdHandle(STD_INPUT_HANDLE));
-  StdOutputHandle:=THandle(GetStdHandle(STD_OUTPUT_HANDLE));
-  StdErrorHandle:=THandle(GetStdHandle(STD_ERROR_HANDLE));
-  if not IsConsole then
-   begin
-     AssignError(stderr);
-     AssignError(StdOut);
-     Assign(Output,'');
-     Assign(Input,'');
-     Assign(ErrOutput,'');
-   end
-  else
-   begin
-     OpenStdIO(Input,fmInput,StdInputHandle);
-     OpenStdIO(Output,fmOutput,StdOutputHandle);
-     OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
-     OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-     OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-   end;
-end;
-
-(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *)
-
-var
-  ProcessID: SizeUInt;
-
-function GetProcessID: SizeUInt;
-begin
- GetProcessID := ProcessID;
-end;
-
+{$I syswin.inc}
+{******************************************************************************}
 
 function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;assembler;
 asm