--- Merging r15642 into '.':

U    utils/h2pas/h2pas.pas
U    utils/h2pas/testit.h
U    utils/h2pas/h2pas.y
--- Merging r15643 into '.':
G    utils/h2pas/h2pas.pas
G    utils/h2pas/h2pas.y
--- Merging r15644 into '.':
U    packages/sqlite/src/sqlite3.inc
--- Merging r15663 into '.':
U    rtl/objpas/classes/action.inc
U    rtl/objpas/classes/collect.inc
U    rtl/objpas/classes/compon.inc
U    rtl/objpas/classes/classes.inc
U    rtl/objpas/classes/reader.inc
U    rtl/objpas/classes/classesh.inc
--- Merging r15664 into '.':
U    packages/fcl-base/src/inifiles.pp
--- Merging r15666 into '.':
U    packages/libxml/Makefile.fpc
C    packages/libxml/Makefile
--- Merging r15747 into '.':
U    rtl/linux/linux.pp
--- Merging r15775 into '.':
U    rtl/win/sysutils.pp
--- Merging r15776 into '.':
G    rtl/win/sysutils.pp
U    rtl/objpas/sysutils/dati.inc
--- Merging r15782 into '.':
G    rtl/objpas/sysutils/dati.inc
--- Merging r15787 into '.':
U    rtl/win/syswin.inc
--- Merging r15811 into '.':
G    rtl/linux/linux.pp
--- Merging r15837 into '.':
G    utils/h2pas/h2pas.pas
G    utils/h2pas/h2pas.y
--- Merging r15854 into '.':
U    packages/fcl-json/tests/testjsondata.pp
U    packages/fcl-json/tests/testjson.lpi
U    packages/fcl-json/src/fpjson.pp
--- Merging r15855 into '.':
U    packages/fcl-image/src/fpreadjpeg.pas
--- Merging r15856 into '.':
U    packages/fcl-db/src/sdf/sdfdata.pp
--- Merging r15857 into '.':
U    packages/fcl-base/src/contnrs.pp
--- Merging r15860 into '.':
G    utils/h2pas/h2pas.pas
G    utils/h2pas/testit.h
G    utils/h2pas/h2pas.y
--- Merging r15862 into '.':
U    ide/fp.pas
--- Merging r15864 into '.':
U    packages/unzip/src/unzip51g.pp
--- Merging r15865 into '.':
U    packages/fcl-base/src/gettext.pp
--- Merging r15871 into '.':
U    rtl/bsd/ossysc.inc
--- Merging r15878 into '.':
U    packages/fcl-json/src/jsonscanner.pp
U    packages/fcl-json/src/jsonparser.pp
--- Merging r15879 into '.':
G    packages/fcl-json/src/fpjson.pp
--- Merging r15882 into '.':
U    packages/openssl/src/openssl.pas
--- Merging r15883 into '.':
G    packages/openssl/src/openssl.pas
--- Merging r15884 into '.':
U    packages/fpvectorial/src/fpvectorial.pas
U    packages/fpvectorial/examples/fpce_mainform.lfm
U    packages/fpvectorial/examples/fpce_mainform.pas
A    packages/fpvectorial/examples/fpvwritetest.pas
--- Merging r15885 into '.':
U    packages/fpvectorial/examples/fpvwritetest.pas
--- Merging r15886 into '.':
G    packages/openssl/src/openssl.pas
--- Merging r15889 into '.':
U    packages/gdbint/src/gdbint.pp
--- Merging r15890 into '.':
U    ide/fpdebug.pas
--- Merging r15891 into '.':
U    ide/fpmrun.inc
--- Merging r15894 into '.':
U    rtl/bsd/bunxsysc.inc
--- Merging r15895 into '.':
U    rtl/freebsd/termiosproc.inc
--- Merging r15907 into '.':
U    rtl/linux/x86_64/prt0.as
U    rtl/linux/x86_64/cprt0.as
U    rtl/linux/x86_64/gprt0.as
A    tests/webtbs/tw17236.pp
Summary of conflicts:
  Text conflicts: 1

# revisions: 15642,15643,15644,15663,15664,15666,15747,15775,15776,15782,15787,15811,15837,15854,15855,15856,15857,15860,15862,15864,15865,15871,15878,15879,15882,15883,15884,15885,15886,15889,15890,15891,15894,15895,15907
------------------------------------------------------------------------
r15642 | florian | 2010-07-26 22:09:58 +0200 (Mon, 26 Jul 2010) | 2 lines
Changed paths:
   M /trunk/utils/h2pas/h2pas.pas
   M /trunk/utils/h2pas/h2pas.y
   M /trunk/utils/h2pas/testit.h

* when generating procedure variables in records, no_pop should be left as it is, other code takes care of it, resolves #17006

------------------------------------------------------------------------
------------------------------------------------------------------------
r15643 | florian | 2010-07-26 22:13:53 +0200 (Mon, 26 Jul 2010) | 2 lines
Changed paths:
   M /trunk/utils/h2pas/h2pas.pas
   M /trunk/utils/h2pas/h2pas.y

* fixed very oldish case indention style

------------------------------------------------------------------------
------------------------------------------------------------------------
r15644 | florian | 2010-07-26 22:27:07 +0200 (Mon, 26 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/sqlite/src/sqlite3.inc

- remove superfluous "end." as reported by Sven Barth, resolves #17017
------------------------------------------------------------------------
------------------------------------------------------------------------
r15663 | michael | 2010-07-30 11:06:18 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/action.inc
   M /trunk/rtl/objpas/classes/classes.inc
   M /trunk/rtl/objpas/classes/classesh.inc
   M /trunk/rtl/objpas/classes/collect.inc
   M /trunk/rtl/objpas/classes/compon.inc
   M /trunk/rtl/objpas/classes/reader.inc

* Patch from Luiz americo to use FPList where possible
------------------------------------------------------------------------
------------------------------------------------------------------------
r15664 | michael | 2010-07-30 11:08:51 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/inifiles.pp

* Patch from Luiz Americo to use Const string params where possible
------------------------------------------------------------------------
------------------------------------------------------------------------
r15666 | michael | 2010-07-30 11:54:55 +0200 (Fri, 30 Jul 2010) | 1 line
Changed paths:
   M /trunk/packages/libxml/Makefile
   M /trunk/packages/libxml/Makefile.fpc

* Remove src as include dir, causes conflict with parser.inc of classes unit
------------------------------------------------------------------------
------------------------------------------------------------------------
r15747 | daniel | 2010-08-08 16:24:46 +0200 (Sun, 08 Aug 2010) | 2 lines
Changed paths:
   M /trunk/rtl/linux/linux.pp

  + Add futex

------------------------------------------------------------------------
------------------------------------------------------------------------
r15775 | marco | 2010-08-11 10:29:47 +0200 (Wed, 11 Aug 2010) | 1 line
Changed paths:
   M /trunk/rtl/win/sysutils.pp

 * First era patch of Taka_JP.
------------------------------------------------------------------------
------------------------------------------------------------------------
r15776 | marco | 2010-08-11 11:03:13 +0200 (Wed, 11 Aug 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/sysutils/dati.inc
   M /trunk/rtl/win/sysutils.pp

 * support for east asia locale in formatdatetime. Patch from Taka_JP, mantis 14955 modified for recent sysutils rework, and to init eastasia support only once.
------------------------------------------------------------------------
------------------------------------------------------------------------
r15782 | florian | 2010-08-11 22:30:14 +0200 (Wed, 11 Aug 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/sysutils/dati.inc

* disable east asia/era stuff on WinCE, the functions does not seem to be available there, fixed compilation of trunk for WinCE
------------------------------------------------------------------------
------------------------------------------------------------------------
r15787 | marco | 2010-08-12 17:34:43 +0200 (Thu, 12 Aug 2010) | 1 line
Changed paths:
   M /trunk/rtl/win/syswin.inc

* simple fix for 16158, avoid crash on duplicate calling of DLL_PROCESS_DETACH
------------------------------------------------------------------------
------------------------------------------------------------------------
r15811 | daniel | 2010-08-14 21:34:05 +0200 (Sat, 14 Aug 2010) | 2 lines
Changed paths:
   M /trunk/rtl/linux/linux.pp

  + Add libc version of futex

------------------------------------------------------------------------
------------------------------------------------------------------------
r15837 | florian | 2010-08-17 23:09:11 +0200 (Tue, 17 Aug 2010) | 2 lines
Changed paths:
   M /trunk/utils/h2pas/h2pas.pas
   M /trunk/utils/h2pas/h2pas.y

* write P'type' instead of ^'type' for function results, resolves #7561

------------------------------------------------------------------------
------------------------------------------------------------------------
r15854 | michael | 2010-08-19 19:04:05 +0200 (Thu, 19 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp
   M /trunk/packages/fcl-json/tests/testjson.lpi
   M /trunk/packages/fcl-json/tests/testjsondata.pp

* Patch from Luiz Americo to fix TJSONBoolean.AsString, also fixed testcases
------------------------------------------------------------------------
------------------------------------------------------------------------
r15855 | michael | 2010-08-19 19:08:43 +0200 (Thu, 19 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/fpreadjpeg.pas

* Applied patch from theo (bug ID 16748) to enable JPEG scaling
------------------------------------------------------------------------
------------------------------------------------------------------------
r15856 | michael | 2010-08-19 19:49:40 +0200 (Thu, 19 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sdf/sdfdata.pp

* Fixed bug #15939 
------------------------------------------------------------------------
------------------------------------------------------------------------
r15857 | michael | 2010-08-19 19:53:24 +0200 (Thu, 19 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/contnrs.pp

* Made chain protected, as asked in 16899
------------------------------------------------------------------------
------------------------------------------------------------------------
r15860 | florian | 2010-08-20 10:22:14 +0200 (Fri, 20 Aug 2010) | 2 lines
Changed paths:
   M /trunk/utils/h2pas/h2pas.pas
   M /trunk/utils/h2pas/h2pas.y
   M /trunk/utils/h2pas/testit.h

* convert array declarations without size into pointers (as even the comment in the code says), resolves #10156

------------------------------------------------------------------------
------------------------------------------------------------------------
r15862 | jonas | 2010-08-20 13:04:44 +0200 (Fri, 20 Aug 2010) | 2 lines
Changed paths:
   M /trunk/ide/fp.pas

  - removed debian detection since its gpm bug has been long fixed

------------------------------------------------------------------------
------------------------------------------------------------------------
r15864 | marco | 2010-08-21 06:33:51 +0200 (Sat, 21 Aug 2010) | 2 lines
Changed paths:
   M /trunk/packages/unzip/src/unzip51g.pp

 * patch from Dmitry for bug #7604, fixing the CRC problems.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15865 | marco | 2010-08-21 07:18:29 +0200 (Sat, 21 Aug 2010) | 3 lines
Changed paths:
   M /trunk/packages/fcl-base/src/gettext.pp

 * slightly adapted patch from Mantis 17224 from Maxim Ganetsky
    also look ups with gettext-context if given.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15871 | marco | 2010-08-22 11:46:17 +0200 (Sun, 22 Aug 2010) | 3 lines
Changed paths:
   M /trunk/rtl/bsd/ossysc.inc

 * another fix for mmap from Chrisopher Key. 32-bit this time. Mostly in
   unused arguments atm, but could be important for other uses of mmap.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15878 | michael | 2010-08-23 09:45:55 +0200 (Mon, 23 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/jsonparser.pp
   M /trunk/packages/fcl-json/src/jsonscanner.pp

* Patch with small speed improvements from Luiz Americo (Bug ID 17240 )
------------------------------------------------------------------------
------------------------------------------------------------------------
r15879 | michael | 2010-08-23 09:48:50 +0200 (Mon, 23 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Patch from Luiz Americo (bug ID 017238) Small speed improvement, corrected order of arguments
------------------------------------------------------------------------
------------------------------------------------------------------------
r15882 | sekelsenmat | 2010-08-23 15:57:36 +0200 (Mon, 23 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/openssl/src/openssl.pas

Adds PEM_read_bio_PrivateKey to the OpenSSl headers and other minor improvements
------------------------------------------------------------------------
------------------------------------------------------------------------
r15883 | sekelsenmat | 2010-08-23 16:32:31 +0200 (Mon, 23 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/openssl/src/openssl.pas

Small fix for PPEVP_PKEY
------------------------------------------------------------------------
------------------------------------------------------------------------
r15884 | sekelsenmat | 2010-08-23 17:26:54 +0200 (Mon, 23 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fpvectorial/examples/fpce_mainform.lfm
   M /trunk/packages/fpvectorial/examples/fpce_mainform.pas
   A /trunk/packages/fpvectorial/examples/fpvwritetest.pas
   M /trunk/packages/fpvectorial/src/fpvectorial.pas

Adds support for texts in the core of fpvectorial and adds a new example application for generating a set of documents from code
------------------------------------------------------------------------
------------------------------------------------------------------------
r15885 | sekelsenmat | 2010-08-23 17:33:41 +0200 (Mon, 23 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/fpvectorial/examples/fpvwritetest.pas

Adds bezier curve and text support for the fpvectorial writer test app.
------------------------------------------------------------------------
------------------------------------------------------------------------
r15886 | sekelsenmat | 2010-08-23 18:04:12 +0200 (Mon, 23 Aug 2010) | 1 line
Changed paths:
   M /trunk/packages/openssl/src/openssl.pas

Adds more OpenSSL BIO functions and constants
------------------------------------------------------------------------
------------------------------------------------------------------------
r15889 | pierre | 2010-08-24 15:17:37 +0200 (Tue, 24 Aug 2010) | 3 lines
Changed paths:
   M /trunk/packages/gdbint/src/gdbint.pp

 * fix current_address type
 * add python_libdir global cvar to avoid linking main.o from libgdb.a

------------------------------------------------------------------------
------------------------------------------------------------------------
r15890 | pierre | 2010-08-24 15:35:09 +0200 (Tue, 24 Aug 2010) | 1 line
Changed paths:
   M /trunk/ide/fpdebug.pas

 + SetTBreak method added
------------------------------------------------------------------------
------------------------------------------------------------------------
r15891 | pierre | 2010-08-24 15:35:36 +0200 (Tue, 24 Aug 2010) | 1 line
Changed paths:
   M /trunk/ide/fpmrun.inc

 + Use SetTbreak method
------------------------------------------------------------------------
------------------------------------------------------------------------
r15894 | pierre | 2010-08-24 16:57:01 +0200 (Tue, 24 Aug 2010) | 1 line
Changed paths:
   M /trunk/rtl/bsd/bunxsysc.inc

 * Avoid warning at compilation
------------------------------------------------------------------------
------------------------------------------------------------------------
r15895 | pierre | 2010-08-24 17:06:50 +0200 (Tue, 24 Aug 2010) | 1 line
Changed paths:
   M /trunk/rtl/freebsd/termiosproc.inc

 * Allow compilation with DEBUG=1
------------------------------------------------------------------------
------------------------------------------------------------------------
r15907 | florian | 2010-08-25 21:43:29 +0200 (Wed, 25 Aug 2010) | 3 lines
Changed paths:
   M /trunk/rtl/linux/x86_64/cprt0.as
   M /trunk/rtl/linux/x86_64/gprt0.as
   M /trunk/rtl/linux/x86_64/prt0.as
   A /trunk/tests/webtbs/tw17236.pp

* support of data > 2 GB on x86_64-linux with PIC by picifing the startup code, resolves #17236
* fixed some small issues in the startup files

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@16420 -

.gitattributes

@@ -1870,6 +1870,7 @@ packages/fpvectorial/examples/fpvc_mainform.pas svneol=native#text/plain
 packages/fpvectorial/examples/fpvectorialconverter.ico -text
 packages/fpvectorial/examples/fpvectorialconverter.lpi svneol=native#text/plain
 packages/fpvectorial/examples/fpvectorialconverter.lpr svneol=native#text/plain
+packages/fpvectorial/examples/fpvwritetest.pas svneol=native#text/plain
 packages/fpvectorial/fpmake.pp svneol=native#text/plain
 packages/fpvectorial/src/avisocncgcodereader.pas svneol=native#text/plain
 packages/fpvectorial/src/avisocncgcodewriter.pas svneol=native#text/plain
@@ -9685,6 +9686,7 @@ tests/webtbs/tw1696.pp svneol=native#text/plain
 tests/webtbs/tw1699.pp svneol=native#text/plain
 tests/webtbs/tw1709.pp svneol=native#text/plain
 tests/webtbs/tw1720.pp svneol=native#text/plain
+tests/webtbs/tw17236.pp svneol=native#text/pascal
 tests/webtbs/tw17283.pp svneol=native#text/plain
 tests/webtbs/tw17337.pp svneol=native#text/plain
 tests/webtbs/tw1735.pp svneol=native#text/plain

ide/fp.pas

@@ -235,25 +235,6 @@ begin
   end;
 end;
 
-{$ifdef linux}
-procedure detect_debian;
-
-var attr:word;
-    f:text;
-
-begin
-  assign(f,'/etc/debian_version');
-  getfattr(f,attr);
-  if doserror=0 then
-    errorbox('Debian system detected!'#13#13+
-             'Debian systems use an incompatible gpm'#13+
-             'daemon, therefore your system might'#13+
-             'suffer from Debian bug 412927. Please'#13+
-             'see http://bugs.debian.org/cgi-bin/'#13+
-             'bugreport.cgi?bug=412927 for details.',nil);
-end;
-{$endif}
-
 procedure DelTempFiles;
 begin
   DeleteFile(FPOutFileName);
@@ -435,10 +416,6 @@ BEGIN
 
   if ShowReadme then
   begin
-  {$ifdef linux}
-    {Regrettably we do not have a proper solution.}
-    detect_debian;
-  {$endif}
     PutCommand(Application,evCommand,cmShowReadme,nil);
     ShowReadme:=false; { do not show next time }
   end;

ide/fpdebug.pas

@@ -58,6 +58,7 @@ type
 {$endif SUPPORT_REMOTE}
     constructor Init;
     procedure SetExe(const exefn:string);
+    procedure SetTBreak(tbreakstring : string);
     procedure SetWidth(AWidth : longint);
     procedure SetSourceDirs;
     destructor  Done;
@@ -683,6 +684,13 @@ begin
     end;
 end;
 
+    
+procedure TDebugController.SetTBreak(tbreakstring : string);
+begin
+  Command('tbreak '+tbreakstring);
+  TBreakNumber:=Last_breakpoint_number;
+end;
+
 procedure TDebugController.SetWidth(AWidth : longint);
 begin
   WindowWidth:=AWidth;

ide/fpmrun.inc

@@ -399,7 +399,7 @@ begin
         begin
           FileName:=PSourceWindow(W)^.Editor^.FileName;
           LineNr:=PSourceWindow(W)^.Editor^.CurPos.Y+1;
-          Debugger^.Command('tbreak '+GDBFileName(NameAndExtOf(FileName))+':'+IntToStr(LineNr));
+          Debugger^.SetTbreak(GDBFileName(NameAndExtOf(FileName))+':'+IntToStr(LineNr));
           Debugger^.Continue;
         end
       else
@@ -413,7 +413,7 @@ begin
             begin
               if PDL^.Address<>0 then
                 begin
-                  Debugger^.Command('tbreak *0x'+HexStr(PDL^.Address,sizeof(pointer)*2));
+                  Debugger^.SetTBreak('*0x'+HexStr(PDL^.Address,sizeof(pointer)*2));
                 end
               else
                 begin
@@ -424,7 +424,7 @@ begin
                   p:=pos(' ',S);
                   S:=Copy(S,1,p-1);
                   LineNr:=StrToInt(S);
-                  Debugger^.Command('tbreak '+GDBFileName(NameAndExtOf(FileName))+':'+IntToStr(LineNr));
+                  Debugger^.SetTBreak(GDBFileName(NameAndExtOf(FileName))+':'+IntToStr(LineNr));
                 end;
               Debugger^.Continue;
             end;

packages/fcl-base/src/contnrs.pp

@@ -363,8 +363,8 @@ type
     function GetLoadFactor: double;
     function GetAVGChainLen: double;
     function GetMaxChainLength: Longword;
-    function Chain(const index: Longword):TFPObjectList;
   protected
+    function Chain(const index: Longword):TFPObjectList;
     Function CreateNewNode(const aKey : string) : THTCustomNode; virtual; abstract;
     Procedure AddNode(ANode : THTCustomNode); virtual; abstract;
     function ChainLength(const ChainIndex: Longword): Longword; virtual;

packages/fcl-base/src/gettext.pp

@@ -261,8 +261,14 @@ end;
 
 
 function Translate (Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString;
+var contextempty : boolean;
 begin
-  Result:=TMOFile(arg).Translate(Value,Hash);
+  contextempty:=name='';
+  Result:='';
+  if not contextempty then
+    Result:=TMOFile(arg).Translate(Name+#4+Value);
+  if contextempty or (Result='') then
+    Result:=TMOFile(arg).Translate(Value,Hash);
 end;
 
 

packages/fcl-base/src/inifiles.pp

@@ -80,7 +80,7 @@ type
     FIdent: string;
     FValue: string;
   public
-    constructor Create(AIdent, AValue: string);
+    constructor Create(const AIdent, AValue: string);
     property Ident: string read FIdent write FIdent;
     property Value: string read FValue write FValue;
   end;
@@ -88,7 +88,7 @@ type
   TIniFileKeyList = class(TList)
   private
     function GetItem(Index: integer): TIniFileKey;
-    function KeyByName(AName: string; CaseSensitive : Boolean): TIniFileKey;
+    function KeyByName(const AName: string; CaseSensitive : Boolean): TIniFileKey;
   public
     destructor Destroy; override;
     procedure Clear; override;
@@ -101,7 +101,7 @@ type
     FKeyList: TIniFileKeyList;
   public
     Function Empty : Boolean;
-    constructor Create(AName: string);
+    constructor Create(const AName: string);
     destructor Destroy; override;
     property Name: string read FName;
     property KeyList: TIniFileKeyList read FKeyList;
@@ -110,7 +110,7 @@ type
   TIniFileSectionList = class(TList)
   private
     function GetItem(Index: integer): TIniFileSection;
-    function SectionByName(AName: string; CaseSensitive : Boolean): TIniFileSection;
+    function SectionByName(const AName: string; CaseSensitive : Boolean): TIniFileSection;
   public
     destructor Destroy; override;
     procedure Clear;override;
@@ -218,7 +218,7 @@ begin
     Result := '0';
 end;
 
-function IsComment(AString: string): boolean;
+function IsComment(const AString: string): boolean;
 begin
   Result := False;
   if AString > '' then
@@ -308,7 +308,7 @@ end;
 
 { TIniFileKey }
 
-constructor TIniFileKey.Create(AIdent, AValue: string);
+constructor TIniFileKey.Create(const AIdent, AValue: string);
 begin
   FIdent := AIdent;
   FValue := AValue;
@@ -323,7 +323,7 @@ begin
     Result := TIniFileKey(inherited Items[Index]);
 end;
 
-function TIniFileKeyList.KeyByName(AName: string; CaseSensitive : Boolean): TIniFileKey;
+function TIniFileKeyList.KeyByName(const AName: string; CaseSensitive : Boolean): TIniFileKey;
 var
   i: integer;
 begin
@@ -379,7 +379,7 @@ end;
 
 { TIniFileSection }
 
-constructor TIniFileSection.Create(AName: string);
+constructor TIniFileSection.Create(const AName: string);
 begin
   FName := AName;
   FKeyList := TIniFileKeyList.Create;
@@ -399,7 +399,7 @@ begin
     Result := TIniFileSection(inherited Items[Index]);
 end;
 
-function TIniFileSectionList.SectionByName(AName: string; CaseSensitive : Boolean): TIniFileSection;
+function TIniFileSectionList.SectionByName(const AName: string; CaseSensitive : Boolean): TIniFileSection;
 var
   i: integer;
 begin

packages/fcl-db/src/sdf/sdfdata.pp

@@ -163,6 +163,7 @@ type
     FBookmarkOfs        :Integer;
     FSaveChanges        :Boolean;
     FDefaultRecordLength:Cardinal;
+    FDataOffset         : Integer;
   protected
     function AllocRecordBuffer: PChar; override;
     procedure FreeRecordBuffer(var Buffer: PChar); override;
@@ -465,7 +466,7 @@ end;
 function TFixedFormatDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
   DoCheck: Boolean): TGetResult;
 begin
-  if (FData.Count < 1) then
+  if (FData.Count < (1+FDataOffset)) then
     Result := grEOF
   else
     Result := TxtGetRecord(Buffer, GetMode);
@@ -542,12 +543,12 @@ begin
         else
           Inc(FCurRec);
       gmPrior:
-        if FCurRec <= 0 then
+        if FCurRec <= FDataOffset then
           Result := grBOF
         else
           Dec(FCurRec);
       gmCurrent:
-        if (FCurRec < 0) or (FCurRec >= RecordCount) then
+        if (FCurRec < FDataOffset) or (FCurRec >= RecordCount) then
           Result := grError;
     end;
     if (Result = grOk) then
@@ -851,7 +852,10 @@ begin
   if not IsCursorOpen then
     exit;
   if (FData.Count = 0) or (Trim(FData[0]) = '') then
-    FirstLineAsSchema := FALSE
+    begin
+    FirstLineAsSchema := FALSE;
+    FDataOffset:=0;
+    end
   else if (Schema.Count = 0) or (FirstLineAsSchema) then
   begin
     Schema.Clear;
@@ -902,13 +906,18 @@ begin
   if FirstLineAsSchema then
   begin
     if (FData.Count < 2) then
-      Result := grEOF
+      begin
+      if GetMode=gmPrior then
+       Result := grBOF
+      else
+       Result := grEOF
+      end
     else
-    begin
+      begin
+      If (FCurrec=-1) and (GetMode=gmNext) then
+        inc(FCurrec);
       Result := inherited GetRecord(Buffer, GetMode, DoCheck);
-      if (Result = grOk) and (FCurRec = 0) then
-        Result := inherited GetRecord(Buffer, GetMode, DoCheck);
-    end;
+      end;
   end
   else
     Result := inherited GetRecord(Buffer, GetMode, DoCheck);
@@ -1008,6 +1017,7 @@ procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
 begin
   CheckInactive;
   FFirstLineAsSchema := Value;
+  FDataOffset:=Ord(FFirstLineAsSchema);
 end;
 
 //-----------------------------------------------------------------------------

packages/fcl-image/src/fpreadjpeg.pas

@@ -48,6 +48,8 @@ type
   TFPReaderJPEG = class(TFPCustomImageReader)
   private
     FSmoothing: boolean;
+    FMinHeight:integer;
+    FMinWidth:integer;
     FWidth: Integer;
     FHeight: Integer;
     FGrayscale: boolean;
@@ -69,6 +71,9 @@ type
     property ProgressiveEncoding: boolean read FProgressiveEncoding;
     property Smoothing: boolean read FSmoothing write SetSmoothing;
     property Performance: TJPEGReadPerformance read FPerformance write SetPerformance;
+    property Scale: TJPEGScale read FScale write FScale;
+    property MinWidth:integer read FMinWidth write FMinWidth;
+    property MinHeight:integer read FMinHeight write FMinHeight;
   end;
 
 implementation
@@ -177,28 +182,50 @@ var
   end;
 
   procedure InitReadingPixels;
+  var d1,d2:integer;
+
+    function DToScale(inp:integer):TJPEGScale;
+    begin
+      if inp>7 then Result:=jsEighth else
+      if inp>3 then Result:=jsQuarter else
+      if inp>1 then Result:=jsHalf else
+      Result:=jsFullSize;
+    end;
+
   begin
     FInfo.scale_num := 1;
-    FInfo.scale_denom := 1;// shl Byte(FScale);
+
+    if (FMinWidth>0) and (FMinHeight>0) then
+      if (FInfo.image_width>FMinWidth) or (FInfo.image_height>FMinHeight) then
+        begin
+        d1:=Round((FInfo.image_width / FMinWidth)-0.5);
+        d2:=Round((FInfo.image_height /  FMinHeight)-0.5);
+        if d1>d2 then fScale:=DToScale(d2) else fScale:=DtoScale(d1);
+        end;
+
+    FInfo.scale_denom :=1 shl Byte(FScale); //1
     FInfo.do_block_smoothing := FSmoothing;
 
     if FGrayscale then FInfo.out_color_space := JCS_GRAYSCALE;
-    if (FInfo.out_color_space = JCS_GRAYSCALE) then begin
+    if (FInfo.out_color_space = JCS_GRAYSCALE) then 
+      begin
       FInfo.quantize_colors := True;
       FInfo.desired_number_of_colors := 236;
-    end;
+      end;
 
-    if FPerformance = jpBestSpeed then begin
+    if FPerformance = jpBestSpeed then 
+      begin
       FInfo.dct_method := JDCT_IFAST;
       FInfo.two_pass_quantize := False;
       FInfo.dither_mode := JDITHER_ORDERED;
       // FInfo.do_fancy_upsampling := False;  can create an AV inside jpeglib
-    end;
+      end;
 
-    if FProgressiveEncoding then begin
+    if FProgressiveEncoding then 
+      begin
       FInfo.enable_2pass_quant := FInfo.two_pass_quantize;
       FInfo.buffered_image := True;
-    end;
+      end;
   end;
 
   function CorrectCMYK(const C: TFPColor): TFPColor;

packages/fcl-json/src/fpjson.pp

@@ -724,7 +724,7 @@ end;
 
 function TJSONboolean.GetAsString: TJSONStringType;
 begin
-  Result:=BoolToStr(FValue);
+  Result:=BoolToStr(FValue, True);
 end;
 
 procedure TJSONboolean.SetAsString(const AValue: TJSONStringType);
@@ -1300,7 +1300,7 @@ begin
   Flist:=TFPObjectList.Create(True);
 end;
 
-Function VarRecToJSON(Const Element : TVarRec; SourceType : String) : TJSONData;
+Function VarRecToJSON(Const Element : TVarRec; const SourceType : String) : TJSONData;
 
 begin
   Result:=Nil;
@@ -1322,7 +1322,7 @@ begin
       vtObject     : if (VObject is TJSONData) then
                        Result:=TJSONData(VObject)
                      else
-                       Raise EJSON.CreateFmt(SErrNotJSONData,[SourceType,VObject.ClassName]);
+                       Raise EJSON.CreateFmt(SErrNotJSONData,[VObject.ClassName,SourceType]);
       //vtVariant    :
     else
       Raise EJSON.CreateFmt(SErrUnknownTypeInConstructor,[SourceType,VType])

packages/fcl-json/src/jsonparser.pp

@@ -30,7 +30,7 @@ Type
     FScanner : TJSONScanner;
     function ParseNumber: TJSONNumber;
   Protected
-    procedure DoError(Msg: String);
+    procedure DoError(const Msg: String);
     function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
     function GetNextToken: TJSONToken;
     function CurrentTokenString: String;
@@ -115,8 +115,7 @@ begin
       tkComma : DoError(SErrUnexpectedToken);
     end;
   except
-    if assigned(Result) then
-      FreeAndNil(Result);
+    FreeAndNil(Result);
     Raise;
   end;
 end;
@@ -226,7 +225,7 @@ begin
   Until (Result<>tkWhiteSpace);
 end;
 
-Procedure TJSONParser.DoError(Msg : String);
+Procedure TJSONParser.DoError(const Msg : String);
 
 Var
   S : String;

packages/fcl-json/src/jsonscanner.pp

@@ -63,7 +63,7 @@ type
     function DoFetchToken: TJSONToken;
   public
     constructor Create(Source : TStream); overload;
-    constructor Create(Source : String); overload;
+    constructor Create(const Source : String); overload;
     destructor Destroy; override;
     function FetchToken: TJSONToken;
 
@@ -104,7 +104,7 @@ begin
   FSource.LoadFromStream(Source);
 end;
 
-constructor TJSONScanner.Create(Source : String);
+constructor TJSONScanner.Create(const Source : String);
 begin
   FSource:=TStringList.Create;
   FSource.Text:=Source;

packages/fcl-json/tests/testjson.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="7"/>
+    <Version Value="8"/>
     <General>
       <Flags>
         <LRSInOutputDirectory Value="False"/>
@@ -58,10 +58,15 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="8"/>
+    <Version Value="9"/>
     <SearchPaths>
       <OtherUnitFiles Value="../src/"/>
     </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
     <Other>
       <CompilerPath Value="$(CompPath)"/>
     </Other>

packages/fcl-json/tests/testjsondata.pp

@@ -399,7 +399,7 @@ begin
     TestAsBoolean(J,True);
     TestAsInteger(J,1);
     TestAsInt64(J,1);
-    TestAsString(J,BoolToStr(True));
+    TestAsString(J,BoolToStr(True,True));
     TestAsFloat(J,1.0);
   finally
     FreeAndNil(J);
@@ -421,7 +421,7 @@ begin
     TestAsBoolean(J,False);
     TestAsInteger(J,0);
     TestAsInt64(J,0);
-    TestAsString(J,BoolToStr(False));
+    TestAsString(J,BoolToStr(False,True));
     TestAsFloat(J,0.0);
   finally
     FreeAndNil(J);

packages/fpvectorial/examples/fpce_mainform.lfm

@@ -51,4 +51,12 @@ object formCorelExplorer: TformCorelExplorer
     Caption = 'Version:'
     ParentColor = False
   end
+  object labelSize: TLabel
+    Left = 256
+    Height = 14
+    Top = 112
+    Width = 24
+    Caption = 'Size:'
+    ParentColor = False
+  end
 end

packages/fpvectorial/examples/fpce_mainform.pas

@@ -15,6 +15,7 @@ type
   TformCorelExplorer = class(TForm)
     Label1: TLabel;
     Label2: TLabel;
+    labelSize: TLabel;
     labelVersion: TLabel;
     labelFilename: TLabel;
     shellInput: TShellTreeView;
@@ -64,9 +65,14 @@ begin
     labelFilename.Caption := 'Filename: ' + shellInput.GetSelectedNodePath();
     if (lChunk.ChildChunks <> nil) and (lChunk.ChildChunks.First <> nil) then
     begin
+      // Version Chunk
       lCurChunk := TCDRChunk(lChunk.ChildChunks.First);
       Str := TCDRChunkVRSN(lCurChunk).VersionStr;
       labelVersion.Caption := 'Version: ' + Str;
+
+      // Main data
+      lCurChunk := TCDRChunk(lChunk.ChildChunks.Items[1]);
+      labelSize.Caption := 'Size: ' + ;
     end;
   finally
     Reader.Free;

packages/fpvectorial/examples/fpvwritetest.pas

@@ -0,0 +1,100 @@
+{
+FPVectorial example application for writing vectorial images
+generated in code to disk. This program will generate the following
+vectorial images:
+
+single_line_1    One line from (0, 20) to (30, 30)
+single_line_2    One line from (20, 30) to (30, 20)
+polyline_1       One line from (0, 0) to (10, 10) to (20, 30) to (30, 20)
+polyline_2       One line from (10, 10) to (20, 30) to (30, 20) to (40, 40)
+bezier_1         One path starting in (0, 0) lining to (10, 10) then bezier to (20, 10) and then line to (30, 0)
+bezier_2         One curve from (10, 10) to (20, 20)
+text_ascii       One text written at (10, 10)
+text_europen     One text testing european languages at (20, 20)
+text_asian       One text testing asian languages at (30, 30)
+
+Author: Felipe Monteiro de Carvalho
+
+License: Public Domain
+}
+program fpvwritetest;
+
+{$mode objfpc}{$H+}
+
+uses
+  fpvectorial, svgvectorialwriter;
+
+const
+  cFormat = vfSVG;
+  cExtension = '.svg';
+var
+  Vec: TvVectorialDocument;
+begin
+  Vec := TvVectorialDocument.Create;
+  try
+    // single_line_1    One line from (0, 20) to (30, 30)
+    Vec.StartPath(0, 20);
+    Vec.AddLineToPath(30, 30);
+    Vec.EndPath();
+    Vec.WriteToFile('single_line_1' + cExtension, cFormat);
+
+    //    single_line_2    One line from (20, 30) to (30, 20)
+    Vec.Clear;
+    Vec.StartPath(20, 30);
+    Vec.AddLineToPath(30, 20);
+    Vec.EndPath();
+    Vec.WriteToFile('single_line_2' + cExtension, cFormat);
+
+    //    polyline_1       One line from (0, 0) to (10, 10) to (20, 30) to (30, 20)
+    Vec.Clear;
+    Vec.StartPath(0, 0);
+    Vec.AddLineToPath(10, 10);
+    Vec.AddLineToPath(20, 30);
+    Vec.AddLineToPath(30, 20);
+    Vec.EndPath();
+    Vec.WriteToFile('polyline_1' + cExtension, cFormat);
+
+    //    polyline_2       One line from (10, 10) to (20, 30) to (30, 20) to (40, 40)
+    Vec.Clear;
+    Vec.StartPath(10, 10);
+    Vec.AddLineToPath(20, 30);
+    Vec.AddLineToPath(30, 20);
+    Vec.AddLineToPath(40, 40);
+    Vec.EndPath();
+    Vec.WriteToFile('polyline_2' + cExtension, cFormat);
+
+    // bezier_1         One path starting in (0, 0) lining to (10, 10) then bezier to (20, 10) and then line to (30, 0)
+    Vec.Clear;
+    Vec.StartPath(0, 0);
+    Vec.AddLineToPath(10, 10);
+    Vec.AddBezierToPath(10, 20, 20, 20, 20, 10);
+    Vec.AddLineToPath(30, 0);
+    Vec.EndPath();
+    Vec.WriteToFile('bezier_1' + cExtension, cFormat);
+
+    // bezier_2         One curve from (10, 10) to (20, 20)
+    Vec.Clear;
+    Vec.StartPath(10, 10);
+    Vec.AddBezierToPath(10, 15, 15, 20, 20, 10);
+    Vec.EndPath();
+    Vec.WriteToFile('bezier_2' + cExtension, cFormat);
+
+    // text_ascii       One text written at (10, 10)
+    Vec.Clear;
+    Vec.AddText('Some text in english.');
+    Vec.WriteToFile('text_ascii' + cExtension, cFormat);
+
+    // text_europen     One text testing european languages at (20, 20)
+    Vec.Clear;
+    Vec.AddText('Mówić, cześć, Włosku, Parabéns, Assunção, Correções.');
+    Vec.WriteToFile('text_europen' + cExtension, cFormat);
+
+    // text_asian       One text testing asian languages at (30, 30)
+    Vec.Clear;
+    Vec.AddText('森林，是一个高密度树木的区域');
+    Vec.WriteToFile('text_asian' + cExtension, cFormat);
+  finally
+    Vec.Free;
+  end;
+end.
+

packages/fpvectorial/src/fpvectorial.pas

@@ -63,6 +63,18 @@ type
 
   PPath = ^TPath;
 
+  {@@
+    TvText represents a text in memory.
+
+    At the moment fonts are unsupported, only simple texts
+    up to 255 chars are supported.
+  }
+  TvText = record
+    Value: array[0..255] of Char;
+  end;
+
+  PText = ^TvText;
+
 type
 
   TvCustomVectorialWriter = class;
@@ -73,6 +85,7 @@ type
   TvVectorialDocument = class
   private
     FPaths: TFPList;
+    FTexts: TFPList;
     FTmpPath: TPath;
     procedure RemoveCallback(data, arg: pointer);
     function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
@@ -94,9 +107,12 @@ type
     { Data reading methods }
     function  GetPath(ANum: Cardinal): TPath;
     function  GetPathCount: Integer;
+    function  GetText(ANum: Cardinal): TvText;
+    function  GetTextCount: Integer;
     { Data removing methods }
     procedure Clear;
     procedure RemoveAllPaths;
+    procedure RemoveAllTexts;
     { Data writing methods }
     procedure AddPath(APath: TPath);
     procedure StartPath(AX, AY: Double);
@@ -105,6 +121,8 @@ type
     procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload;
     procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload;
     procedure EndPath();
+    procedure AddText(AText: TvText); overload;
+    procedure AddText(AStr: utf8string); overload;
     { properties }
     property PathCount: Integer read GetPathCount;
     property Paths[Index: Cardinal]: TPath read GetPath;
@@ -264,6 +282,7 @@ begin
   inherited Create;
 
   FPaths := TFPList.Create;
+  FTexts := TFPList.Create;
 end;
 
 {@@
@@ -274,6 +293,7 @@ begin
   Clear;
 
   FPaths.Free;
+  FTexts.Free;
 
   inherited Destroy;
 end;
@@ -287,6 +307,12 @@ begin
   FPaths.Clear;
 end;
 
+procedure TvVectorialDocument.RemoveAllTexts;
+begin
+  FTexts.ForEachCall(RemoveCallback, nil);
+  FTexts.Clear;
+end;
+
 procedure TvVectorialDocument.AddPath(APath: TPath);
 var
   Path: PPath;
@@ -389,6 +415,25 @@ begin
   FTmPPath.Len := 0;
 end;
 
+procedure TvVectorialDocument.AddText(AText: TvText);
+var
+  lText: PText;
+  Len: Integer;
+begin
+  Len := SizeOf(TvText);
+  lText := GetMem(Len);
+  Move(AText, lText^, Len);
+  FTexts.Add(lText);
+end;
+
+procedure TvVectorialDocument.AddText(AStr: utf8string);
+var
+  lText: TvText;
+begin
+  lText.Value := AStr;
+  AddText(lText);
+end;
+
 {@@
   Convenience method which creates the correct
   writer object for a given vector graphics document format.
@@ -568,12 +613,27 @@ begin
   Result := FPaths.Count;
 end;
 
+function TvVectorialDocument.GetText(ANum: Cardinal): TvText;
+begin
+  if ANum >= FTexts.Count then raise Exception.Create('TvVectorialDocument.GetText: Text number out of bounds');
+
+  if FTexts.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetText: Invalid Text number');
+
+  Result := PText(FTexts.Items[ANum])^;
+end;
+
+function TvVectorialDocument.GetTextCount: Integer;
+begin
+  Result := FTexts.Count;
+end;
+
 {@@
   Clears all data in the document
 }
 procedure TvVectorialDocument.Clear;
 begin
   RemoveAllPaths();
+  RemoveAllTexts();
 end;
 
 { TvCustomVectorialReader }

packages/gdbint/src/gdbint.pp

@@ -630,7 +630,6 @@ type
     frame_level,
     command_level,
     stop_breakpoint_number,
-    current_address,
     current_line_number,
     signal_start,
     signal_end,
@@ -648,6 +647,7 @@ type
     line_end : longint;
     signal_name,
     signal_string : pchar;
+    current_address,
     current_pc      : CORE_ADDR;
     { breakpoint }
     last_breakpoint_number,
@@ -2360,10 +2360,14 @@ var
     begin
 
 {$ifdef GDB_USES_BP_LOCATION}
-      sym:=find_pc_line(b.loc^.address,0);
+      if assigned (b.loc) then
+        sym:=find_pc_line(b.loc^.address,0)
 {$else not GDB_USES_BP_LOCATION}
-      sym:=find_pc_line(b.address,0);
+      if (b.address <> 0) then
+        sym:=find_pc_line(b.address,0)
 {$endif not GDB_USES_BP_LOCATION}
+      else
+        fillchar (sym, sizeof(sym), #0);
     end;
 begin
   get_pc_line;
@@ -2374,7 +2378,10 @@ begin
        but they are valid !! }
      invalid_breakpoint_line:=(b.line_number<>sym.line) and (b.line_number<>0);
 {$ifdef GDB_USES_BP_LOCATION}
-     last_breakpoint_address:=b.loc^.address;
+     if assigned (b.loc) then
+       last_breakpoint_address:=b.loc^.address
+     else
+       last_breakpoint_address:=0;
 {$else not GDB_USES_BP_LOCATION}
      last_breakpoint_address:=b.address;
 {$endif not GDB_USES_BP_LOCATION}
@@ -2983,6 +2990,7 @@ end;
 {$ifdef GDB_HAS_SYSROOT}
 var gdb_sysroot  : pchar; cvar;public;
     gdb_datadir  : pchar; cvar;public;
+    python_libdir : pchar;cvar;public;
     gdb_sysrootc : char;
     return_child_result : longbool;cvar;public;
     return_child_result_value : longint;cvar;public;
@@ -2999,6 +3007,7 @@ begin
   gdb_sysrootc := #0;
   gdb_sysroot := @gdb_sysrootc;
   gdb_datadir := @gdb_sysrootc;
+  python_libdir := @gdb_sysrootc;
 {$endif}
 {$ifdef GDB_HAS_DEBUG_FILE_DIRECTORY}
   debug_file_directory := '/usr/local/lib';

packages/libxml/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/08/25]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/11/23]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -628,186 +628,6 @@ override TARGET_EXAMPLEDIRS+=examples
 endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-haiku)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-darwin)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-symbian)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),m68k-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),sparc-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),x86_64-solaris)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),x86_64-darwin)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),x86_64-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-palmos)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-darwin)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-gba)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-nds)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),arm-symbian)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc64-darwin)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),powerpc64-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),avr-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),armeb-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),armeb-embedded)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),mipsel-linux)
-override COMPILER_INCLUDEDIR+=src
-endif
-ifeq ($(FULL_TARGET),i386-linux)
 override COMPILER_SOURCEDIR+=src tests examples
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)

packages/libxml/Makefile.fpc

@@ -16,7 +16,6 @@ exampledirs=examples
 fpcpackage=y
 
 [compiler]
-includedir=src
 sourcedir=src tests examples
 
 [default]

packages/openssl/src/openssl.pas

@@ -45,7 +45,7 @@ unit OpenSSL;
 |          if need be, it should be re-added, or handled by the                | 
 |           OS threading init somehow                                          |
 |                                                                              |
-| 2010 - Felipe Monteiro de Carvalho - Many improvements                       |
+| 2010 - Felipe Monteiro de Carvalho - Added RAND functios                     |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -108,7 +108,8 @@ type
   PEVP_MD	= SslPtr;
   PBIO_METHOD = SslPtr;
   PBIO = SslPtr;
-  EVP_PKEY = SslPtr;
+  PEVP_PKEY = SslPtr;
+  PPEVP_PKEY = ^PEVP_PKEY;
   PRSA = SslPtr;
   PPRSA = ^PRSA;
   PASN1_UTCTIME = SslPtr;
@@ -241,6 +242,10 @@ type
                                      // in the OpenSSL library will occur
   end;
 
+  // PEM
+
+  Ppem_password_cb = Pointer;
+
 const
   SSL_ERROR_NONE = 0;
   SSL_ERROR_SSL = 1;
@@ -367,6 +372,76 @@ const
   RSA_NO_PADDING         = 3;
   RSA_PKCS1_OAEP_PADDING = 4;
 
+  // BIO
+
+  BIO_NOCLOSE	        = $00;
+  BIO_CLOSE 	        = $01;
+
+  //* modifiers */
+  BIO_FP_READ		= $02;
+  BIO_FP_WRITE		= $04;
+  BIO_FP_APPEND		= $08;
+  BIO_FP_TEXT		= $10;
+
+  BIO_C_SET_CONNECT                 = 100;
+  BIO_C_DO_STATE_MACHINE            = 101;
+  BIO_C_SET_NBIO	            = 102;
+  BIO_C_SET_PROXY_PARAM	            = 103;
+  BIO_C_SET_FD	                    = 104;
+  BIO_C_GET_FD		            = 105;
+  BIO_C_SET_FILE_PTR	            = 106;
+  BIO_C_GET_FILE_PTR	            = 107;
+  BIO_C_SET_FILENAME	            = 108;
+  BIO_C_SET_SSL		            = 109;
+  BIO_C_GET_SSL		            = 110;
+  BIO_C_SET_MD		            = 111;
+  BIO_C_GET_MD	                    = 112;
+  BIO_C_GET_CIPHER_STATUS           = 113;
+  BIO_C_SET_BUF_MEM 	            = 114;
+  BIO_C_GET_BUF_MEM_PTR  	    = 115;
+  BIO_C_GET_BUFF_NUM_LINES          = 116;
+  BIO_C_SET_BUFF_SIZE	            = 117;
+  BIO_C_SET_ACCEPT 	            = 118;
+  BIO_C_SSL_MODE 	            = 119;
+  BIO_C_GET_MD_CTX	            = 120;
+  BIO_C_GET_PROXY_PARAM	            = 121;
+  BIO_C_SET_BUFF_READ_DATA 	    = 122; // data to read first */
+  BIO_C_GET_CONNECT	 	    = 123;
+  BIO_C_GET_ACCEPT		    = 124;
+  BIO_C_SET_SSL_RENEGOTIATE_BYTES   = 125;
+  BIO_C_GET_SSL_NUM_RENEGOTIATES    = 126;
+  BIO_C_SET_SSL_RENEGOTIATE_TIMEOUT = 127;
+  BIO_C_FILE_SEEK		    = 128;
+  BIO_C_GET_CIPHER_CTX		    = 129;
+  BIO_C_SET_BUF_MEM_EOF_RETURN	= 130;//*return end of input value*/
+  BIO_C_SET_BIND_MODE		= 131;
+  BIO_C_GET_BIND_MODE		= 132;
+  BIO_C_FILE_TELL		= 133;
+  BIO_C_GET_SOCKS		= 134;
+  BIO_C_SET_SOCKS		= 135;
+
+  BIO_C_SET_WRITE_BUF_SIZE	= 136;//* for BIO_s_bio */
+  BIO_C_GET_WRITE_BUF_SIZE	= 137;
+  BIO_C_MAKE_BIO_PAIR		= 138;
+  BIO_C_DESTROY_BIO_PAIR	= 139;
+  BIO_C_GET_WRITE_GUARANTEE	= 140;
+  BIO_C_GET_READ_REQUEST	= 141;
+  BIO_C_SHUTDOWN_WR		= 142;
+  BIO_C_NREAD0		        = 143;
+  BIO_C_NREAD			= 144;
+  BIO_C_NWRITE0			= 145;
+  BIO_C_NWRITE			= 146;
+  BIO_C_RESET_READ_REQUEST	= 147;
+  BIO_C_SET_MD_CTX		= 148;
+
+  BIO_C_SET_PREFIX		= 149;
+  BIO_C_GET_PREFIX		= 150;
+  BIO_C_SET_SUFFIX		= 151;
+  BIO_C_GET_SUFFIX		= 152;
+
+  BIO_C_SET_EX_ARG		= 153;
+  BIO_C_GET_EX_ARG		= 154;
+
 var
   SSLLibHandle: TLibHandle = 0;
   SSLUtilHandle: TLibHandle = 0;
@@ -437,18 +512,18 @@ var
   function X509Digest(data: PX509; _type: PEVP_MD; md: String; var len: cInt):cInt;
   function X509print(b: PBIO; a: PX509): cInt;
   function X509SetVersion(x: PX509; version: cInt): cInt;
-  function X509SetPubkey(x: PX509; pkey: EVP_PKEY): cInt;
+  function X509SetPubkey(x: PX509; pkey: PEVP_PKEY): cInt;
   function X509SetIssuerName(x: PX509; name: PX509_NAME): cInt;
   function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: cInt;
     bytes: string; len, loc, _set: cInt): cInt;
-  function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): cInt;
+  function X509Sign(x: PX509; pkey: PEVP_PKEY; const md: PEVP_MD): cInt;
   function X509GmtimeAdj(s: PASN1_UTCTIME; adj: cInt): PASN1_UTCTIME;
   function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): cInt;
   function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): cInt;
   function X509GetSerialNumber(x: PX509): PASN1_cInt;
-  function EvpPkeyNew: EVP_PKEY;
-  procedure EvpPkeyFree(pk: EVP_PKEY);
-  function EvpPkeyAssign(pkey: EVP_PKEY; _type: cInt; key: Prsa): cInt;
+  function EvpPkeyNew: PEVP_PKEY;
+  procedure EvpPkeyFree(pk: PEVP_PKEY);
+  function EvpPkeyAssign(pkey: PEVP_PKEY; _type: cInt; key: Prsa): cInt;
   function EvpGetDigestByName(Name: String): PEVP_MD;
   procedure EVPcleanup;
   function SSLeayversion(t: cInt): string;
@@ -470,7 +545,7 @@ var
   function Asn1UtctimeNew: PASN1_UTCTIME;
   procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
   function i2dX509bio(b: PBIO; x: PX509): cInt;
-  function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): cInt;
+  function i2dPrivateKeyBio(b: PBIO; pkey: PEVP_PKEY): cInt;
 
   // 3DES functions
   procedure DESsetoddparity(Key: des_cblock);
@@ -570,6 +645,16 @@ var
   function EVP_DecryptUpdate(ctx: PEVP_CIPHER_CTX; out_data: PByte;
            outl: pcint; const in_: PByte; inl: cint): cint;
   function EVP_DecryptFinal(ctx: PEVP_CIPHER_CTX; outm: PByte; outlen: pcint): cint;
+  //
+  // PEM Functions - pem.h
+  //
+  function PEM_read_bio_PrivateKey(bp: PBIO; X: PPEVP_PKEY;
+           cb: Ppem_password_cb; u: Pointer): PEVP_PKEY;
+
+  // BIO Functions - bio.h
+
+  function BIO_ctrl(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong;
+  function BIO_read_filename(b: PBIO; const name: PChar): cint;
 
 
 function IsSSLloaded: Boolean;
@@ -634,18 +719,18 @@ type
   TX509Digest = function(data: PX509; _type: PEVP_MD; md: PChar; len: PcInt):cInt; cdecl;
   TX509print = function(b: PBIO; a: PX509): cInt; cdecl;
   TX509SetVersion = function(x: PX509; version: cInt): cInt; cdecl;
-  TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): cInt; cdecl;
+  TX509SetPubkey = function(x: PX509; pkey: PEVP_PKEY): cInt; cdecl;
   TX509SetIssuerName = function(x: PX509; name: PX509_NAME): cInt; cdecl;
   TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PChar; _type: cInt;
     bytes: PChar; len, loc, _set: cInt): cInt; cdecl;
-  TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): cInt; cdecl;
+  TX509Sign = function(x: PX509; pkey: PEVP_PKEY; const md: PEVP_MD): cInt; cdecl;
   TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: cInt): PASN1_UTCTIME; cdecl;
   TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): cInt; cdecl;
   TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): cInt; cdecl;
   TX509GetSerialNumber = function(x: PX509): PASN1_cInt; cdecl;
-  TEvpPkeyNew = function: EVP_PKEY; cdecl;
-  TEvpPkeyFree = procedure(pk: EVP_PKEY); cdecl;
-  TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: cInt; key: Prsa): cInt; cdecl;
+  TEvpPkeyNew = function: PEVP_PKEY; cdecl;
+  TEvpPkeyFree = procedure(pk: PEVP_PKEY); cdecl;
+  TEvpPkeyAssign = function(pkey: PEVP_PKEY; _type: cInt; key: Prsa): cInt; cdecl;
   TEvpGetDigestByName = function(Name: PChar): PEVP_MD; cdecl;
   TEVPcleanup = procedure; cdecl;
   TSSLeayversion = function(t: cInt): PChar; cdecl;
@@ -667,7 +752,7 @@ type
   TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
   TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
   Ti2dX509bio = function(b: PBIO; x: PX509): cInt; cdecl;
-  Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): cInt; cdecl;
+  Ti2dPrivateKeyBio= function(b: PBIO; pkey: PEVP_PKEY): cInt; cdecl;
 
   // 3DES functions
   TDESsetoddparity = procedure(Key: des_cblock); cdecl;
@@ -759,6 +844,15 @@ type
            outl: pcint; const in_: PByte; inl: cint): cint; cdecl;
   TEVP_DecryptFinal = function(ctx: PEVP_CIPHER_CTX; outm: PByte; outlen: pcint): cint; cdecl;
 
+  // PEM functions
+
+  TPEM_read_bio_PrivateKey = function(bp: PBIO; X: PPEVP_PKEY;
+           cb: Ppem_password_cb; u: Pointer): PEVP_PKEY; cdecl;
+
+  // BIO Functions
+
+  TBIO_ctrl = function(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong; cdecl;
+
 var
 // libssl.dll
   _SslGetError: TSslGetError = nil;
@@ -932,6 +1026,13 @@ var
   _EVP_DecryptUpdate: TEVP_DecryptUpdate = nil;
   _EVP_DecryptFinal: TEVP_DecryptFinal = nil;
 
+  // PEM
+  _PEM_read_bio_PrivateKey: TPEM_read_bio_PrivateKey = nil;
+
+  // BIO Functions
+
+  _BIO_ctrl: TBIO_ctrl = nil;
+
 var
   SSLloaded: boolean = false;
 
@@ -1324,7 +1425,7 @@ begin
     Result := 0;
 end;
 
-function EvpPkeyNew: EVP_PKEY;
+function EvpPkeyNew: PEVP_PKEY;
 begin
   if InitSSLInterface and Assigned(_EvpPkeyNew) then
     Result := _EvpPkeyNew
@@ -1332,7 +1433,7 @@ begin
     Result := nil;
 end;
 
-procedure EvpPkeyFree(pk: EVP_PKEY);
+procedure EvpPkeyFree(pk: PEVP_PKEY);
 begin
   if InitSSLInterface and Assigned(_EvpPkeyFree) then
     _EvpPkeyFree(pk);
@@ -1468,7 +1569,7 @@ begin
     _PKCS12free(p12);
 end;
 
-function EvpPkeyAssign(pkey: EVP_PKEY; _type: cInt; key: Prsa): cInt;
+function EvpPkeyAssign(pkey: PEVP_PKEY; _type: cInt; key: Prsa): cInt;
 begin
   if InitSSLInterface and Assigned(_EvpPkeyAssign) then
     Result := _EvpPkeyAssign(pkey, _type, key)
@@ -1484,7 +1585,7 @@ begin
     Result := 0;
 end;
 
-function X509SetPubkey(x: PX509; pkey: EVP_PKEY): cInt;
+function X509SetPubkey(x: PX509; pkey: PEVP_PKEY): cInt;
 begin
   if InitSSLInterface and Assigned(_X509SetPubkey) then
     Result := _X509SetPubkey(x, pkey)
@@ -1509,7 +1610,7 @@ begin
     Result := 0;
 end;
 
-function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): cInt;
+function X509Sign(x: PX509; pkey: PEVP_PKEY; const md: PEVP_MD): cInt;
 begin
   if InitSSLInterface and Assigned(_X509Sign) then
     Result := _X509Sign(x, pkey, md)
@@ -1563,7 +1664,7 @@ begin
     Result := 0;
 end;
 
-function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): cInt;
+function i2dPrivateKeyBio(b: PBIO; pkey: PEVP_PKEY): cInt;
 begin
   if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then
     Result := _i2dPrivateKeyBio(b, pkey)
@@ -2057,6 +2158,32 @@ begin
     Result := -1;
 end;
 
+{ PEM }
+
+function PEM_read_bio_PrivateKey(bp: PBIO; X: PPEVP_PKEY;
+         cb: Ppem_password_cb; u: Pointer): PEVP_PKEY;
+begin
+  if InitSSLInterface and Assigned(_PEM_read_bio_PrivateKey) then
+    Result := _PEM_read_bio_PrivateKey(bp, x, cb, u)
+  else
+    Result := nil;
+end;
+
+// BIO Functions
+
+function BIO_ctrl(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong;
+begin
+  if InitSSLInterface and Assigned(_BIO_ctrl) then
+    Result := _BIO_ctrl(bp, cmd, larg, parg)
+  else
+    Result := -1;
+end;
+
+function BIO_read_filename(b: PBIO; const name: PChar): cint;
+begin
+  Result := BIO_ctrl(b, BIO_C_SET_FILENAME, BIO_CLOSE or BIO_FP_READ, Pointer(name));
+end;
+
 
 {$IFNDEF WINDOWS}
 { Try to load all library versions until you find or run out }
@@ -2282,6 +2409,14 @@ begin
         _EVP_DecryptUpdate := GetProcAddr(SSLUtilHandle, 'EVP_DecryptUpdate', AVerboseLoading);
         _EVP_DecryptFinal := GetProcAddr(SSLUtilHandle, 'EVP_DecryptFinal', AVerboseLoading);
 
+        // PEM
+
+        _PEM_read_bio_PrivateKey := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_PrivateKey', AVerboseLoading);
+
+        // BIO
+
+        _BIO_ctrl := GetProcAddr(SSLUtilHandle, 'BIO_ctrl', AVerboseLoading);
+
         //init library
         if assigned(_SslLibraryInit) then
           _SslLibraryInit;
@@ -2505,6 +2640,13 @@ begin
     _EVP_DecryptUpdate := nil;
     _EVP_DecryptFinal := nil;
 
+    // PEM
+
+    _PEM_read_bio_PrivateKey := nil;
+
+    // BIO
+
+    _BIO_ctrl := nil;
 
   Result := True;
 end;

packages/sqlite/src/sqlite3.inc

@@ -5951,5 +5951,3 @@ begin
 end;
 
 {$ENDIF}
-
-end.

packages/unzip/src/unzip51g.pp

@@ -2410,8 +2410,18 @@ BEGIN
     originalcrc := b AND $FFFF;
     dumpbits ( 16 );
     needbits ( 16 );
-    originalcrc := ( b AND $FFFF ) SHL 16;
+    originalcrc := originalcrc OR LongWord(( b AND $FFFF ) SHL 16);
     dumpbits ( 16 );
+
+    IF originalcrc = $08074b50 THEN BEGIN
+      { skiping possible $08074b50 data descriptor signature. see PKWARE APPNOTE.txt }
+      needbits ( 16 );
+      originalcrc := b AND $FFFF;
+      dumpbits ( 16 );
+      needbits ( 16 );
+      originalcrc := originalcrc OR LongWord(( b AND $FFFF ) SHL 16);
+      dumpbits ( 16 );
+    END;
   END;
 
   close ( infile );

rtl/bsd/bunxsysc.inc

@@ -84,7 +84,7 @@ Begin
  it.it_value.tv_sec:=seconds;
  it.it_value.tv_usec:=0;
  If SetITimer(ITIMER_REAL,it,oitv)<0 Then
-   Exit(-1);
+   Exit(cuint(-1));
 
  if oitv.it_value.tv_usec<>0 Then
    Inc(oitv.it_value.tv_sec);

rtl/bsd/ossysc.inc

@@ -96,10 +96,10 @@ begin
  {$ifdef CPU64}
   Fpmmap:=pointer(ptruint(do_syscall(TSysParam(syscall_nr_mmap),TSysParam(Start),TSysParam(Len),TSysParam(Prot),TSysParam(Flags),TSysParam(fd),0,TSysParam(offst))));
 {$else}
-  Fpmmap:=pointer(ptruint(do_syscall(syscall_nr_mmap,TSysParam(Start),Len,Prot,Flags,fd,
-        {$ifdef FPC_BIG_ENDIAN}    hi(offst),lo(offst){$endif}
-        {$ifdef FPC_LITTLE_ENDIAN} lo(offst),hi(offst){$endif},0
-        )));
+ Fpmmap:=pointer(ptruint(do_syscall(syscall_nr_mmap,TSysParam(Start),Len,Prot,Flags,fd,0,
+         {$ifdef FPC_BIG_ENDIAN}    hi(offst),lo(offst){$endif}
+         {$ifdef FPC_LITTLE_ENDIAN} lo(offst),hi(offst){$endif}
+         )));
 {$endif}
 end;
 

rtl/freebsd/termiosproc.inc

@@ -29,9 +29,12 @@ var
   nr:cint;
 begin
   case OptAct of
-   TCSANOW   : nr:=TIOCSETA;
-   TCSADRAIN : nr:=TIOCSETAW;
-   TCSAFLUSH : nr:=TIOCSETAF;
+  {the three constants TIOCSETA, TIOCSETAW and TIOCSETAF are
+   unsigned values above $80000000, so that they give range check errors
+   on 32-bit systems }
+   TCSANOW   : nr:=cint(TIOCSETA);
+   TCSADRAIN : nr:=cint(TIOCSETAW);
+   TCSAFLUSH : nr:=cint(TIOCSETAF);
   else
    begin
      fpsetErrNo(ESysEINVAL);

rtl/linux/linux.pp

@@ -101,6 +101,19 @@ const
    if (oldval CMP CMPARG)
      wake UADDR2; }
 
+{$ifndef FPC_USE_LIBC}
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec;addr2:Pcint;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;timeout:Ptimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$else}
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec;addr2:Pcint;val3:cint):cint; cdecl; external name 'futex';
+function futex(var uaddr;op,val:cint;timeout:Ptimespec;var addr2;val3:cint):cint; cdecl; external name 'futex';
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec;var addr2;val3:cint):cint; cdecl; external name 'futex';
+{$endif}
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
 {$ifndef FPC_USE_LIBC}
 function futex_op(op, oparg, cmp, cmparg: cint): cint; {$ifdef SYSTEMINLINE}inline;{$endif}
 {$endif}
@@ -503,6 +516,67 @@ begin
   fdatasync:=do_SysCall(syscall_nr_fdatasync, fd);
 end;
 
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec;addr2:Pcint;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout),
+                    Tsysparam(addr2),Tsysparam(val3));
+end;
+
+function futex(var uaddr;op,val:cint;timeout:Ptimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout),
+                    Tsysparam(@addr2),Tsysparam(val3));
+end;
+
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(@timeout),
+                    Tsysparam(@addr2),Tsysparam(val3));
+end;
+
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout));
+end;
+
+function futex(var uaddr;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout));
+end;
+
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(@timeout));
+end;
+
+{$else}
+
+{Libc case.}
+
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=futex(uaddr,op,val,nil,nil,0);
+end;
+
+function futex(var uaddr;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=futex(@uaddr,op,val,nil,nil,0);
+end;
+
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=futex(@uaddr,op,val,@timeout,nil,0);
+end;
+
 {$endif} // non-libc
 
 { FUTEX_OP is a macro, doesn't exist in libC as function}

rtl/linux/x86_64/cprt0.as

@@ -44,11 +44,14 @@ _start:
 	popq %rsi		/* Pop the argument count.  */
 	movq %rsp, %rdx		/* argv starts just at the current stack top.  */
 
-        movq     %rsi,operatingsystem_parameter_argc
-	movq     %rsp,operatingsystem_parameter_argv   /* argv starts just at the current stack top.  */
-        leaq     8(,%rsi,8),%rax
-        addq     %rsp,%rax
-        movq     %rax,operatingsystem_parameter_envp
+        movq    operatingsystem_parameter_argc@GOTPCREL(%rip),%rax
+        movq    %rsi,(%rax)
+        movq    operatingsystem_parameter_argv@GOTPCREL(%rip),%rax
+        movq    %rsp,(%rax)   /* argv starts just at the current stack top.  */
+        leaq    8(,%rsi,8),%rax
+        addq    %rsp,%rax
+        movq    operatingsystem_parameter_envp@GOTPCREL(%rip),%rsi
+        movq    %rax,(%rsi)
 
 	/* Align the stack to a 16 byte boundary to follow the ABI.  */
 	andq  $~15, %rsp
@@ -60,18 +63,20 @@ _start:
 	pushq %rsp
 
 	/* Pass address of our own entry points to .fini and .init.  */
-	movq $_init_dummy, %r8
-	movq $_fini_dummy, %rcx
+	movq _init_dummy@GOTPCREL(%rip), %rcx
+	movq _fini_dummy@GOTPCREL(%rip), %r8
 
-	movq $main_stub, %rdi
+	movq main_stub@GOTPCREL(%rip), %rdi
 
 	/* Call the user's main function, and exit with its value.
 	   But let the libc call main.	  */
-	call __libc_start_main
+	call __libc_start_main@PLT
 
 	hlt			/* Crash if somehow `exit' does return.	 */
 
 /* fake main routine which will be run from libc */
+	.globl main_stub
+        .type main_stub,@function
 main_stub:
         /* save return address */
         popq    %rax
@@ -79,29 +84,49 @@ main_stub:
 	// stack alignment
 	pushq	%rax
 
-        movq    %rax,___fpc_ret
-        movq    %rbp,___fpc_ret_rbp
+	movq    ___fpc_ret_rbp@GOTPCREL(%rip),%rcx
+        movq    %rbp,(%rcx)
+	movq    ___fpc_ret@GOTPCREL(%rip),%rcx
+        movq    %rax,(%rcx)
         pushq   %rax
 
         /* Save initial stackpointer */
-        movq    %rsp,__stkptr
+        movq    __stkptr@GOTPCREL(%rip),%rax
+        movq    %rsp,(%rax)
 
         /* start the program */
         xorq    %rbp,%rbp
-        call    PASCALMAIN
+        call    PASCALMAIN@PLT
         hlt
+	.size   main_stub,.-main_stub
+
 
         .globl _haltproc
         .type _haltproc,@function
 _haltproc:
-        movzwq    operatingsystem_result,%rax /* load and save exitcode */
-
-        movq    ___fpc_ret,%rdx         /* return to libc */
-        movq    ___fpc_ret_rbp,%rbp
+        movq    operatingsystem_result@GOTPCREL(%rip),%rax
+        movzwl  (%rax),%eax
+
+        /* return to libc */
+	movq    ___fpc_ret_rbp@GOTPCREL(%rip),%rcx
+        movq    (%rcx),%rbp
+	movq    ___fpc_ret@GOTPCREL(%rip),%rcx
+        movq    (%rcx),%rdx
         pushq    %rdx
+	ret
+	.size   _haltproc,.-_haltproc
+
+	.globl _init_dummy
+        .type   _init_dummy, @function
 _init_dummy:
+        ret
+	.size   _init_dummy,.-_init_dummy
+
+	.globl  _fini_dummy
+        .type   _fini_dummy, @function
 _fini_dummy:
         ret
+	.size   _fini_dummy,.-_fini_dummy
 
 /* Define a symbol for the first piece of initialized data.  */
 	.data

rtl/linux/x86_64/gprt0.as

@@ -44,11 +44,14 @@ _start:
 	popq %rsi		/* Pop the argument count.  */
 	movq %rsp, %rdx		/* argv starts just at the current stack top.  */
 
-        movq     %rsi,operatingsystem_parameter_argc
-	movq     %rsp,operatingsystem_parameter_argv   /* argv starts just at the current stack top.  */
+        movq    operatingsystem_parameter_argc@GOTPCREL(%rip),%rax
+        movq    %rsi,(%rax)
+        movq    operatingsystem_parameter_argv@GOTPCREL(%rip),%rax
+        movq    %rsp,(%rax)   /* argv starts just at the current stack top.  */
         leaq     8(,%rsi,8),%rax
         addq     %rsp,%rax
-        movq     %rax,operatingsystem_parameter_envp
+        movq    operatingsystem_parameter_envp@GOTPCREL(%rip),%rsi
+        movq    %rax,(%rsi)
 
 	/* Align the stack to a 16 byte boundary to follow the ABI.  */
 	andq  $~15, %rsp
@@ -60,18 +63,20 @@ _start:
 	pushq %rsp
 
 	/* Pass address of our own entry points to .fini and .init.  */
-	movq $_init_dummy, %r8
-	movq $_fini_dummy, %rcx
+        movq _init_dummy@GOTPCREL(%rip), %r8
+        movq _fini_dummy@GOTPCREL(%rip), %rcx
 
-	movq $main_stub, %rdi
+        movq main_stub@GOTPCREL(%rip), %rdi
 
 	/* Call the user's main function, and exit with its value.
 	   But let the libc call main.	  */
-	call __libc_start_main
+	call __libc_start_main@PLT
 
 	hlt			/* Crash if somehow `exit' does return.	 */
 
 /* fake main routine which will be run from libc */
+        .globl main_stub
+        .type main_stub,@function
 main_stub:
         /* save return address */
         popq    %rax
@@ -79,37 +84,56 @@ main_stub:
 	// stack alignment
         pushq   %rax
 
-        movq    %rax,___fpc_ret
-        movq    %rbp,___fpc_ret_rbp
+        movq    ___fpc_ret_rbp@GOTPCREL(%rip),%rcx
+        movq    %rbp,(%rcx)
+        movq    ___fpc_ret@GOTPCREL(%rip),%rcx
+        movq    %rax,(%rcx)
         pushq   %rax
 
 	/* Initialize gmon */
-        movq    $_etext,%rsi
-        movq    $_start,%rdi
-        call    monstartup
+        movq    _etext@GOTPCREL(%rip),%rsi
+        movq    _start@GOTPCREL(%rip),%rdi
+        call    monstartup@PLT
 
-        movq    $_mcleanup,%rdi
-        call    atexit
+        movq    _mcleanup@GOTPCREL(%rip),%rdi
+        call    atexit@PLT
 
         /* Save initial stackpointer */
-        movq    %rsp,__stkptr
+        movq    __stkptr@GOTPCREL(%rip),%rax
+        movq    %rsp,(%rax)
 
         /* start the program */
         xorq    %rbp,%rbp
-        call    PASCALMAIN
+        call    PASCALMAIN@PLT
         hlt
+        .size   main_stub,.-main_stub
 
         .globl _haltproc
         .type _haltproc,@function
 _haltproc:
-        movzwq    operatingsystem_result,%rax /* load and save exitcode */
-
-        movq    ___fpc_ret,%rdx         /* return to libc */
-        movq    ___fpc_ret_rbp,%rbp
+        movq    operatingsystem_result@GOTPCREL(%rip),%rax
+        movzwl  (%rax),%eax
+
+       /* return to libc */
+        movq    ___fpc_ret_rbp@GOTPCREL(%rip),%rcx
+        movq    (%rcx),%rbp
+        movq    ___fpc_ret@GOTPCREL(%rip),%rcx
+        movq    (%rcx),%rdx
         pushq    %rdx
+        ret
+        .size   _haltproc,.-_haltproc
+
+        .globl _init_dummy
+        .type   _init_dummy, @function
 _init_dummy:
+        ret
+        .size   _init_dummy,.-_init_dummy
+
+        .globl  _fini_dummy
+        .type   _fini_dummy, @function
 _fini_dummy:
         ret
+        .size   _fini_dummy,.-_fini_dummy
 
 /* Define a symbol for the first piece of initialized data.  */
 	.data

rtl/linux/x86_64/prt0.as

@@ -38,18 +38,22 @@
 	.globl _start
 	.type _start,@function
 _start:
-#       movq %rdx,%r9                 /* Address of the shared library termination
+#       movq    %rdx,%r9                 /* Address of the shared library termination
 #               	                 function.  */
-	popq     %rsi		      /* Pop the argument count.  */
-        movq     %rsi,operatingsystem_parameter_argc
-	movq     %rsp,operatingsystem_parameter_argv   /* argv starts just at the current stack top.  */
-        leaq     8(,%rsi,8),%rax
-        addq     %rsp,%rax
-        movq     %rax,operatingsystem_parameter_envp
-        andq     $~15,%rsp            /* Align the stack to a 16 byte boundary to follow the ABI.  */
+	popq    %rsi		      /* Pop the argument count.  */
+        movq 	operatingsystem_parameter_argc@GOTPCREL(%rip),%rax
+        movq    %rsi,(%rax)
+        movq 	operatingsystem_parameter_argv@GOTPCREL(%rip),%rax
+	movq    %rsp,(%rax)   /* argv starts just at the current stack top.  */
+        leaq    8(,%rsi,8),%rax
+        addq    %rsp,%rax
+        movq 	operatingsystem_parameter_envp@GOTPCREL(%rip),%rcx
+        movq    %rax,(%rcx)
+        andq    $~15,%rsp            /* Align the stack to a 16 byte boundary to follow the ABI.  */
 
         /* Save initial stackpointer */
-        movq    %rsp,__stkptr
+        movq 	__stkptr@GOTPCREL(%rip),%rax
+        movq    %rsp,(%rax)
 
         xorq    %rbp, %rbp
         call    PASCALMAIN
@@ -58,8 +62,9 @@ _start:
         .globl  _haltproc
         .type   _haltproc,@function
 _haltproc:
+        movq 	operatingsystem_result@GOTPCREL(%rip),%rax
+        movzwl  (%rax),%edi
         movl    $231,%eax                 /* exit_group call */
-        movzwl    operatingsystem_result,%edi
         syscall
         jmp     _haltproc
 

rtl/objpas/classes/action.inc

@@ -88,7 +88,7 @@ end;
 constructor TBasicAction.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FClients := TList.Create;
+  FClients := TFpList.Create;
 end;
 
 

rtl/objpas/classes/classes.inc

@@ -715,15 +715,15 @@ begin
 end;
 
 threadvar
-  GlobalLoaded, GlobalLists: TList;
+  GlobalLoaded, GlobalLists: TFpList;
 
 procedure BeginGlobalLoading;
 
 begin
   if not Assigned(GlobalLists) then
-    GlobalLists := TList.Create;
+    GlobalLists := TFpList.Create;
   GlobalLists.Add(GlobalLoaded);
-  GlobalLoaded := TList.Create;
+  GlobalLoaded := TFpList.Create;
 end;
 
 
@@ -741,7 +741,7 @@ procedure EndGlobalLoading;
 begin
   { Free the memory occupied by BeginGlobalLoading }
   GlobalLoaded.Free;
-  GlobalLoaded := TList(GlobalLists.Last);
+  GlobalLoaded := TFpList(GlobalLists.Last);
   GlobalLists.Delete(GlobalLists.Count - 1);
   if GlobalLists.Count = 0 then
   begin

rtl/objpas/classes/classesh.inc

@@ -469,7 +469,7 @@ type
   TCollection = class(TPersistent)
   private
     FItemClass: TCollectionItemClass;
-    FItems: TList;
+    FItems: TFpList;
     FUpdateCount: Integer;
     FNextID: Integer;
     FPropName: string;
@@ -1131,7 +1131,7 @@ type
     FOwner: TComponent;
     FParent: TComponent;
     FFixups: TObject;
-    FLoaded: TList;
+    FLoaded: TFpList;
     FOnFindMethod: TFindMethodEvent;
     FOnSetMethodProperty: TSetMethodPropertyEvent;
     FOnSetName: TSetNameEvent;
@@ -1574,8 +1574,8 @@ type
     FOwner: TComponent;
     FName: TComponentName;
     FTag: Longint;
-    FComponents: TList;
-    FFreeNotifies: TList;
+    FComponents: TFpList;
+    FFreeNotifies: TFpList;
     FDesignInfo: Longint;
     FVCLComObject: Pointer;
     FComponentState: TComponentState;
@@ -1707,7 +1707,7 @@ type
     FOnExecute: TNotifyEvent;
     FOnUpdate: TNotifyEvent;
   protected
-    FClients: TList;
+    FClients: TFpList;
     procedure Change; virtual;
     procedure SetOnExecute(Value: TNotifyEvent); virtual;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;

rtl/objpas/classes/collect.inc

@@ -292,7 +292,7 @@ constructor TCollection.Create(AItemClass: TCollectionItemClass);
 begin
   inherited create;
   FItemClass:=AItemClass;
-  FItems:=TList.Create;
+  FItems:=TFpList.Create;
 end;
 
 

rtl/objpas/classes/compon.inc

@@ -106,7 +106,7 @@ Procedure TComponent.Insert(AComponent: TComponent);
 
 begin
   If not assigned(FComponents) then
-    FComponents:=TList.Create;
+    FComponents:=TFpList.Create;
   FComponents.Add(AComponent);
   AComponent.FOwner:=Self;
 end;
@@ -561,7 +561,7 @@ begin
   else
     begin
     If not (Assigned(FFreeNotifies)) then
-      FFreeNotifies:=TList.Create;
+      FFreeNotifies:=TFpList.Create;
     If FFreeNotifies.IndexOf(AComponent)=-1 then
       begin
       FFreeNotifies.Add(AComponent);

rtl/objpas/classes/reader.inc

@@ -587,7 +587,7 @@ end;
 
 procedure TReader.BeginReferences;
 begin
-  FLoaded := TList.Create;
+  FLoaded := TFpList.Create;
 end;
 
 procedure TReader.CheckValue(Value: TValueType);
@@ -1423,7 +1423,7 @@ begin
       if Assigned(GlobalLoaded) then
         FLoaded := GlobalLoaded
       else
-        FLoaded := TList.Create;
+        FLoaded := TFpList.Create;
 
       try
         if FLoaded.IndexOf(FRoot) < 0 then

rtl/objpas/sysutils/dati.inc

@@ -428,7 +428,7 @@ begin
       begin
         inc(n);
         if n>3 then
-          begin 
+          begin
             FixErrorMsg(SInvalidDateFormat,s);
             exit;
           end;
@@ -705,7 +705,7 @@ Var
 
 begin
   Result:=IntStrToTime(Msg,S,Len,DefaultFormatSettings,Separator);
-  If (Msg<>'') then 
+  If (Msg<>'') then
     Raise EConvertError.Create(Msg);
 end;
 
@@ -813,6 +813,44 @@ var
   ResultLen: integer;
   ResultBuffer: array[0..255] of char;
   ResultCurrent: pchar;
+{$IFDEF MSWindows}
+  isEnable_E_Format : Boolean;
+  isEnable_G_Format : Boolean;
+  eastasiainited : boolean;
+{$ENDIF MSWindows}
+
+{$IFDEF MSWindows}
+  procedure InitEastAsia;
+  var     ALCID : LCID;
+         PriLangID , SubLangID : Word;
+
+  begin
+    ALCID := GetThreadLocale;
+    PriLangID := ALCID and $3FF;
+    if (PriLangID>0) then
+       SubLangID := (ALCID and $FFFF) shr 10
+      else
+        begin
+          PriLangID := SysLocale.PriLangID;
+          SubLangID := SysLocale.SubLangID;
+        end;
+    isEnable_E_Format := (PriLangID = LANG_JAPANESE)
+                  or
+                  (PriLangID = LANG_KOREAN)
+                  or
+                  ((PriLangID = LANG_CHINESE)
+                   and
+                   (SubLangID = SUBLANG_CHINESE_TRADITIONAL)
+                  );
+    isEnable_G_Format := (PriLangID = LANG_JAPANESE)
+                  or
+                  ((PriLangID = LANG_CHINESE)
+                   and
+                   (SubLangID = SUBLANG_CHINESE_TRADITIONAL)
+                  );
+    eastasiainited :=true;
+  end;
+{$ENDIF MSWindows}
 
   procedure StoreStr(Str: PChar; Len: Integer);
   begin
@@ -828,7 +866,7 @@ var
   var Len: integer;
   begin
    Len := Length(Str);
-   if ResultLen + Len < SizeOf(ResultBuffer) then 
+   if ResultLen + Len < SizeOf(ResultBuffer) then
      begin
        StrMove(ResultCurrent, pchar(Str), Len);
        ResultCurrent := ResultCurrent + Len;
@@ -855,6 +893,7 @@ var
 var
   Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
 
+
   procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
   var
     Token, lastformattoken: char;
@@ -868,6 +907,7 @@ var
   begin
     if Nesting > 1 then  // 0 is original string, 1 is included FormatString
       Exit;
+
     FormatCurrent := PChar(FormatStr);
     FormatEnd := FormatCurrent + Length(FormatStr);
     Clock12 := false;
@@ -966,7 +1006,7 @@ var
                   1: StoreInt(Month, 0);
                   2: StoreInt(Month, 2);
                   3: StoreString(FormatSettings.ShortMonthNames[Month]);
-                else  
+                else
                   StoreString(FormatSettings.LongMonthNames[Month]);
                 end;
               end;
@@ -978,7 +1018,7 @@ var
                 3: StoreString(FormatSettings.ShortDayNames[DayOfWeek]);
                 4: StoreString(FormatSettings.LongDayNames[DayOfWeek]);
                 5: StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
-              else  
+              else
                 StoreFormat(FormatSettings.LongDateFormat, Nesting+1, False);
               end ;
             end ;
@@ -986,32 +1026,32 @@ var
               begin
                 tmp := hour mod 12;
                 if tmp=0 then tmp:=12;
-                if Count = 1 then 
+                if Count = 1 then
                   StoreInt(tmp, 0)
-                else 
+                else
                   StoreInt(tmp, 2);
               end
               else begin
-                if Count = 1 then 
+                if Count = 1 then
 		  StoreInt(Hour, 0)
-                else 
+                else
                   StoreInt(Hour, 2);
               end;
-            'N': if Count = 1 then 
+            'N': if Count = 1 then
                    StoreInt(Minute, 0)
-                 else 
+                 else
                    StoreInt(Minute, 2);
-            'S': if Count = 1 then 
+            'S': if Count = 1 then
                    StoreInt(Second, 0)
-                 else 
+                 else
                    StoreInt(Second, 2);
-            'Z': if Count = 1 then 
+            'Z': if Count = 1 then
                    StoreInt(MilliSecond, 0)
-                 else 
+                 else
 		   StoreInt(MilliSecond, 3);
-            'T': if Count = 1 then 
+            'T': if Count = 1 then
 		   StoreFormat(FormatSettings.ShortTimeFormat, Nesting+1, True)
-                 else 
+                 else
 	           StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
             'C': begin
                    StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
@@ -1019,8 +1059,36 @@ var
                      begin
                       StoreString(' ');
                       StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
+                     end;
                  end;
-            end;
+{$IFDEF MSWindows}
+            'E':
+               begin
+                 if not Eastasiainited then InitEastAsia;
+                 if Not(isEnable_E_Format) then StoreStr(@FormatCurrent^, 1)
+                  else
+                   begin
+                     while (P < FormatEnd) and (UpCase(P^) = Token) do
+                     P := P + 1;
+                     Count := P - FormatCurrent;
+                     StoreString(ConvertEraYearString(Count,Year,Month,Day));
+                   end;
+                 lastformattoken:=token;
+               end;
+             'G':
+               begin
+                 if not Eastasiainited then InitEastAsia;
+                 if Not(isEnable_G_Format) then StoreStr(@FormatCurrent^, 1)
+                  else
+                   begin
+                     while (P < FormatEnd) and (UpCase(P^) = Token) do
+                     P := P + 1;
+                     Count := P - FormatCurrent;
+                     StoreString(ConvertEraString(Count,Year,Month,Day));
+                   end;
+                 lastformattoken:=token;
+               end;
+{$ENDIF MSWindows}
           end;
           lastformattoken := token;
         end;
@@ -1032,6 +1100,9 @@ var
   end;
 
 begin
+{$ifdef MSWindows}
+  eastasiainited:=false;
+{$endif MSWindows}
   DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
   DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
   ResultLen := 0;
@@ -1039,7 +1110,7 @@ begin
   if FormatStr <> '' then
     StoreFormat(FormatStr, 0, False)
   else
-    StoreFormat('C', 0, False);  
+    StoreFormat('C', 0, False);
   ResultBuffer[ResultLen] := #0;
   result := StrPas(@ResultBuffer[0]);
 end ;
@@ -1100,10 +1171,10 @@ end;
 
 function TryStrToDate(const S: ShortString; out Value: TDateTime;
                     const useformat : string; separator : char = #0): Boolean;
-                    
+
 Var
   Msg : Ansistring;
-                      
+
 begin
   Value:=IntStrToDate(Msg,@S[1],Length(S),useformat,defaultformatsettings,separator);
   Result:=(Msg='');
@@ -1111,10 +1182,10 @@ end;
 
 function TryStrToDate(const S: AnsiString; out Value: TDateTime;
                     const useformat : string; separator : char = #0): Boolean;
-                    
+
 Var
-  Msg : Ansistring;                    
-                    
+  Msg : Ansistring;
+
 begin
   Result:=Length(S)<>0;
   If Result then
@@ -1138,13 +1209,13 @@ end;
 function TryStrToDate(const S: AnsiString; out Value: TDateTime; separator : char): Boolean;
 
 begin
-  Result:=TryStrToDate(S,Value,ShortDateFormat,Separator);  
+  Result:=TryStrToDate(S,Value,ShortDateFormat,Separator);
 end;
 
 function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
 Var
-  Msg : Ansistring;                    
-                    
+  Msg : Ansistring;
+
 begin
   Result:=Length(S)<>0;
   If Result then

rtl/win/sysutils.pp

@@ -50,6 +50,13 @@ Var
   Win32BuildNumber   : dword;
   Win32CSDVersion    : ShortString;   // CSD record is 128 bytes only?
 
+const
+  MaxEraCount = 7;
+
+var
+  EraNames: array [1..MaxEraCount] of String;
+  EraYearOffsets: array [1..MaxEraCount] of Integer;
+
 { Compatibility with Delphi }
 function Win32Check(res:boolean):boolean;inline;
 function WinCheck(res:boolean):boolean;
@@ -143,6 +150,9 @@ function GetFileVersion(const AFileName:string):Cardinal;
 {$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
 {$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
 
+
+function ConvertEraYearString(Count ,Year,Month,Day : integer) : string; forward;
+function ConvertEraString(Count ,Year,Month,Day : integer) : string; forward;
 { Include platform independent implementation part }
 {$i sysutils.inc}
 
@@ -639,6 +649,72 @@ begin
     Result := Def;
 end;
 
+function ConvertEraString(Count ,Year,Month,Day : integer) : string;
+  var
+    ASystemTime: TSystemTime;
+    buf: array[0..100] of char;
+    ALCID : LCID;
+    PriLangID : Word;
+    SubLangID : Word;
+begin
+  Result := ''; if (Count<=0) then exit;
+  DateTimeToSystemTime(EncodeDate(Year,Month,Day),ASystemTime);
+
+  ALCID := GetThreadLocale;
+//  ALCID := SysLocale.DefaultLCID;
+  if GetDateFormat(ALCID , DATE_USE_ALT_CALENDAR
+      , @ASystemTime, PChar('gg')
+      , @buf, SizeOf(buf)) > 0 then
+  begin
+    Result := buf;
+    if Count = 1 then
+    begin
+      PriLangID := ALCID and $3FF;
+      SubLangID := (ALCID and $FFFF) shr 10;
+      case PriLangID of
+        LANG_JAPANESE:
+          begin
+            Result := Copy(WideString(Result),1,1);
+          end;
+        LANG_CHINESE:
+          if (SubLangID = SUBLANG_CHINESE_TRADITIONAL) then
+          begin
+            Result := Copy(WideString(Result),1,1);
+          end;
+      end;
+    end;
+  end;
+// if Result = '' then Result := StringOfChar('G',Count);
+end;
+
+function ConvertEraYearString(Count ,Year,Month,Day : integer) : string;
+  var
+    ALCID : LCID;
+    ASystemTime : TSystemTime;
+    AFormatText : string;
+    buf : array[0..100] of Char;
+begin
+  Result := '';
+  DateTimeToSystemTime(EncodeDate(Year,Month,Day),ASystemTime);
+
+  if Count <= 2 then
+    AFormatText := 'yy'
+  else
+    AFormatText := 'yyyy';
+
+  ALCID := GetThreadLocale;
+//  ALCID := SysLocale.DefaultLCID;
+
+  if GetDateFormat(ALCID, DATE_USE_ALT_CALENDAR
+      , @ASystemTime, PChar(AFormatText)
+      , @buf, SizeOf(buf)) > 0 then
+  begin
+    Result := buf;
+    if (Count = 1) and (Result[1] = '0') then
+      Result := Copy(Result, 2, Length(Result)-1);
+  end;
+end;
+
 
 Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
 Var
@@ -651,6 +727,70 @@ Begin
     Result:=Def;
 End;
 
+function EnumEraNames(Names: PChar): WINBOOL; stdcall;
+var
+  i : integer;
+begin
+  Result := False;
+  for i := Low(EraNames) to High(EraNames) do
+   if (EraNames[i] = '') then
+   begin
+     EraNames[i] := Names;
+     Result := True;
+     break;
+   end;
+end;
+
+function EnumEraYearOffsets(YearOffsets: PChar): WINBOOL; stdcall;
+var
+  i : integer;
+begin
+  Result := False;
+  for i := Low(EraYearOffsets) to High(EraYearOffsets) do
+   if (EraYearOffsets[i] = -1) then
+   begin
+     EraYearOffsets[i] := StrToIntDef(YearOffsets, 0);
+     Result := True;
+     break;
+   end;
+end;
+
+procedure GetEraNamesAndYearOffsets;
+  var
+    ACALID : CALID;
+    ALCID : LCID;
+    buf : array[0..10] of char;
+    i : integer;
+begin
+  for i:= 1 to MaxEraCount do
+   begin
+     EraNames[i] := '';  EraYearOffsets[i] := -1;
+   end;
+  ALCID := GetThreadLocale;
+  if GetLocaleInfo(ALCID , LOCALE_IOPTIONALCALENDAR, buf, sizeof(buf)) <= 0 then exit;
+  ACALID := StrToIntDef(buf,1);
+
+  if ACALID in [3..5] then
+  begin
+    EnumCalendarInfoA(@EnumEraNames, ALCID, ACALID , CAL_SERASTRING);
+    EnumCalendarInfoA(@EnumEraYearOffsets, ALCID, ACALID, CAL_IYEAROFFSETRANGE);
+  end;
+(*
+1 CAL_GREGORIAN Gregorian (localized)
+2 CAL_GREGORIAN_US Gregorian (English strings always)
+3 CAL_JAPAN Japanese Emperor Era
+4 CAL_TAIWAN Taiwan Calendar
+5 CAL_KOREA Korean Tangun Era
+6 CAL_HIJRI Hijri (Arabic Lunar)
+7 CAL_THAI Thai
+8 CAL_HEBREW Hebrew (Lunar)
+9 CAL_GREGORIAN_ME_FRENCH Gregorian Middle East French
+10 CAL_GREGORIAN_ARABIC Gregorian Arabic
+11 CAL_GREGORIAN_XLIT_ENGLISH Gregorian transliterated English
+12 CAL_GREGORIAN_XLIT_FRENCH Gregorian transliterated French
+23 CAL_UMALQURA Windows Vista or later: Um Al Qura (Arabic lunar) calendar
+*)
+end;
 
 procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); 
 var
@@ -744,6 +884,7 @@ begin
 
   Set8087CW(old8087CW);
   GetFormatSettings;
+  if SysLocale.FarEast then GetEraNamesAndYearOffsets;
 end;
 
 

rtl/win/syswin.inc

@@ -82,6 +82,8 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
        DLL_PROCESS_DETACH :
          begin
            Dll_entry:=true; { return value is ignored }
+		   if MainThreadIDWin32=0 then // already been here.
+		     exit;
            If SetJmp(DLLBuf) = 0 then
              FPC_Do_Exit;
            if assigned(Dll_Process_Detach_Hook) then
@@ -91,6 +93,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
            { Free TLS resources used by ThreadVars }
            SysFiniMultiThreading;
            WinDoneCriticalSection(AttachingThread);
+		   MainThreadIDWin32:=0;
          end;
      end;
   end;

tests/webtbs/tw17236.pp

@@ -0,0 +1,10 @@
+{ %target=linux,darwin,freebsd,netbsd,openbsd,sunos,beos,haiku }
+{ %cpu=x86_64,powerpc64,mips64,sparc64,ia64,alpha }
+
+{ windows does not support statics > 2GB }
+var
+  i : longint;
+  a : array[0..1500000000] of longint;
+begin
+  writeln(a[i]);
+end.

utils/h2pas/h2pas.pas

@@ -248,7 +248,6 @@ program h2pas;
       end;
 
 
-
     function TypeName(const s:string):string;
       var
         i : longint;
@@ -624,6 +623,7 @@ program h2pas;
        (* if in args *dname is replaced by pdname *)
        in_args : boolean = false;
        typedef_level : longint = 0;
+       old_in_args : boolean = false;
 
     (* writes an argument list, where p is t_arglist *)
 
@@ -756,7 +756,7 @@ program h2pas;
          error : integer;
          pointerwritten,
          constant : boolean;
-
+         old_in_args : boolean;
       begin
          if not(assigned(p)) then
            begin
@@ -764,109 +764,116 @@ program h2pas;
               exit;
            end;
          case p^.typ of
-            t_pointerdef : begin
-                              (* procedure variable ? *)
-                              if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
-                                begin
-                                   is_procvar:=true;
-                                   (* distinguish between procedure and function *)
-                                   if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
-                                     begin
-                                        write(outfile,'procedure ');
-
-                                        shift(10);
-                                        (* write arguments *)
-                                        if assigned(p^.p1^.p2) then
-                                          write_args(outfile,p^.p1^.p2);
-                                        flush(outfile);
-                                        popshift;
-                                     end
-                                   else
-                                     begin
-                                        write(outfile,'function ');
-                                        shift(9);
-                                        (* write arguments *)
-                                        if assigned(p^.p1^.p2) then
-                                          write_args(outfile,p^.p1^.p2);
-                                        write(outfile,':');
-                                        flush(outfile);
-                                        write_p_a_def(outfile,p^.p1^.p1,simple_type);
-                                        popshift;
-                                     end
-                                end
-                              else
-                                begin
-                                   (* generate "pointer" ? *)
-                                   if (simple_type^.typ=t_void) and (p^.p1=nil) then
-                                     begin
-                                       write(outfile,'pointer');
-                                       flush(outfile);
-                                     end
-                                   else
-                                     begin
-                                       pointerwritten:=false;
-                                       if (p^.p1=nil) and UsePPointers then
-                                        begin
-                                          if (simple_type^.typ=t_id) then
-                                           begin
-                                             write(outfile,PointerName(simple_type^.p));
-                                             pointerwritten:=true;
-                                           end
-                                          { structure }
-                                          else if (simple_type^.typ in [t_uniondef,t_structdef]) and
-                                                  (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
-                                           begin
-                                             write(outfile,PointerName(simple_type^.p2^.p));
-                                             pointerwritten:=true;
-                                           end;
-                                        end;
-                                      if not pointerwritten then
-                                       begin
-                                         if in_args then
-                                         begin
-                                          write(outfile,'P');
-                                          pointerprefix:=true;
-                                         end
-                                         else
-                                          write(outfile,'^');
-                                         write_p_a_def(outfile,p^.p1,simple_type);
-                                         pointerprefix:=false;
-                                       end;
-                                     end;
-                                end;
-                           end;
-            t_arraydef : begin
-                             constant:=false;
-                             if assigned(p^.p2) then
-                              begin
-                                if p^.p2^.typ=t_id then
-                                 begin
-                                   val(p^.p2^.str,i,error);
-                                   if error=0 then
-                                    begin
-                                      dec(i);
-                                      constant:=true;
-                                    end;
-                                 end;
-                                if not constant then
-                                 begin
-                                   write(outfile,'array[0..(');
-                                   write_expr(outfile,p^.p2);
-                                   write(outfile,')-1] of ');
-                                 end
-                                else
-                                 begin
-                                   write(outfile,'array[0..',i,'] of ');
-                                 end;
-                              end
-                             else
-                              begin
-                                (* open array *)
-                                write(outfile,'array of ');
-                              end;
-                             flush(outfile);
-                             write_p_a_def(outfile,p^.p1,simple_type);
+            t_pointerdef :
+              begin
+                (* procedure variable ? *)
+                if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
+                  begin
+                     is_procvar:=true;
+                     (* distinguish between procedure and function *)
+                     if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
+                       begin
+                          write(outfile,'procedure ');
+
+                          shift(10);
+                          (* write arguments *)
+                          if assigned(p^.p1^.p2) then
+                            write_args(outfile,p^.p1^.p2);
+                          flush(outfile);
+                          popshift;
+                       end
+                     else
+                       begin
+                          write(outfile,'function ');
+                          shift(9);
+                          (* write arguments *)
+                          if assigned(p^.p1^.p2) then
+                            write_args(outfile,p^.p1^.p2);
+                          write(outfile,':');
+                          flush(outfile);
+
+                          old_in_args:=in_args;
+                          (* write pointers as P.... instead of ^.... *)
+                          in_args:=true;
+                          write_p_a_def(outfile,p^.p1^.p1,simple_type);
+                          in_args:=old_in_args;
+                          popshift;
+                       end
+                  end
+                else
+                  begin
+                     (* generate "pointer" ? *)
+                     if (simple_type^.typ=t_void) and (p^.p1=nil) then
+                       begin
+                         write(outfile,'pointer');
+                         flush(outfile);
+                       end
+                     else
+                       begin
+                         pointerwritten:=false;
+                         if (p^.p1=nil) and UsePPointers then
+                          begin
+                            if (simple_type^.typ=t_id) then
+                             begin
+                               write(outfile,PointerName(simple_type^.p));
+                               pointerwritten:=true;
+                             end
+                            { structure }
+                            else if (simple_type^.typ in [t_uniondef,t_structdef]) and
+                                    (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
+                             begin
+                               write(outfile,PointerName(simple_type^.p2^.p));
+                               pointerwritten:=true;
+                             end;
                           end;
+                        if not pointerwritten then
+                         begin
+                           if in_args then
+                           begin
+                            write(outfile,'P');
+                            pointerprefix:=true;
+                           end
+                           else
+                            write(outfile,'^');
+                           write_p_a_def(outfile,p^.p1,simple_type);
+                           pointerprefix:=false;
+                         end;
+                       end;
+                  end;
+              end;
+            t_arraydef :
+              begin
+                constant:=false;
+                if assigned(p^.p2) then
+                 begin
+                   if p^.p2^.typ=t_id then
+                    begin
+                      val(p^.p2^.str,i,error);
+                      if error=0 then
+                       begin
+                         dec(i);
+                         constant:=true;
+                       end;
+                    end;
+                   if not constant then
+                    begin
+                      write(outfile,'array[0..(');
+                      write_expr(outfile,p^.p2);
+                      write(outfile,')-1] of ');
+                    end
+                   else
+                    begin
+                      write(outfile,'array[0..',i,'] of ');
+                    end;
+                 end
+                else
+                 begin
+                   (* open array *)
+                   write(outfile,'array of ');
+                 end;
+                flush(outfile);
+                write_p_a_def(outfile,p^.p1,simple_type);
+              end;
             else internalerror(1);
          end;
       end;
@@ -933,10 +940,10 @@ program h2pas;
                   begin
                     if in_args then
                     begin
-                      if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
-                        write(outfile,'P')
+                      if UseCTypesUnit and IsACType(p^.p1^.p) then
+                        write(outfile,'p')
                       else
-                        write(outfile,'p');
+                        write(outfile,'P');
                       pointerprefix:=true;
                     end
                     else
@@ -1145,10 +1152,7 @@ program h2pas;
                                      if is_procvar then
                                        begin
                                           if not no_pop then
-                                            begin
-                                               write(outfile,';cdecl');
-                                               no_pop:=true;
-                                            end;
+                                            write(outfile,';cdecl');
                                           is_procvar:=false;
                                        end;
                                      writeln(outfile,';');
@@ -1283,6 +1287,7 @@ program h2pas;
         writeln(outfile,aktspace,'end;');
       end;
 
+
 const _WHILE = 257;
 const _FOR = 258;
 const _DO = 259;
@@ -1559,7 +1564,11 @@ begin
          if assigned(yyv[yysp-1]^.p1^.p1^.p2) then
          write_args(outfile,yyv[yysp-1]^.p1^.p1^.p2);
          write(outfile,':');
+         old_in_args:=in_args;
+         (* write pointers as P.... instead of ^.... *)
+         in_args:=true;
          write_p_a_def(outfile,yyv[yysp-1]^.p1^.p1^.p1,yyv[yysp-3]);
+         in_args:=old_in_args;
          if createdynlib then
          begin
          loaddynlibproc.add('pointer('+yyv[yysp-1]^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+yyv[yysp-1]^.p1^.p2^.p+''');');
@@ -1571,7 +1580,12 @@ begin
          if assigned(yyv[yysp-1]^.p1^.p1^.p2) then
          write_args(implemfile,yyv[yysp-1]^.p1^.p1^.p2);
          write(implemfile,':');
+         
+         old_in_args:=in_args;
+         (* write pointers as P.... instead of ^.... *)
+         in_args:=true;
          write_p_a_def(implemfile,yyv[yysp-1]^.p1^.p1^.p1,yyv[yysp-3]);
+         in_args:=old_in_args;
          end;
          end;
          (* No CDECL in interface for Uselib *)
@@ -1754,7 +1768,12 @@ begin
          if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
          write_args(implemfile,yyv[yysp-2]^.p1^.p1^.p2);
          write(implemfile,':');
+         
+         old_in_args:=in_args;
+         (* write pointers as P.... instead of ^.... *)
+         in_args:=true;
          write_p_a_def(implemfile,yyv[yysp-2]^.p1^.p1^.p1,yyv[yysp-4]);
+         in_args:=old_in_args;
          end;
          end;
          if assigned(yyv[yysp-1]) then
@@ -2762,7 +2781,7 @@ begin
          yyval:=hp;
          while assigned(hp^.p1) do
          hp:=hp^.p1;
-         hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
+         hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
          
        end;
  109 : begin
@@ -2838,7 +2857,7 @@ begin
          yyval:=hp;
          while assigned(hp^.p1) do
          hp:=hp^.p1;
-         hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
+         hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
          
        end;
  119 : begin

utils/h2pas/h2pas.y

@@ -244,7 +244,6 @@ program h2pas;
       end;
 
 
-
     function TypeName(const s:string):string;
       var
         i : longint;
@@ -620,6 +619,7 @@ program h2pas;
        (* if in args *dname is replaced by pdname *)
        in_args : boolean = false;
        typedef_level : longint = 0;
+       old_in_args : boolean = false;
 
     (* writes an argument list, where p is t_arglist *)
 
@@ -752,7 +752,7 @@ program h2pas;
          error : integer;
          pointerwritten,
          constant : boolean;
-
+         old_in_args : boolean;
       begin
          if not(assigned(p)) then
            begin
@@ -760,109 +760,116 @@ program h2pas;
               exit;
            end;
          case p^.typ of
-            t_pointerdef : begin
-                              (* procedure variable ? *)
-                              if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
-                                begin
-                                   is_procvar:=true;
-                                   (* distinguish between procedure and function *)
-                                   if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
-                                     begin
-                                        write(outfile,'procedure ');
-
-                                        shift(10);
-                                        (* write arguments *)
-                                        if assigned(p^.p1^.p2) then
-                                          write_args(outfile,p^.p1^.p2);
-                                        flush(outfile);
-                                        popshift;
-                                     end
-                                   else
-                                     begin
-                                        write(outfile,'function ');
-                                        shift(9);
-                                        (* write arguments *)
-                                        if assigned(p^.p1^.p2) then
-                                          write_args(outfile,p^.p1^.p2);
-                                        write(outfile,':');
-                                        flush(outfile);
-                                        write_p_a_def(outfile,p^.p1^.p1,simple_type);
-                                        popshift;
-                                     end
-                                end
-                              else
-                                begin
-                                   (* generate "pointer" ? *)
-                                   if (simple_type^.typ=t_void) and (p^.p1=nil) then
-                                     begin
-                                       write(outfile,'pointer');
-                                       flush(outfile);
-                                     end
-                                   else
-                                     begin
-                                       pointerwritten:=false;
-                                       if (p^.p1=nil) and UsePPointers then
-                                        begin
-                                          if (simple_type^.typ=t_id) then
-                                           begin
-                                             write(outfile,PointerName(simple_type^.p));
-                                             pointerwritten:=true;
-                                           end
-                                          { structure }
-                                          else if (simple_type^.typ in [t_uniondef,t_structdef]) and
-                                                  (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
-                                           begin
-                                             write(outfile,PointerName(simple_type^.p2^.p));
-                                             pointerwritten:=true;
-                                           end;
-                                        end;
-                                      if not pointerwritten then
-                                       begin
-                                         if in_args then
-                                         begin
-                                          write(outfile,'P');
-                                          pointerprefix:=true;
-                                         end
-                                         else
-                                          write(outfile,'^');
-                                         write_p_a_def(outfile,p^.p1,simple_type);
-                                         pointerprefix:=false;
-                                       end;
-                                     end;
-                                end;
-                           end;
-            t_arraydef : begin
-                             constant:=false;
-                             if assigned(p^.p2) then
-                              begin
-                                if p^.p2^.typ=t_id then
-                                 begin
-                                   val(p^.p2^.str,i,error);
-                                   if error=0 then
-                                    begin
-                                      dec(i);
-                                      constant:=true;
-                                    end;
-                                 end;
-                                if not constant then
-                                 begin
-                                   write(outfile,'array[0..(');
-                                   write_expr(outfile,p^.p2);
-                                   write(outfile,')-1] of ');
-                                 end
-                                else
-                                 begin
-                                   write(outfile,'array[0..',i,'] of ');
-                                 end;
-                              end
-                             else
-                              begin
-                                (* open array *)
-                                write(outfile,'array of ');
-                              end;
-                             flush(outfile);
-                             write_p_a_def(outfile,p^.p1,simple_type);
+            t_pointerdef :
+              begin
+                (* procedure variable ? *)
+                if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
+                  begin
+                     is_procvar:=true;
+                     (* distinguish between procedure and function *)
+                     if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
+                       begin
+                          write(outfile,'procedure ');
+
+                          shift(10);
+                          (* write arguments *)
+                          if assigned(p^.p1^.p2) then
+                            write_args(outfile,p^.p1^.p2);
+                          flush(outfile);
+                          popshift;
+                       end
+                     else
+                       begin
+                          write(outfile,'function ');
+                          shift(9);
+                          (* write arguments *)
+                          if assigned(p^.p1^.p2) then
+                            write_args(outfile,p^.p1^.p2);
+                          write(outfile,':');
+                          flush(outfile);
+
+                          old_in_args:=in_args;
+                          (* write pointers as P.... instead of ^.... *)
+                          in_args:=true;
+                          write_p_a_def(outfile,p^.p1^.p1,simple_type);
+                          in_args:=old_in_args;
+                          popshift;
+                       end
+                  end
+                else
+                  begin
+                     (* generate "pointer" ? *)
+                     if (simple_type^.typ=t_void) and (p^.p1=nil) then
+                       begin
+                         write(outfile,'pointer');
+                         flush(outfile);
+                       end
+                     else
+                       begin
+                         pointerwritten:=false;
+                         if (p^.p1=nil) and UsePPointers then
+                          begin
+                            if (simple_type^.typ=t_id) then
+                             begin
+                               write(outfile,PointerName(simple_type^.p));
+                               pointerwritten:=true;
+                             end
+                            { structure }
+                            else if (simple_type^.typ in [t_uniondef,t_structdef]) and
+                                    (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
+                             begin
+                               write(outfile,PointerName(simple_type^.p2^.p));
+                               pointerwritten:=true;
+                             end;
                           end;
+                        if not pointerwritten then
+                         begin
+                           if in_args then
+                           begin
+                            write(outfile,'P');
+                            pointerprefix:=true;
+                           end
+                           else
+                            write(outfile,'^');
+                           write_p_a_def(outfile,p^.p1,simple_type);
+                           pointerprefix:=false;
+                         end;
+                       end;
+                  end;
+              end;
+            t_arraydef :
+              begin
+                constant:=false;
+                if assigned(p^.p2) then
+                 begin
+                   if p^.p2^.typ=t_id then
+                    begin
+                      val(p^.p2^.str,i,error);
+                      if error=0 then
+                       begin
+                         dec(i);
+                         constant:=true;
+                       end;
+                    end;
+                   if not constant then
+                    begin
+                      write(outfile,'array[0..(');
+                      write_expr(outfile,p^.p2);
+                      write(outfile,')-1] of ');
+                    end
+                   else
+                    begin
+                      write(outfile,'array[0..',i,'] of ');
+                    end;
+                 end
+                else
+                 begin
+                   (* open array *)
+                   write(outfile,'array of ');
+                 end;
+                flush(outfile);
+                write_p_a_def(outfile,p^.p1,simple_type);
+              end;
             else internalerror(1);
          end;
       end;
@@ -929,10 +936,10 @@ program h2pas;
                   begin
                     if in_args then
                     begin
-                      if UseCTypesUnit and (IsACType(p^.p1^.p)=False) then
-                        write(outfile,'P')
+                      if UseCTypesUnit and IsACType(p^.p1^.p) then
+                        write(outfile,'p')
                       else
-                        write(outfile,'p');
+                        write(outfile,'P');
                       pointerprefix:=true;
                     end
                     else
@@ -1141,10 +1148,7 @@ program h2pas;
                                      if is_procvar then
                                        begin
                                           if not no_pop then
-                                            begin
-                                               write(outfile,';cdecl');
-                                               no_pop:=true;
-                                            end;
+                                            write(outfile,';cdecl');
                                           is_procvar:=false;
                                        end;
                                      writeln(outfile,';');
@@ -1279,6 +1283,7 @@ program h2pas;
         writeln(outfile,aktspace,'end;');
       end;
 
+
 %}
 
 %token _WHILE _FOR _DO _GOTO _CONTINUE _BREAK
@@ -1481,7 +1486,11 @@ declaration :
                   if assigned($4^.p1^.p1^.p2) then
                     write_args(outfile,$4^.p1^.p1^.p2);
                   write(outfile,':');
+                  old_in_args:=in_args;
+                  (* write pointers as P.... instead of ^.... *)
+                  in_args:=true;
                   write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
+                  in_args:=old_in_args;
                   if createdynlib then
                     begin
                       loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
@@ -1491,9 +1500,14 @@ declaration :
                    begin
                      write(implemfile,'function ',$4^.p1^.p2^.p);
                      if assigned($4^.p1^.p1^.p2) then
-                      write_args(implemfile,$4^.p1^.p1^.p2);
+                       write_args(implemfile,$4^.p1^.p1^.p2);
                      write(implemfile,':');
+
+                     old_in_args:=in_args;
+                     (* write pointers as P.... instead of ^.... *)
+                     in_args:=true;
                      write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
+                     in_args:=old_in_args;
                    end;
                end;
              (* No CDECL in interface for Uselib *)
@@ -1675,7 +1689,12 @@ declaration :
                      if assigned($4^.p1^.p1^.p2) then
                       write_args(implemfile,$4^.p1^.p1^.p2);
                      write(implemfile,':');
+
+                     old_in_args:=in_args;
+                     (* write pointers as P.... instead of ^.... *)
+                     in_args:=true;
                      write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
+                     in_args:=old_in_args;
                    end;
                end;
              if assigned($5) then
@@ -2639,7 +2658,7 @@ declarator :
        $$:=hp;
        while assigned(hp^.p1) do
          hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
+       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
      } |
      LKLAMMER declarator RKLAMMER
      {
@@ -2707,7 +2726,7 @@ abstract_declarator :
        $$:=hp;
        while assigned(hp^.p1) do
          hp:=hp^.p1;
-       hp^.p1:=new(presobject,init_two(t_arraydef,nil,nil));
+       hp^.p1:=new(presobject,init_one(t_pointerdef,nil));
      } |
      LKLAMMER abstract_declarator RKLAMMER
      {

utils/h2pas/testit.h

@@ -88,3 +88,12 @@ void   gdk_gc_set_dashes          (GdkGC            *gc,
                                    gint              dash_offset,
                                    gint8             dash_list[],
                                    gint              n);
+
+typedef struct FnTable {
+  int (*Fn1)( void );
+  int (*Fn2)( void );
+  int (*Fn3)( void );
+} FnTable;
+
+
+void f(int a, char* p[]);