Browse Source

* synchronised with trunk till r41976

git-svn-id: branches/debug_eh@41977 -
Jonas Maebe 6 years ago
parent
commit
3a1fb45315
58 changed files with 1486 additions and 410 deletions
  1. 1 0
      .gitattributes
  2. 0 108
      compiler/aasmbase.pas
  3. 10 12
      compiler/aasmcnst.pas
  4. 37 0
      compiler/avr/aoptcpu.pas
  5. 90 0
      compiler/cutils.pas
  6. 2 2
      compiler/entfile.pas
  7. 1 1
      compiler/llvm/llvmtype.pas
  8. 6 9
      compiler/llvm/nllvmtcon.pas
  9. 8 9
      packages/amunits/src/coreunits/agraphics.pas
  10. 1 1
      packages/amunits/src/coreunits/clipboard.pas
  11. 4 4
      packages/amunits/src/coreunits/intuition.pas
  12. 13 13
      packages/arosunits/src/agraphics.pas
  13. 2 43
      packages/arosunits/src/amigados.pas
  14. 1 1
      packages/arosunits/src/datatypes.pas
  15. 4 4
      packages/arosunits/src/intuition.pas
  16. 0 1
      packages/arosunits/src/locale.pas
  17. 0 1
      packages/arosunits/src/serial.pas
  18. 6 4
      packages/arosunits/src/workbench.pas
  19. 6 9
      packages/fcl-db/src/sqldb/odbc/odbcconn.pas
  20. 14 10
      packages/fcl-registry/src/winreg.inc
  21. 2 2
      packages/fcl-web/src/base/restbase.pp
  22. 30 0
      packages/fpmkunit/src/fpmkunit.pp
  23. 29 7
      packages/morphunits/src/agraphics.pas
  24. 2 2
      packages/morphunits/src/amigados.pas
  25. 7 0
      packages/morphunits/src/datatypes.pas
  26. 2 2
      packages/morphunits/src/exec.pas
  27. 1 3
      packages/morphunits/src/intuition.pas
  28. 2 2
      packages/morphunits/src/utility.pas
  29. 258 0
      packages/rtl-objpas/src/inc/dateutil.inc
  30. 53 0
      rtl/bsd/ostypes.inc
  31. 2 8
      rtl/embedded/Makefile
  32. 7 8
      rtl/embedded/Makefile.fpc
  33. 3 7
      rtl/freebsd/ptypes.inc
  34. 2 1
      rtl/inc/dos.inc
  35. 2 1
      rtl/inc/fexpand.inc
  36. 2 1
      rtl/inc/ustrings.inc
  37. 62 17
      rtl/linux/i386/sysnr.inc
  38. 1 0
      rtl/linux/powerpc/stat.inc
  39. 77 8
      rtl/linux/powerpc/sysnr.inc
  40. 4 2
      rtl/linux/ptypes.inc
  41. 49 1
      rtl/linux/x86_64/sysnr.inc
  42. 2 1
      rtl/objpas/classes/streams.inc
  43. 3 3
      rtl/objpas/fgl.pp
  44. 45 1
      rtl/objpas/sysutils/sysencoding.inc
  45. 3 0
      rtl/objpas/sysutils/sysencodingh.inc
  46. 6 3
      rtl/openbsd/ptypes.inc
  47. 60 0
      rtl/openbsd/t_openbsd.h2paschk
  48. 322 37
      rtl/unix/scripts/check_sys.sh
  49. 1 0
      rtl/win/wininc/ascdef.inc
  50. 1 0
      rtl/win/wininc/ascfun.inc
  51. 3 3
      rtl/win/wininc/defines.inc
  52. 6 1
      rtl/win/wininc/func.inc
  53. 16 16
      rtl/win/wininc/messages.inc
  54. 1 0
      rtl/win/wininc/unidef.inc
  55. 1 0
      rtl/win/wininc/unifun.inc
  56. 29 0
      tests/tbs/tb0657.pp
  57. 4 1
      tests/utils/testsuite/utests.pp
  58. 180 40
      utils/h2pas/h2paschk.pas

+ 1 - 0
.gitattributes

@@ -11838,6 +11838,7 @@ tests/tbs/tb0653.pp svneol=native#text/plain
 tests/tbs/tb0654.pp svneol=native#text/plain
 tests/tbs/tb0655.pp svneol=native#text/pascal
 tests/tbs/tb0656.pp svneol=native#text/pascal
+tests/tbs/tb0657.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain

+ 0 - 108
compiler/aasmbase.pas

@@ -232,11 +232,6 @@ interface
     function create_smartlink_library:boolean;inline;
     function create_smartlink:boolean;inline;
 
-    function LengthUleb128(a: qword) : byte;
-    function LengthSleb128(a: int64) : byte;
-    function EncodeUleb128(a: qword;out buf) : byte;
-    function EncodeSleb128(a: int64;out buf) : byte;
-
     function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
 
     { dummy default noop callback }
@@ -285,109 +280,6 @@ implementation
       end;
 
 
-    function LengthUleb128(a: qword) : byte;
-      begin
-        result:=0;
-        repeat
-          a := a shr 7;
-          inc(result);
-          if a=0 then
-            break;
-        until false;
-      end;
-
-
-    function LengthSleb128(a: int64) : byte;
-      var
-        b, size: byte;
-        asign : int64;
-        neg, more: boolean;
-      begin
-        more := true;
-        neg := a < 0;
-        size := sizeof(a)*8;
-        result:=0;
-        repeat
-          b := a and $7f;
-          a := a shr 7;
-          if neg then
-            begin
-              { Use a variable to be sure that the correct or mask is generated }
-              asign:=1;
-              asign:=asign shl (size - 7);
-              a := a or -asign;
-            end;
-          if (((a = 0) and
-               (b and $40 = 0)) or
-              ((a = -1) and
-               (b and $40 <> 0))) then
-            more := false;
-          inc(result);
-          if not(more) then
-            break;
-        until false;
-      end;
-
-
-    function EncodeUleb128(a: qword;out buf) : byte;
-      var
-        b: byte;
-        pbuf : pbyte;
-      begin
-        result:=0;
-        pbuf:=@buf;
-        repeat
-          b := a and $7f;
-          a := a shr 7;
-          if a<>0 then
-            b := b or $80;
-          pbuf^:=b;
-          inc(pbuf);
-          inc(result);
-          if a=0 then
-            break;
-        until false;
-      end;
-
-
-    function EncodeSleb128(a: int64;out buf) : byte;
-      var
-        b, size: byte;
-        asign : int64;
-        neg, more: boolean;
-        pbuf : pbyte;
-      begin
-        more := true;
-        neg := a < 0;
-        size := sizeof(a)*8;
-        result:=0;
-        pbuf:=@buf;
-        repeat
-          b := a and $7f;
-          a := a shr 7;
-          if neg then
-            begin
-              { Use a variable to be sure that the correct or mask is generated }
-              asign:=1;
-              asign:=asign shl (size - 7);
-              a := a or -asign;
-            end;
-          if (((a = 0) and
-               (b and $40 = 0)) or
-              ((a = -1) and
-               (b and $40 <> 0))) then
-            more := false
-          else
-            b := b or $80;
-          pbuf^:=b;
-          inc(pbuf);
-          inc(result);
-          if not(more) then
-            break;
-        until false;
-      end;
-
-
     function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
       var
         i : longint;

+ 10 - 12
compiler/aasmcnst.pas

@@ -57,7 +57,7 @@ type
     protected
      fval: tai;
     public
-     constructor create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
+     constructor create(_def: tdef; _val: tai);
      destructor destroy; override;
      property val: tai read fval write setval;
    end;
@@ -70,7 +70,7 @@ type
      { iterator to walk over all individual items in the aggregate }
      tadeenumerator = class(tobject)
       private
-       fvalues: tfplist;
+       fvalues: tfpobjectlist;
        fvaluespos: longint;
        function getcurrent: tai_abstracttypedconst;
       public
@@ -81,7 +81,7 @@ type
      end;
 
     protected
-     fvalues: tfplist;
+     fvalues: tfpobjectlist;
      fisstring: boolean;
 
      { converts the existing data to a single tai_string }
@@ -93,7 +93,7 @@ type
      procedure addvalue(val: tai_abstracttypedconst);
      function valuecount: longint;
      procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
-     function replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
+     procedure replacevalueatpos(val: tai_abstracttypedconst; pos: longint);
      { change the type to a record, regardless of how the aggregate was created;
        the size of the original type and the record must match }
      procedure changetorecord(_def: trecorddef);
@@ -640,9 +640,9 @@ implementation
       end;
 
 
-   constructor tai_simpletypedconst.create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
+   constructor tai_simpletypedconst.create(_def: tdef; _val: tai);
      begin
-       inherited create(_adetyp,_def);
+       inherited create(tck_simple,_def);
        fval:=_val;
      end;
 
@@ -710,7 +710,7 @@ implementation
        { the "nil" def will be replaced with an array def of the appropriate
          size once we're finished adding data, so we don't create intermediate
          arraydefs all the time }
-       fvalues.add(tai_simpletypedconst.create(tck_simple,nil,newstr));
+       fvalues.add(tai_simpletypedconst.create(nil,newstr));
      end;
 
    procedure tai_aggregatetypedconst.add_to_string(strtai: tai_string; othertai: tai);
@@ -744,7 +744,7 @@ implementation
      begin
        inherited;
        fisstring:=false;
-       fvalues:=tfplist.create;
+       fvalues:=tfpobjectlist.create(true);
      end;
 
 
@@ -794,9 +794,9 @@ implementation
      end;
 
 
-   function tai_aggregatetypedconst.replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
+   procedure tai_aggregatetypedconst.replacevalueatpos(val: tai_abstracttypedconst; pos: longint);
      begin
-       result:=tai_abstracttypedconst(fvalues[pos]);
+       { since fvalues owns its elements, it will automatically free the old value }
        fvalues[pos]:=val;
      end;
 
@@ -831,8 +831,6 @@ implementation
      var
        ai: tai_abstracttypedconst;
      begin
-       for ai in self do
-          ai.free;
        fvalues.free;
        inherited destroy;
      end;

+ 37 - 0
compiler/avr/aoptcpu.pas

@@ -484,6 +484,43 @@ Implementation
                             result:=true;
                           end;
                       end;
+                A_SBRS,
+                A_SBRC:
+                  begin
+                    {
+                      Turn
+                        in rx, y
+                        sbr* rx, z
+                      Into
+                        sbi* y, z
+                    }
+                    if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ=top_reg) and
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(p.next))) and
+                       GetLastInstruction(p,hp1) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).opcode=A_IN) and
+                       (taicpu(hp1).ops=2) and
+                       (taicpu(hp1).oper[1]^.typ=top_const) and
+                       (taicpu(hp1).oper[1]^.val in [0..31]) and
+                       MatchOperand(taicpu(hp1).oper[0]^,taicpu(p).oper[0]^.reg) and
+                       (not RegModifiedBetween(taicpu(p).oper[0]^.reg, hp1, p)) then
+                      begin
+                        if taicpu(p).opcode=A_SBRS then
+                          taicpu(p).opcode:=A_SBIS
+                        else
+                          taicpu(p).opcode:=A_SBIC;
+
+                        taicpu(p).loadconst(0, taicpu(hp1).oper[1]^.val);
+
+                        DebugMsg('Peephole InSbrx2Sbix performed', p);
+
+                        asml.Remove(hp1);
+                        hp1.free;
+
+                        result:=true;
+                      end;
+                  end;
                 A_ANDI:
                   begin
                     {

+ 90 - 0
compiler/cutils.pas

@@ -180,6 +180,11 @@ interface
 
     Function nextafter(x,y:double):double;
 
+    function LengthUleb128(a: qword) : byte;
+    function LengthSleb128(a: int64) : byte;
+    function EncodeUleb128(a: qword;out buf) : byte;
+    function EncodeSleb128(a: int64;out buf) : byte;
+
   { hide Sysutils.ExecuteProcess in units using this one after SysUtils}
   const
     ExecuteProcess = 'Do not use' deprecated 'Use cfileutil.RequotedExecuteProcess instead, ExecuteProcess cannot deal with single quotes as used by Unix command lines';
@@ -1631,6 +1636,91 @@ implementation
     end;
 
 
+    function LengthUleb128(a: qword) : byte;
+      begin
+        result:=0;
+        repeat
+          a := a shr 7;
+          inc(result);
+          if a=0 then
+            break;
+        until false;
+      end;
+
+
+    function LengthSleb128(a: int64) : byte;
+      var
+        b, size: byte;
+        more: boolean;
+      begin
+        more := true;
+        size := sizeof(a)*8;
+        result:=0;
+        repeat
+          b := a and $7f;
+          a := SarInt64(a, 7);
+
+          if (
+            ((a = 0) and (b and $40 = 0)) or
+            ((a = -1) and (b and $40 <> 0))
+          ) then
+            more := false;
+          inc(result);
+          if not(more) then
+            break;
+        until false;
+      end;
+
+
+    function EncodeUleb128(a: qword;out buf) : byte;
+      var
+        b: byte;
+        pbuf : pbyte;
+      begin
+        result:=0;
+        pbuf:=@buf;
+        repeat
+          b := a and $7f;
+          a := a shr 7;
+          if a<>0 then
+            b := b or $80;
+          pbuf^:=b;
+          inc(pbuf);
+          inc(result);
+          if a=0 then
+            break;
+        until false;
+      end;
+
+
+    function EncodeSleb128(a: int64;out buf) : byte;
+      var
+        b, size: byte;
+        more: boolean;
+        pbuf : pbyte;
+      begin
+        more := true;
+        size := sizeof(a)*8;
+        result:=0;
+        pbuf:=@buf;
+        repeat
+          b := a and $7f;
+          a := SarInt64(a, 7);
+
+          if (
+            ((a = 0) and (b and $40 = 0)) or
+            ((a = -1) and (b and $40 <> 0))
+          ) then
+            more := false
+          else
+            b := b or $80;
+          pbuf^:=b;
+          inc(pbuf);
+          inc(result);
+        until not more;
+      end;
+
+
 initialization
   internalerrorproc:=@defaulterror;
   initupperlower;

+ 2 - 2
compiler/entfile.pas

@@ -609,13 +609,13 @@ end;
 
 function tentryfile.getbyte:byte;
 begin
-  if entryidx+1>entry.size then
+  if entryidx>=entry.size then
    begin
      error:=true;
      result:=0;
      exit;
    end;
-  if bufsize-bufidx>=1 then
+  if bufidx<bufsize then
     begin
       result:=pbyte(@buf[bufidx])^;
       inc(bufidx);

+ 1 - 1
compiler/llvm/llvmtype.pas

@@ -410,7 +410,7 @@ implementation
                       symdef:=cpointerdef.getreusable(symdef);
                       if not equal_llvm_defs(symdef,p.def) then
                         begin
-                          cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(tck_simple,symdef,tai_simpletypedconst(p).val),p.def);
+                          cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(symdef,tai_simpletypedconst(p).val),p.def);
                           tai_simpletypedconst(p).val:=cnv;
                         end;
                     end;

+ 6 - 9
compiler/llvm/nllvmtcon.pas

@@ -164,15 +164,12 @@ implementation
 
 
   procedure tllvmtypedconstplaceholder.replace(ai: tai; d: tdef);
-    var
-      oldconst: tai_abstracttypedconst;
     begin
       if d<>def then
         internalerror(2015091002);
-      oldconst:=agginfo.aggai.replacevalueatpos(
-        tai_simpletypedconst.create(tck_simple,d,ai),pos
+      agginfo.aggai.replacevalueatpos(
+        tai_simpletypedconst.create(d,ai),pos
       );
-      oldconst.free;
     end;
 
 
@@ -257,7 +254,7 @@ implementation
 
   function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
     begin
-      result:=tai_simpletypedconst.create(tck_simple,def,p);
+      result:=tai_simpletypedconst.create(def,p);
     end;
 
 
@@ -294,7 +291,7 @@ implementation
         begin
           kind:=tck_simple;
           { finalise the queued expression }
-          ai:=tai_simpletypedconst.create(kind,def,p);
+          ai:=tai_simpletypedconst.create(def,p);
           { set the new index to -1, so we internalerror should we try to
             add anything further }
           update_queued_tai(def,ai,ai,-1);
@@ -305,7 +302,7 @@ implementation
           fqueued_tai:=nil;
         end
       else
-        stc:=tai_simpletypedconst.create(tck_simple,def,p);
+        stc:=tai_simpletypedconst.create(def,p);
       info:=tllvmaggregateinformation(curagginfo);
       { these elements can be aggregates themselves, e.g. a shortstring can
         be emitted as a series of bytes and string data arrays }
@@ -359,7 +356,7 @@ implementation
       fillbytes:=info.prepare_next_field(def);
       while fillbytes>0 do
         begin
-          info.aggai.insertvaluebeforepos(tai_simpletypedconst.create(tck_simple,u8inttype,tai_const.create_8bit(0)),info.anonrecalignpos);
+          info.aggai.insertvaluebeforepos(tai_simpletypedconst.create(u8inttype,tai_const.create_8bit(0)),info.anonrecalignpos);
           dec(fillbytes);
         end;
     end;

+ 8 - 9
packages/amunits/src/coreunits/agraphics.pas

@@ -134,7 +134,6 @@ type
         _p1,
         _p2     : Pointer;    { system reserved }
         reserved : Longint;     { system use }
-        Flags   : Longint;      { only exists in layer allocation }
     end;
 
     pLayer = ^tLayer;
@@ -158,7 +157,7 @@ type
         cr2,
         crnew           : pClipRect;  { used by dedice }
         SuperSaveClipRects : pClipRect; { preallocated cr's }
-        cliprects      : pClipRect;  { system use during refresh }
+        _cliprects      : pClipRect;  { system use during refresh }
         LayerInfo       : Pointer;      { points to head of the list }
         Lock            : tSignalSemaphore;
         BackFill        : pHook;
@@ -391,8 +390,8 @@ type
     pCopList = ^tCopList;
     tCopList = record
         Next    : pCopList;     { next block for this copper list }
-        CopList : pCopList;    { system use }
-        ViewPort : Pointer;    { system use }
+        _CopList : pCopList;    { system use }
+        _ViewPort : Pointer;    { system use }
         CopIns  : pCopIns;    { start of this block }
         CopPtr  : pCopIns;    { intermediate ptr }
         CopLStart : psmallint;     { mrgcop fills this in for Long Frame}
@@ -418,8 +417,8 @@ type
         fm0      : array [0..1] of word;
         diwstart : array [0..9] of word;
         bplcon2  : array [0..1] of word;
-        sprfix   : array [0..(2*8)] of word;
-        sprstrtup : Array [0..(2*8*2)] of Word;
+        sprfix   : array [0..(2*8-1)] of word;
+        sprstrtup : Array [0..(2*8*2-1)] of Word;
         wait14    : array [0..1] of word;
         norm_hblank : array [0..1] of word;
         jump        : array [0..1] of word;
@@ -1147,7 +1146,7 @@ Type
     pColorMap = ^tColorMap;
     tColorMap = record
         Flags   : Byte;
-        CType   : Byte;         { This is "Type" in C includes }
+        Type_   : Byte;         { This is "Type" in C includes }
         Count   : Word;
         ColorTable      : Pointer;
         cm_vpe  : pViewPortExtra;
@@ -1739,7 +1738,7 @@ Type
 
   pQueryHeader = ^tQueryHeader;
   tQueryHeader = record
-   tructID,                    { datachunk type identifier }
+   StructID,                    { datachunk type identifier }
    DisplayID,                  { copy of display record key   }
    SkipID,                     { TAG_SKIP -- see tagitems.h }
    Length  :  ULONG;         { length of local data in double-longwords }
@@ -1878,7 +1877,7 @@ Type
         Header  : tQueryHeader;
         Vec     : Pointer;
         Data    : Pointer;
-        vi_Type : WORD;               { Type in C Includes }
+        Type_ : WORD;               { Type in C Includes }
         pad     : Array[0..2] of WORD;
         reserved : Array[0..1] of ULONG;
  end;

+ 1 - 1
packages/amunits/src/coreunits/clipboard.pas

@@ -13,7 +13,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
+{$PACKRECORDS 2}
 unit clipboard;
 
 INTERFACE

+ 4 - 4
packages/amunits/src/coreunits/intuition.pas

@@ -2433,7 +2433,7 @@ Type
         ViewInitX,
         ViewInitY       : smallint;        { View initial offset values      }
 
-        EnableCLI       : Boolean;      { CLI availability switch }
+        EnableCLI       : WordBool;      { CLI availability switch }
 
     { printer configurations }
         PrinterType     : Word;        { printer type                     }
@@ -3905,8 +3905,8 @@ Type
    pSGWork = ^tSGWork;
    tSGWork = record
     { set up when gadget is first activated    }
-    Gad       : pGadget;         { the contestant itself        }   { Gadget in C-Includes }
-    StrInfo   : pStringInfo;     { easy access to sinfo         }   { StrInfo in C-Includes }
+    Gadget     : pGadget;         { the contestant itself        }   { Gadget in C-Includes }
+    StringInfo : pStringInfo;     { easy access to sinfo         }   { StrInfo in C-Includes }
     WorkBuffer : STRPTR;           { intuition's planned result   }
     PrevBuffer : STRPTR;           { what was there before        }
     Modes      : ULONG;          { current mode                 }
@@ -3919,7 +3919,7 @@ Type
     Actions    : ULONG;          { what Intuition will do       }
     LongInt_   : Longint;          { temp storage for longint     }
 
-    GInfo      : pGadgetInfo;    { see cghooks.h                }   { GadgetInfo in C-Includes }
+    GadgetInfo      : pGadgetInfo;    { see cghooks.h                }   { GadgetInfo in C-Includes }
     EditOp     : Word;            { from constants below         }
    END;
 

+ 13 - 13
packages/arosunits/src/agraphics.pas

@@ -341,7 +341,7 @@ type
    // SYSTEM VARIABLES
     NextVSprite: PVSprite; // GEL linked list forward/backward pointers sorted by y,x value
     PrevVSprite: PVSprite;
-    DrawPath: PVSprite;    // pointer of overlay drawing
+    IntVSprite: PVSprite;    // pointer of overlay drawing
     ClearPath: PVSprite;   // pointer for overlay clearing
     OldY, OldX: SmallInt;  // previous position
    // COMMON VARIABLES
@@ -564,10 +564,10 @@ type
   PShapeHookMsg = ^TShapeHookMsg;
   TShapeHookMsg = record
     Action: LongInt;
-    Layer: PLayer;
-    ActualShape: PRegion;
-    NewBounds: TRectangle;
-    OldBounds: TRectangle;
+    NewShape: PRegion;
+    OldShape: PRegion;
+    NewBounds: PRectangle;
+    OldBounds: PRectangle;
   end;
   // Hook for getting LA_ShapeHook and getting this Msg
   TShapeHookProc = function(Hook: PHook; Layer: PLayer; Msg: PShapeHookMsg): PRegion; cdecl;
@@ -990,19 +990,19 @@ type
   // Copper structures
   PCopIns = ^TCopIns;
   TCopIns = record
-    OpCode  : smallint; // 0 = move, 1 = wait
+    OpCode: smallint; // 0 = move, 1 = wait
     case SmallInt of
     0:(
       NxtList: PCopList;
       );
     1:(
-      VWaitPos: SmallInt; // vertical wait position
       DestAddr: SmallInt; // destination Pointer
+      DestData: SmallInt; // data to send      
       );
     2:(
-      HWaitPos: SmallInt; // horizontal wait position
-      DestData: SmallInt; // data to send
-      );
+      VWaitPos: SmallInt; // vertical wait position
+      HWaitPos: SmallInt; // horizontal wait position      
+      );  
   end;
 
   TCopList = record
@@ -1994,9 +1994,9 @@ type
     VBCounter: ULONG;
 
     HashTableSemaphore: PSignalSemaphore;  // Semaphore for hash_table access, private in fact
-
-    ChunkyToPlanarPtr: PLongWord;  // HWEmul[0];
-    HWEmul: array[1..8] of PLongWord;
+    case boolean of
+      true: ( ChunkyToPlanarPtr: PLongWord;);  // HWEmul[0];
+      false: (HWEmul: array[0..8] of PLongWord;);
   end;
 
 type

+ 2 - 43
packages/arosunits/src/amigados.pas

@@ -848,12 +848,6 @@ type
     dl_DiskType: LongInt; // 'DOS', etc
     dl_unused: BPTR;
     dl_Name: BSTR;        // bptr to bcpl name
-{$ifdef aros}
-  {$ifndef AROS_DOS_PACKETS}
-    dl_Reserved: array[0..5] of IPTR;
-    dl_AROS: TDosListAROSExt;
-  {$endif}
-{$endif}
   end;
 
 { device structure (same as the DeviceNode structure in filehandler.h) }
@@ -874,12 +868,6 @@ type
     dvi_GlobVec: BSTR;
 {$endif}
     dvi_Name: BSTR;
-{$ifdef aros}
-  {$ifndef AROS_DOS_PACKETS}
-    dvi_Reserved: array[0..5] of IPTR;
-    dvi_AROS: TDosListAROSExt;
-  {$endif}
-{$endif}
   end;
 
 const
@@ -1165,12 +1153,6 @@ type
                              * vector for you.
                              }
     dn_Name: BSTR;         { the node name, e.g. '\3','D','F','3' }
-{$ifdef aros}
-  {$ifndef AROS_DOS_PACKETS}
-    dn_Reserved: array[0..5] of IPTR;  // Private extensions Should not be used in user land code.
-    dn_AROS: TDosListAROSExt;
-  {$endif}
-{$endif}
   end;
 
 type
@@ -1518,39 +1500,16 @@ type
   TDosLibrary = record
     dl_lib: TLibrary;
     dl_Root: PRootNode;      // Pointer to RootNode, described below }
-{$ifdef AROS_BINCOMPAT}
+
     dl_GV: APTR;             // Pointer to BCPL global vector       }
     dl_A2: LongInt;          // Private register dump of DOS        }
     dl_A5: LongInt;
     dl_A6: LongInt;
-{$endif}
+
     dl_Errors: PErrorString;    // pointer to array of error msgs
     dl_TimeReq: PTimeRequest;   // private pointer to timer request
     dl_UtilityBase  : PLibrary; // private ptr to utility library
     dl_IntuitionBase : PLibrary;
-{ These were AROS-specific private fields. At the moment they are mostly not used
-  and are present only for binary compatibility with programs that used dl_Flags
-  (Directory Opus for example). Do not try to use them in any way!}
-{$ifdef aros}
-    dl_TimerBase: PDevice;
-    dl_TimerIO: TTimeRequest;
-    dl_DevInfo: PDosList;
-    dl_SysBase: PExecBase;
-    dl_SegList: BPTR;
-    dl_NulHandler: PDevice;
-    dl_NulLock: PUnit;
-  // LDDemon (library loader) private data
-    dl_LDObjectsListSigSem: TSignalSemaphore;
-    dl_LDObjectsList: TList;
-    dl_LDHandler: TInterrupt;
-    dl_LDDemonPort: PMsgPort;
-    dl_LDDemonTask: PProcess;
-    dl_LDReturn: ULONG;
-    //* AROS-specific and private. Can go away in future.
-    dl_SYSLock: BPTR;
-    // The flags are ORed with RootNode^.rn_Flags. See below for definitions.
-    dl_Flags: ULONG;
-{$endif}
   end;
 
 const

+ 1 - 1
packages/arosunits/src/datatypes.pas

@@ -781,8 +781,8 @@ type
   TAnimHeader = record
     ah_Operation: Byte;
     ah_Mask: Byte;
-    ah_Height: Word;
     ah_Width: Word;
+    ah_Height: Word;    
     ah_Left: SmallInt;
     ah_Top: SmallInt;
     ah_AbsTime: LongWord;

+ 4 - 4
packages/arosunits/src/intuition.pas

@@ -1471,7 +1471,7 @@ type
     ViewInitX,
     ViewInitY: SmallInt;   // View initial offset values
 
-    EnableCLI: LongBool;   // CLI availability switch
+    EnableCLI: WordBool;   // CLI availability switch
 
   // printer configurations
     PrinterType: Word;     // printer type
@@ -1663,11 +1663,11 @@ type
                             Screens are then maintained in a front to back order using Screen.NextScreen  }
     Flags: LongWord;      // see definitions below
 {$ifdef AROS_BINCOMPAT}
-    MouseX,
-    MouseY: SmallInt;      // mouse position relative to View
-{$else}
     MouseY,
     MouseX: SmallInt;      // mouse position relative to View
+{$else}
+    MouseX,
+    MouseY: SmallInt;      // mouse position relative to View
 {$endif}
 
     Seconds: LongWord;     // timestamp of most current input event

+ 0 - 1
packages/arosunits/src/locale.pas

@@ -12,7 +12,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{$PACKRECORDS 2}
 
 unit locale;
 

+ 0 - 1
packages/arosunits/src/serial.pas

@@ -17,7 +17,6 @@
 unit serial;
 
 interface
-{$PACKRECORDS 2}
 
 uses
   exec;

+ 6 - 4
packages/arosunits/src/workbench.pas

@@ -237,7 +237,7 @@ type
     ism_Drawer: BPTR;          // Lock on the drawer this object resides in, NULL for Workbench backdrop (devices).
     ism_Name: STRPTR;          // Name of the object in question.
     ism_type: Word;            // One of WBDISK, WBDRAWER, WBTOOL, WBPROJECT, WBGARBAGE, WBDEVICE, WBKICK or WBAPPICON.
-    ism_Selected: LongBool;    // TRUE if currently selected, FALSE otherwise.
+    ism_Selected: WordBool;    // TRUE if currently selected, FALSE otherwise.
     ism_Tags: PTagItem;        // Pointer to the list of tag items passed to ChangeWorkbenchSelectionA().
     ism_DrawerWindow: PWindow; // Pointer to the window attached to this icon, if the icon is a drawer-like object.
     ism_ParentWindow: PWindow; // Pointer to the window the icon resides in.
@@ -536,20 +536,22 @@ type
   TWBHandlerMessage = record
     wbhm_Message: TMessage; // Standard message structure.
     wbhm_type: TWBHM_type;  // type of message.
+    wbhm_Data: record
     case integer of
     0 :
     (
       Open: record
-        OpenName: STRPTR;   // Name of the drawer.
+        Name: STRPTR;   // Name of the drawer.
       end;
     );
     1 :
     (
       Update: record
-        UpdateName: STRPTR;  // Mame of the object.
-        Updatetype: LongInt; // type of object (WBDRAWER, WBPROJECT, ...).
+        Name: STRPTR;  // Mame of the object.
+        Type_: LongInt; // type of object (WBDRAWER, WBPROJECT, ...).
       end;
     );
+    end;
   end;
 
 

+ 6 - 9
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -939,7 +939,7 @@ begin
                      ColNameDefaultLength+1, // and its length; we include the #0 terminating any ansistring of Length > 0 in the buffer
                      ColNameLength,          // actual column name length
                      DataType,               // the SQL datatype for the column
-                     ColumnSize,             // column size
+                     ColumnSize,             // column size (in characters)
                      DecimalDigits,          // number of decimal digits
                      Nullable),              // SQL_NO_NULLS, SQL_NULLABLE or SQL_NULLABLE_UNKNOWN
       SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get column properties for column %d.',[i]
@@ -969,8 +969,8 @@ begin
       SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize; end;
       SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize; end;
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
-      SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
-      SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
+      SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize; end;
+      SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize; end;
       SQL_SS_XML,
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
@@ -1120,10 +1120,7 @@ begin
     end;
 
     // add FieldDef
-    with FieldDefs.Add(FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, (Nullable=SQL_NO_NULLS) and (AutoIncAttr=SQL_FALSE), i) do
-    begin
-      if Updatable = SQL_ATTR_READONLY then Attributes := Attributes + [faReadonly];
-    end;
+    AddFieldDef(FieldDefs, i, ColName, FieldType, FieldSize, -1, False, (Nullable=SQL_NO_NULLS) and (AutoIncAttr=SQL_FALSE), Updatable=SQL_ATTR_READONLY);
   end;
 end;
 
@@ -1166,9 +1163,9 @@ begin
   // TODO: finish this
   case FieldDef.DataType of
     ftWideString,ftFixedWideChar: // mapped to TWideStringField
-      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size+sizeof(WideChar), @StrLenOrInd); //buffer must contain space for the null-termination character
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size*FieldDef.CharSize+sizeof(WideChar), @StrLenOrInd); //buffer must contain space for the null-termination character
     ftGuid, ftFixedChar,ftString: // are mapped to a TStringField (including TGuidField)
-      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size*FieldDef.CharSize+1, @StrLenOrInd);
     ftSmallint:           // mapped to TSmallintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
     ftInteger,ftAutoInc:  // mapped to TLongintField

+ 14 - 10
packages/fcl-registry/src/winreg.inc

@@ -42,6 +42,17 @@ begin
   Result:=(S='') or (S[1]<>'\')
 end;
 
+function RegDataWordToRegDataType(RD: DWORD): TRegDataType;
+begin
+  // Test in ascending because rdString is most commonly used
+  Result := Succ(Low(RegDataWords));
+  repeat
+    if RegDataWords[Result] = RD then
+      Exit;
+    Inc(Result);
+  until Result > High(Result);
+  Result := Low(RegDataWords);
+end;
 
 function TRegistry.sysCreateKey(Key: UnicodeString): Boolean;
 Var
@@ -95,9 +106,7 @@ begin
     Result:=-1
   else
     begin
-    RegData:=High(TRegDataType);
-    While (RegData>rdUnknown) and (RD<>RegDataWords[RegData]) do
-      RegData:=Pred(RegData);
+    RegData:=RegDataWordToRegDataType(RD);
     Result:=BufSize;
     end;
 end;
@@ -110,15 +119,10 @@ Var
 begin
   With Value do
     begin
-    FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(ValueName),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
+    FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(ValueName),Nil,@RD,Nil,lpdword(@DataSize));
     Result:=FLastError=ERROR_SUCCESS;
     if Result then
-      begin
-      RD:=DWord(RegData);
-      RegData:=High(TRegDataType);
-      While (RegData>rdUnknown) and (RD<>RegDataWords[RegData]) do
-         RegData:=Pred(RegData);
-      end;
+      RegData:=RegDataWordToRegDataType(RD);
     end;
   If Not Result Then
     begin

+ 2 - 2
packages/fcl-web/src/base/restbase.pp

@@ -717,7 +717,7 @@ begin
         TStringArray(AP)[I]:=AValue.Strings[i];
         end;
     else
-      Raise ERESTAPI.CreateFmt('%s: unsupported array element type : ',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
+      Raise ERESTAPI.CreateFmt('%s: unsupported array element type : %s',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
     end;
     end;
 end;
@@ -1041,7 +1041,7 @@ begin
     For I:=0 to Length(TStringArray(AP))-1 do
       A.Add(TJSONString.Create(TStringArray(AP)[I]));
   else
-    Raise ERESTAPI.CreateFmt('%s: unsupported array element type : ',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
+    Raise ERESTAPI.CreateFmt('%s: unsupported array element type : %s',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
   end;
 end;
 

+ 30 - 0
packages/fpmkunit/src/fpmkunit.pp

@@ -518,6 +518,8 @@ Type
     Property RequireChecksum : Cardinal Read FRequireChecksum Write FRequireChecksum;
   end;
 
+  TResourceFile = Class(TConditionalString);
+
   { TPackageVariant }
 
   TPackage = Class;
@@ -588,6 +590,13 @@ Type
     Property Dependencies[Index : Integer] : TDependency Read GetDependency Write SetDependency; default;
   end;
 
+  { TResourceFiles }
+
+  TResourceFiles = Class(TConditionalStrings)
+  public
+    Procedure GetInstallFiles(AList : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
+  end;
+
   { TTarget }
 
   TTarget = Class(TNamedItem)
@@ -606,6 +615,7 @@ Type
     FUnitPath,
     FIncludePath : TConditionalStrings;
     FDependencies : TDependencies;
+    FResourceFiles : TResourceFiles;
     FCommands : TCommands;
     FDirectory: String;
     FExtension: String;
@@ -646,6 +656,7 @@ Type
     Procedure GetInstallFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
     Procedure GetArchiveFiles(List : TStrings; ACPU:TCPU; AOS : TOS); virtual;
     Property Dependencies : TDependencies Read FDependencies;
+    Property ResourceFiles: TResourceFiles read FResourceFiles;
     Property Commands : TCommands Read FCommands;
     Property State : TTargetState Read FTargetState;
     Property TargetType : TTargetType Read FTargetType Write FTargetType;
@@ -2820,6 +2831,21 @@ begin
   Result := GPluginManager;
 end;
 
+{ TResourceFiles }
+
+procedure TResourceFiles.GetInstallFiles(AList: TStrings; const APrefixU, APrefixB: String; ACPU: TCPU; AOS: TOS);
+Var
+  I : Integer;
+  R : TResourceFile;
+begin
+  For I:=0 to Count-1 do
+    begin
+    R:=Tobject(Items[I]) as TResourceFile;
+    if (ACPU in R.CPUs) and (AOS in R.OSes) then
+      AList.Add(ConcatPaths([APrefixU, R.Value]));
+    end;
+end;
+
 { TfpmResolvePackagePathsPlugin }
 
 procedure TfpmResolvePackagePathsPlugin.ResolveUnitConfigFilenameForBasePath(
@@ -8561,6 +8587,7 @@ begin
   FIncludePath:=TConditionalStrings.Create(TConditionalString);
   FObjectPath:=TConditionalStrings.Create(TConditionalString);
   FDependencies:=TDependencies.Create(TDependency);
+  FResourceFiles:=TResourceFiles.Create(TResourceFile);
   FCommands:=TCommands.Create(TCommand);
 end;
 
@@ -8571,6 +8598,7 @@ begin
   FreeAndNil(FObjectPath);
   FreeAndNil(FIncludePath);
   FreeAndNil(FDependencies);
+  FreeAndNil(FResourceFiles);
   FreeAndNil(FCommands);
   FreeAndNil(Foptions);
   inherited Destroy;
@@ -8597,6 +8625,7 @@ begin
     DestTarget.FileType := FileType;
     DestTarget.Directory := Directory;
     DestTarget.ResourceStrings := ResourceStrings;
+    DestTarget.ResourceFiles.Assign(ResourceFiles);
     DestTarget.Install := Install;
     DestTarget.FTargetSourceFileName := fTargetSourceFileName;
     DestTarget.ObjectPath.Assign(ObjectPath);
@@ -8859,6 +8888,7 @@ begin
           List.Add(APrefixU + RSTFileName);
         end;
      end;
+  FResourceFiles.GetInstallFiles(List, APrefixU, APrefixB, ACPU, AOS);
 end;
 
 

+ 29 - 7
packages/morphunits/src/agraphics.pas

@@ -129,7 +129,29 @@ type
     _p1,
     _p2     : APTR;       // system reserved
     reserved: LongInt;    // system use
-    Flags   : LongInt;    // only exists in layer allocation
+  end;
+  PLayer_Info = ^TLayer_Info;
+  TLayer_Info = record
+    Top_Layer: Player;
+    check_lp: PLayer;
+    Obs: PClipRect;
+    FreeClipRects: PClipRect;
+
+    PrivateReserve1: LongInt;
+    PrivateReserve2: LongInt;
+
+    Lock: TSignalSemaphore;
+    gs_Head: TMinList;
+
+    PrivateReserve3: SmallInt;
+    PrivateReserve4: APTR;
+
+    Flags: Word;               // LIFLG_SUPPORTS_OFFSCREEN_LAYERS
+    fatten_count: ShortInt;
+    LockLayersCount: ShortInt;
+    PrivateReserve5: SmallInt;
+    BlankHook: APTR;
+    LayerInfo_extra: APTR;
   end;
 
 
@@ -275,12 +297,12 @@ type
       NxtList: PCopList;
       );
     1:(
-      VWaitPos: SmallInt; // vertical wait position
       DestAddr: SmallInt; // destination Pointer
+      DestData: SmallInt; // data to send
       );
     2:(
+      VWaitPos: SmallInt; // vertical wait position
       HWaitPos: SmallInt; // horizontal wait position
-      DestData: SmallInt; // data to send
       );
   end;
 
@@ -288,7 +310,7 @@ type
   PCprList = ^TCprList;
   TCprList = record
     Next: PCprList;
-    Start: Word;         // start of copper list
+    Start: PWord;         // start of copper list
     MaxCount: SmallInt;  // number of long instructions
   end;
 
@@ -1903,9 +1925,9 @@ type
     VBCounter: LongWord;
 
     HashTableSemaphore: PSignalSemaphore;  // Semaphore for hash_table access, private in fact
-
-    ChunkyToPlanarPtr: PLongWord;  // HWEmul[0];
-    HWEmul: array[1..8] of PLongWord;
+    case boolean of
+      true: ( ChunkyToPlanarPtr: PLongWord;);  // HWEmul[0];
+      false: (HWEmul: array[0..8] of PLongWord;);
   end;
 
 const

+ 2 - 2
packages/morphunits/src/amigados.pas

@@ -546,7 +546,7 @@ type
   PErrorString = ^TErrorString;
   TErrorString = packed record
     estr_Nums: PLongInt;
-    estr_Byte: PByte;
+    estr_Strings: PByte;
   end;
 
 type
@@ -852,7 +852,7 @@ type
           ap_Reserved  : ShortInt;
           ap_Strlen    : SmallInt;
           ap_Info      : TFileInfoBlock;
-          ap_Buf       : Array[0..0] of Char;
+          ap_Buf       : Array[0..1] of Char;
           { * an_Buf continues * }
         );
   end;

+ 7 - 0
packages/morphunits/src/datatypes.pas

@@ -629,6 +629,13 @@ Type
     dtd_AttrList         : pTagItem;          { Additional attributes }
  end;
 
+// DTM_RELEASERAWINFO
+  PdtReleaseDrawInfo = ^TdtReleaseDrawInfo;
+  TdtReleaseDrawInfo = record
+    MethodID: PtrUInt;
+    dtr_Handle: APTR; // Handle as returned by DTM_OBTAINDRAWINFO
+  end;
+
 { DTM_WRITE }
  pdtWrite = ^tdtWrite;
  tdtWrite = record

+ 2 - 2
packages/morphunits/src/exec.pas

@@ -1071,7 +1071,7 @@ type
     lib_Node    : TNode;
     lib_Flags   : Byte;
     lib_pad     : Byte;
-    lib_MegSize : Word;
+    lib_NegSize : Word;
     lib_PosSize : Word;
     lib_Version : Word;
     lib_Revision: Word;
@@ -1418,7 +1418,7 @@ type
     PortList    : TList;
     TaskReady   : TList;
     TaskWait    : TList;
-    SoftInts    : Array[0..5] Of TSoftIntList;
+    SoftInts    : Array[0..4] Of TSoftIntList;
     LastAlert   : Array[0..3] Of LongInt;
 
     VBlankFrequency     : Byte;

+ 1 - 3
packages/morphunits/src/intuition.pas

@@ -1707,7 +1707,7 @@ type
     ViewInitX,
     ViewInitY: SmallInt;   // View initial offset values
 
-    EnableCLI: LongBool;   // CLI availability switch
+    EnableCLI: WordBool;   // CLI availability switch
 
   // printer configurations
     PrinterType: Word;     // printer type
@@ -2075,8 +2075,6 @@ type
     cl_SubclassCount: LongWord; // number of direct subclasses
     cl_ObjectCount: LongWord;   // number of instances
     cl_Flags: LongWord;         // Flags (CLF_INLIST)
-    cl_ObjectSize: LongWord;    // cl_InstOffset + cl_InstSize + SizeOf(_Object)
-    cl_MemoryPool: APTR;
   end;
 
 const

+ 2 - 2
packages/morphunits/src/utility.pas

@@ -140,8 +140,8 @@ const
 
 
 type
-  PUtilityBase = ^TUtilityName;
-  TUtilityName = packed record
+  PUtilityBase = ^TUtilityBase;
+  TUtilityBase = packed record
     ub_LibNode : TLibrary;
     ub_Language: Byte;
     ub_Reserved: Byte;

+ 258 - 0
packages/rtl-objpas/src/inc/dateutil.inc

@@ -440,6 +440,24 @@ Function LocalTimeToUniversal(LT: TDateTime; TZOffset: Integer): TDateTime;
 function ScanDateTime(const Pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; overload;
 function ScanDateTime(const Pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
 
+// ISO date/time
+// YYYYMMDD or YYYY-MM-DD
+function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
+// HH HH:NN HH:NN:SS HH:NN:SS.ZZZ or HHNN HHNNSS HHNNSS.ZZZ
+function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
+// Combination of previous
+function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
+// Z +hh:nn -hh:nn
+Function TryISOTZStrToTZOffset(TZ : String; Out TZOffset : Integer) : boolean;
+
+// ISO 8601 Date/Time formatting
+
+function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
+Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean): TDateTime;
+Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime): TDateTime;
+Function TryISO8601ToDate(const DateString: string; ReturnUTC : Boolean;out ADateTime: TDateTime) : Boolean;
+
+
 implementation
 
 uses sysconst;
@@ -2678,6 +2696,246 @@ begin
     Result := LT;
 end;
 
+Const
+  FmtUTC = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz';
+  FmtUTCTZ = 'hh":"mm';
+
+function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
+
+const
+  FmtOffset: string = '%.02d:%.02d';
+  Sign: array[Boolean] of Char = ('+', '-');
+
+var
+  Offset: Integer;
+begin
+  Result := FormatDateTime(FmtUTC, ADate);
+  Offset := GetLocalTimeOffset;
+  if AInputIsUTC or (Offset=0) then
+    Result:=Result+'Z'
+  else
+    begin
+    Result:=Result+Sign[Offset>0];
+    Offset := Abs(Offset);
+    Result:= Result+Format(FmtOffset, [Offset div MinsPerHour, Offset mod MinsPerHour]);
+    end;
+end;
+
+function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
+var
+  xYear, xMonth, xDay: LongInt;
+begin
+  case Length(aString) of
+    8: Result :=
+          TryStrToInt(Copy(aString, 1, 4), xYear) and
+          TryStrToInt(Copy(aString, 5, 2), xMonth) and
+          TryStrToInt(Copy(aString, 7, 2), xDay) and
+          TryEncodeDate(xYear, xMonth, xDay, outDate);
+    10: Result :=
+          TryStrToInt(Copy(aString, 1, 4), xYear) and
+          TryStrToInt(Copy(aString, 6, 2), xMonth) and
+          TryStrToInt(Copy(aString, 9, 2), xDay) and
+          TryEncodeDate(xYear, xMonth, xDay, outDate);
+  else
+    Result := False;
+  end;
+  if not Result then
+    outDate := 0;
+end;
+
+
+function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
+var
+  xHour, xMinute, xSecond, xMillisecond, xLength: LongInt;
+begin
+  Result := True;
+  xLength := Length(aString);
+  if (xLength>0) and (aString[xLength] = 'Z') then
+  begin
+    Dec(xLength);
+  end else
+  if (xLength>6) and CharInSet(aString[xLength-5], ['+', '-']) then
+  begin
+    Result :=
+      TryStrToInt(Copy(aString, xLength-4, 2), xHour) and
+      (aString[xLength-2] = ':') and
+      TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
+    Dec(xLength, 6);
+  end else
+  if (xLength>5) and CharInSet(aString[xLength-4], ['+', '-']) then
+  begin
+    Result :=
+      TryStrToInt(Copy(aString, xLength-3, 2), xHour) and
+      TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
+    Dec(xLength, 5);
+  end else
+  if (xLength>3) and CharInSet(aString[xLength-2], ['+', '-']) then
+  begin
+    Result :=
+      TryStrToInt(Copy(aString, xLength-1, 2), xHour);
+    Dec(xLength, 3);
+  end;
+  if not Result then
+  begin
+    outTime := 0;
+    Exit;
+  end;
+
+  case xLength of
+    2: Result :=
+          TryStrToInt(aString, xHour) and
+          TryEncodeTime(xHour, 0, 0, 0, outTime);
+    4: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          TryStrToInt(Copy(aString, 3, 2), xMinute) and
+          TryEncodeTime(xHour, xMinute, 0, 0, outTime);
+    5: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          (aString[3] = ':') and
+          TryStrToInt(Copy(aString, 4, 2), xMinute) and
+          TryEncodeTime(xHour, xMinute, 0, 0, outTime);
+    6: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          TryStrToInt(Copy(aString, 3, 2), xMinute) and
+          TryStrToInt(Copy(aString, 5, 2), xSecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
+    8: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          (aString[3] = ':') and
+          TryStrToInt(Copy(aString, 4, 2), xMinute) and
+          (aString[6] = ':') and
+          TryStrToInt(Copy(aString, 7, 2), xSecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
+    10: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          TryStrToInt(Copy(aString, 3, 2), xMinute) and
+          TryStrToInt(Copy(aString, 5, 2), xSecond) and
+          (aString[7] = '.') and
+          TryStrToInt(Copy(aString, 8, 3), xMillisecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
+    12: Result :=
+          TryStrToInt(Copy(aString, 1, 2), xHour) and
+          (aString[3] = ':') and
+          TryStrToInt(Copy(aString, 4, 2), xMinute) and
+          (aString[6] = ':') and
+          TryStrToInt(Copy(aString, 7, 2), xSecond) and
+          (aString[9] = '.') and
+          TryStrToInt(Copy(aString, 10, 3), xMillisecond) and
+          TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
+  else
+    Result := False;
+  end;
+
+  if not Result then
+    outTime := 0;
+end;
+
+function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
+var
+  xLength: Integer;
+  sDate,sTime : String;
+  xDate, xTime: TDateTime;
+
+begin
+  xLength := Length(aString);
+  if (xLength>11) and CharInSet(aString[11], [' ', 'T']) then
+    begin
+    sDate:=Copy(aString, 1, 10);
+    sTime:=Copy(aString, 12, Length(aString))
+    end
+  else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then
+    begin
+    sDate:=Copy(aString, 1, 8);
+    sTime:=Copy(aString, 10, Length(aString));
+    end
+  else
+    exit(False);
+  Result:=TryISOStrToDate(sDate, xDate)  and TryISOStrToTime(sTime, xTime);
+  if Result then
+    outDateTime := xDate+xTime
+  else
+    outDateTime := 0;
+end;
+
+Function TryISOTZStrToTZOffset(TZ : String; Out TZOffset : Integer) : boolean;
+
+Var
+  H,M : LongInt;
+
+begin
+  Result:=(TZ='Z') or (TZ='');
+  if Result then
+    TZOffset:=0
+  else
+    begin
+    Result:=TZ[1] in ['+','-'];
+    if Not Result then
+      Exit;
+    Result:=TryStrToInt(Copy(TZ,2,2),H) and TryStrToInt(Copy(TZ,5,2),M);
+    if not Result then
+      exit;
+    TZOffset:=H*60+M;
+    if (TZ[1]='+') then
+      TZOffset:=-TZOffset;
+    end;
+end;
+
+Function ISOTZStrToTZOffset(TZ : String) : Integer;
+
+begin
+  if not TryISOTZStrToTZOffSet(TZ,Result) then
+    Raise EConvertError.CreateFmt('Invalid ISO timezone string',[TZ]);
+end;
+
+Function TryISO8601ToDate(const DateString: string; ReturnUTC : Boolean;out ADateTime: TDateTime) : Boolean;
+
+
+Var
+  S,TZ : String;
+  L,Offset,TZOffset : Integer;
+
+begin
+  S:=DateString;
+  L:=Length(S);
+  if L=0 then
+    exit(False);
+  if S[L]='Z' then
+    begin
+    TZ:='Z';
+    S:=Copy(S,1,L-1);
+    end
+  else If (L>5) and (S[L-5] in ['+','-']) then
+    begin
+    TZ:=Copy(S,L-5,6);
+    S:=Copy(S,1,L-6);
+    end;
+  Result:=TryIsoStrToDateTime(S,aDateTime) and TryISOTZStrToTZOffset(TZ,TZOffset);
+  if not Result then
+    exit;
+  aDateTime:=IncMinute(aDateTime,TZOffSet);
+  // offset for UTC or not
+  if ReturnUTC then
+    Offset:=0
+  else
+    OffSet:=-GetLocalTimeOffset;
+  aDateTime:=IncMinute(aDateTime,Offset);
+  Result:=True;
+end;
+
+Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean): TDateTime;
+
+begin
+  if not TryISO8601ToDate(DateString,ReturnUTC,Result) then
+    Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[DateString]);
+end;
+
+Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime): TDateTime;
+
+begin
+  if not TryISO8601ToDate(DateString,ReturnUTC,Result) then
+    Result:=aDefault;
+end;
+
 {$else}
 implementation
 {$endif FPUNONE}

+ 53 - 0
rtl/bsd/ostypes.inc

@@ -107,6 +107,45 @@ TYPE
         st_gen        : cuint32;           // file generation number
         st_birthtime  : time_t;            // File creation time
         st_birthtimensec : clong;          // nsec of file creation time
+{$elseif defined(freebsd)}
+{$ifdef i386}
+{$define __STAT_TIME_T_EXT}
+{$endif}
+        st_dev        : dev_t;             // inode's device
+        st_ino        : ino_t;             // inode's number
+        st_nlink      : nlink_t;           // number of hard links
+        st_mode       : mode_t;            // inode protection mode
+	st_padding0   : cint16;
+        st_uid        : uid_t;             // user ID of the file's owner
+        st_gid        : gid_t;             // group ID of the file's group
+	st_padding1   : cint32;
+        st_rdev       : dev_t;             // device type
+{$ifdef __STAT_TIME_T_EXT}
+        st_atim_ext   : cint32;
+{$endif}
+        st_atime      : time_t;            // time of last access
+        st_atimensec  : clong;             // nsec of last access
+{$ifdef __STAT_TIME_T_EXT}
+        st_mtim_ext   : cint32;
+{$endif}
+        st_mtime      : time_t;            // time of last data modification
+        st_mtimensec  : clong;             // nsec of last data modification
+{$ifdef __STAT_TIME_T_EXT}
+        st_ctim_ext   : cint32;
+{$endif}
+        st_ctime      : time_t;            // time of last file status change
+        st_ctimensec  : clong;             // nsec of last file status change
+{$ifdef __STAT_TIME_T_EXT}
+        st_birthtim_ext   : cint32;
+{$endif}
+        st_birthtime  : time_t;            // File creation time
+        st_birthtimensec : clong;          // nsec of file creation time
+        st_size       : off_t;             // file size, in bytes
+        st_blocks     : cint64;            // blocks allocated for file
+        st_blksize    : cint32;            // optimal blocksize for I/O
+        st_flags      : cuint32;           // user defined flags for file
+        st_gen        : cuint64;           // file generation number
+	st_spare      : array [0..10-1] of cuint64;
 {$else}
         st_dev        : dev_t;             // inode's device
 {$ifdef darwin_new_iostructs}
@@ -189,6 +228,17 @@ TYPE
         d_padding     : array[0..3] of cuint8;
         d_name        : array[0..(255 + 1)-1] of char;  // name must be no longer than this
    end;
+{$elseif defined(freebsd)}
+   dirent  = record
+        d_fileno      : ino_t;
+        d_off         : off_t;
+        d_reclen      : cuint16;                        // length of this record
+        d_type        : cuint8;                         // file type, see below
+	d_pad0        : cuint8;
+        d_namlen      : cuint16;                        // length of string in d_name
+	d_pad1        : cuint16;
+        d_name        : array[0..(255 + 1)-1] of char;  // name must be no longer than this
+   end;
 {$else}
    dirent  = record
         d_fileno      : cuint32;                        // file number of entry
@@ -242,6 +292,9 @@ TYPE
                 l_pid   : pid_t;        { lock owner }
                 l_type  : cshort;       { lock type: read/write, etc. }
                 l_whence: cshort;       { type of l_start }
+{$ifdef freebsd}
+                l_sysid : cint;
+{$endif}
                 end;
    TFlock   = flock;
    pFlock   = ^flock;

+ 2 - 8
rtl/embedded/Makefile

@@ -2806,20 +2806,14 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
 		   $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
-	$(COMPILER) $<
-	$(COMPILER) $<
 consoleio$(PPUEXT) : consoleio.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 heapmgr$(PPUEXT) : heapmgr.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
-dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-	       $(SYSTEMUNIT)$(PPUEXT)
-	$(COMPILER) $<
+dos$(PPUEXT) : dos.pp $(INC)/fexpand.inc $(INC)/filerec.inc $(INC)/textrec.inc $(INC)/dosh.inc $(INC)/dos.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
-	$(COMPILER) $<
-	$(COMPILER) $<
 sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
 		    objpas$(PPUEXT) sysconst$(PPUEXT) heapmgr$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
@@ -2837,7 +2831,7 @@ fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) varia
 	$(COMPILER) $(OBJPASDIR)/fmtbcd.pp
 types$(PPUEXT) : $(OBJPASDIR)/types.pp math$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/types.pp
-rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(SYSTEMUNIT)$(PPUEXT)
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(OBJPASDIR)/rtlconst.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
 sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/sysconst.pp

+ 7 - 8
rtl/embedded/Makefile.fpc

@@ -227,10 +227,10 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
 #
 
 #ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $<
+#        $(COMPILER) $<
 
 #doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $<
+#        $(COMPILER) $<
 
 consoleio$(PPUEXT) : consoleio.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
@@ -243,21 +243,20 @@ heapmgr$(PPUEXT) : heapmgr.pp $(SYSTEMUNIT)$(PPUEXT)
 # TP7 Compatible RTL Units
 #
 
-dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-               $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/fexpand.inc $(INC)/filerec.inc $(INC)/textrec.inc $(INC)/dosh.inc $(INC)/dos.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $<
 
 #crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $<
+#        $(COMPILER) $<
 
 objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $<
 
 #printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $<
+#        $(COMPILER) $<
 
 #graph$(PPUEXT) : graph.pp
-        $(COMPILER) $<
+#        $(COMPILER) $<
 
 #
 # Delphi Compatible Units
@@ -287,7 +286,7 @@ fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) varia
 types$(PPUEXT) : $(OBJPASDIR)/types.pp math$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/types.pp
 
-rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(SYSTEMUNIT)$(PPUEXT)
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(OBJPASDIR)/rtlconst.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
 
 sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

+ 3 - 7
rtl/freebsd/ptypes.inc

@@ -26,7 +26,7 @@ const
     SEM_SAFE=255;
 type
 
-    dev_t    = cuint32;         { used for device numbers      }
+    dev_t    = cuint64;         { used for device numbers      }
     TDev     = dev_t;
     pDev     = ^dev_t;
 
@@ -35,11 +35,7 @@ type
     pGid     = ^gid_t;
     TIOCtlRequest = cuLong;
 
-    {$ifdef CPU64}
-     ino_t    = cuint32;           { used for file serial numbers }
-    {$else}	
-     ino_t    = clong;           { used for file serial numbers }
-    {$endif}
+    ino_t    = cuint64;           { used for file serial numbers }
     TIno     = ino_t;
     pIno     = ^ino_t;
 
@@ -47,7 +43,7 @@ type
     TMode    = mode_t;
     pMode    = ^mode_t;
 
-    nlink_t  = cuint16;         { used for link counts         }
+    nlink_t  = cuint64;         { used for link counts         }
     TnLink   = nlink_t;
     pnLink   = ^nlink_t;
 

+ 2 - 1
rtl/inc/dos.inc

@@ -232,6 +232,7 @@ end;
 ****************************************************************************}
 
 {$IFNDEF HAS_FSPLIT}
+{$push}
 {$warnings off}
 Procedure FSplit (Path: PathStr; var Dir: DirStr; var Name: NameStr; var Ext: ExtStr);
 var
@@ -275,7 +276,7 @@ begin
   Name := Copy (Path, DirEnd + 1, ExtStart - DirEnd - 1);
   Ext := Copy (Path, ExtStart, Length (Path) - ExtStart + 1);
 end;
-{$warnings on}
+{$pop}
 {$ENDIF HAS_FSPLIT}
 
 

+ 2 - 1
rtl/inc/fexpand.inc

@@ -160,11 +160,12 @@ begin
 {$IFNDEF FPC_FEXPAND_SYSUTILS}
 (* Allow both '/' and '\' as directory separators *)
 (* by converting all to the native one.           *)
+{$push}
 {$warnings off}
 	  for I := 1 to Length (Pa) do
 	    if CharInSet(Pa [I], AllowDirectorySeparators)  then
 	      Pa [I] := DirectorySeparator;
-{$warnings on}
+{$pop}
 {$ENDIF not FPC_FEXPAND_SYSUTILS}
 
 (* PathStart is amount of characters to strip to get beginning *)

+ 2 - 1
rtl/inc/ustrings.inc

@@ -2313,6 +2313,7 @@ function StringCodePage(const S: UnicodeString): TSystemCodePage; overload;
   end;
 
 
+{$push}
 {$warnings off}
 function StubUnicodeCase(const s : UnicodeString) : UnicodeString;
   begin
@@ -2333,7 +2334,7 @@ function StubCompareWideString(const s1, s2 : WideString; Options : TCompareOpti
   begin
     unimplementedunicodestring;
   end;
-{$warnings on}
+{$pop}
 
 procedure initunicodestringmanager;
   begin

+ 62 - 17
rtl/linux/i386/sysnr.inc

@@ -20,6 +20,7 @@
 }
 
 Const
+        syscall_nr_restart_syscall      =  0;
         syscall_nr_exit                 =  1;
         syscall_nr_fork                 =  2;
         syscall_nr_read                 =  3;
@@ -239,10 +240,10 @@ Const
         syscall_nr_pivot_root           = 217;
         syscall_nr_mincore              = 218;
         syscall_nr_madvise              = 219;
-        syscall_nr_madvise1             = 219;  { delete when C lib stub is removed }
+        { syscall_nr_madvise1             = 219; not found in C headers }
         syscall_nr_getdents64           = 220;
         syscall_nr_fcntl64              = 221;
-        syscall_nr_security             = 223;  { syscall for security modules }
+        { syscall_nr_security             = 223; not found in C headers }
         syscall_nr_gettid               = 224;
         syscall_nr_readahead            = 225;
         syscall_nr_setxattr             = 226;
@@ -270,7 +271,7 @@ Const
         syscall_nr_io_submit             = 248;
         syscall_nr_io_cancel             = 249;
         syscall_nr_fadvise64             = 250;
-        syscall_nr_set_zone_reclaim      = 251;
+        { syscall_nr_set_zone_reclaim      = 251; not found in C headers }
         syscall_nr_exit_group            = 252;
         syscall_nr_lookup_dcookie        = 253;
         syscall_nr_epoll_create          = 254;
@@ -279,14 +280,14 @@ Const
         syscall_nr_remap_file_pages      = 257;
         syscall_nr_set_tid_address       = 258;
         syscall_nr_timer_create          = 259;
-        syscall_nr_timer_settime         = syscall_nr_timer_create+1;
-        syscall_nr_timer_gettime         = syscall_nr_timer_create+2;
-        syscall_nr_timer_getoverrun      = syscall_nr_timer_create+3;
-        syscall_nr_timer_delete          = syscall_nr_timer_create+4;
-        syscall_nr_clock_settime         = syscall_nr_timer_create+5;
-        syscall_nr_clock_gettime         = syscall_nr_timer_create+6;
-        syscall_nr_clock_getres          = syscall_nr_timer_create+7;
-        syscall_nr_clock_nanosleep       = syscall_nr_timer_create+8;
+        syscall_nr_timer_settime         = 260;
+        syscall_nr_timer_gettime         = 261;
+        syscall_nr_timer_getoverrun      = 262;
+        syscall_nr_timer_delete          = 263;
+        syscall_nr_clock_settime         = 264;
+        syscall_nr_clock_gettime         = 265;
+        syscall_nr_clock_getres          = 266;
+        syscall_nr_clock_nanosleep       = 267;
         syscall_nr_statfs64              = 268;
         syscall_nr_fstatfs64             = 269;
         syscall_nr_tgkill                = 270;
@@ -297,12 +298,12 @@ Const
         syscall_nr_get_mempolicy         = 275;
         syscall_nr_set_mempolicy         = 276;
         syscall_nr_mq_open               = 277;
-        syscall_nr_mq_unlink             = syscall_nr_mq_open+1;
-        syscall_nr_mq_timedsend          = syscall_nr_mq_open+2;
-        syscall_nr_mq_timedreceive       = syscall_nr_mq_open+3;
-        syscall_nr_mq_notify             = syscall_nr_mq_open+4;
-        syscall_nr_mq_getsetattr         = syscall_nr_mq_open+5;
-        syscall_nr_sys_kexec_load        = 283;
+        syscall_nr_mq_unlink             = 278;
+        syscall_nr_mq_timedsend          = 279;
+        syscall_nr_mq_timedreceive       = 280;
+        syscall_nr_mq_notify             = 281;
+        syscall_nr_mq_getsetattr         = 282;
+        syscall_nr_kexec_load            = 283;
         syscall_nr_waitid                = 284;
         {   syscall_sys_nr_setaltroot      285 }
         syscall_nr_add_key               = 286;
@@ -339,3 +340,47 @@ Const
         syscall_nr_move_pages            = 317;
         syscall_nr_getcpu                = 318;
         syscall_nr_epoll_pwait           = 319;
+        syscall_nr_utimensat             = 320;
+        syscall_nr_signalfd              = 321;
+        syscall_nr_timerfd_create        = 322;
+        syscall_nr_eventfd               = 323;
+        syscall_nr_fallocate             = 324;
+        syscall_nr_timerfd_settime       = 325;
+        syscall_nr_timerfd_gettime       = 326;
+        syscall_nr_signalfd4             = 327;
+        syscall_nr_eventfd2              = 328;
+        syscall_nr_epoll_create1         = 329;
+        syscall_nr_dup3                  = 330;
+        syscall_nr_pipe2                 = 331;
+        syscall_nr_inotify_init1         = 332;
+        syscall_nr_preadv                = 333;
+        syscall_nr_pwritev               = 334;
+        syscall_nr_rt_tgsigqueueinfo     = 335;
+        syscall_nr_perf_event_open       = 336;
+        syscall_nr_recvmmsg              = 337;
+        syscall_nr_fanotify_init         = 338;
+        syscall_nr_fanotify_mark         = 339;
+        syscall_nr_prlimit64             = 340;
+        syscall_nr_name_to_handle_at     = 341;
+        syscall_nr_open_by_handle_at     = 342;
+        syscall_nr_clock_adjtime         = 343;
+        syscall_nr_syncfs                = 344;
+        syscall_nr_sendmmsg              = 345;
+        syscall_nr_setns                 = 346;
+        syscall_nr_process_vm_readv      = 347;
+        syscall_nr_process_vm_writev     = 348;
+        syscall_nr_kcmp                  = 349;
+        syscall_nr_finit_module          = 350;
+        syscall_nr_sched_setattr         = 351;
+        syscall_nr_sched_getattr         = 352;
+        syscall_nr_seccomp               = 354;
+        syscall_nr_getrandom             = 355;
+        syscall_nr_memfd_create          = 356;
+        syscall_nr_bpf                   = 357;
+        syscall_nr_userfaultfd           = 374;
+        syscall_nr_membarrier            = 375;
+        syscall_nr_mlock2                = 376;
+        syscall_nr_copy_file_range       = 377;
+        syscall_nr_pkey_mprotect         = 380;
+        syscall_nr_pkey_alloc            = 381;
+        syscall_nr_pkey_free             = 382;

+ 1 - 0
rtl/linux/powerpc/stat.inc

@@ -43,6 +43,7 @@
         st_mtime  : clong;
         st_mtime_nsec : culong;
         st_ctime  : clong;
+        st_ctime_nsec : culong;
         __unused3_ : culong;
         __unused4_ : culong;
         __unused5_ : culong;

+ 77 - 8
rtl/linux/powerpc/sysnr.inc

@@ -16,6 +16,7 @@
  **********************************************************************}
 
 const
+  syscall_nr_restart_syscall = 0;
   syscall_nr_exit = 1;
   syscall_nr_fork = 2;
   syscall_nr_read = 3;
@@ -283,6 +284,11 @@ const
   syscall_nr_fadvise64_64 = 254;
 {$endif}
   syscall_nr_rtas = 255;
+  syscall_nr_sys_debug_setcontext = 256;
+  syscall_nr_migrate_pages = 258;
+  syscall_nr_mbind = 259;
+  syscall_nr_get_mempolicy = 260;
+  syscall_nr_set_mempolicy = 261;
   syscall_nr_mq_open = 262;
   syscall_nr_mq_unlink = 263;
   syscall_nr_mq_timedsend = 264;
@@ -300,8 +306,8 @@ const
   syscall_nr_inotify_add_watch = 276;
   syscall_nr_inotify_rm_watch = 277;
   syscall_nr_spu_run          = 278;
-  syscall_nr_spu_create       = 278;
-  syscall_nr_pselect6         = 289;
+  syscall_nr_spu_create       = 279;
+  syscall_nr_pselect6         = 280;
   syscall_nr_ppoll            = 281;
   syscall_nr_unshare          = 282;
   syscall_nr_splice           = 283;
@@ -312,7 +318,11 @@ const
   syscall_nr_mknodat          = 288;
   syscall_nr_fchownat         = 289;
   syscall_nr_futimesat        = 290;
-  syscall_nr_sys_fstatat64    = 291;
+{$ifdef cpu32}
+  syscall_nr_fstatat64        = 291;
+{$else}
+  syscall_nr_newfstatat       = 291;
+{$endif}
   syscall_nr_unlinkat         = 292;
   syscall_nr_renameat         = 293;
   syscall_nr_linkat           = 294;
@@ -326,8 +336,67 @@ const
   syscall_nr_getcpu           = 302;
   syscall_nr_epoll_pwait      = 303;
   syscall_nr_utimensat        = 304;
-  syscall_nr_fallocate        = 305;
-  syscall_nr_signalfd         = 306;
-  syscall_nr_timerfd          = 307;
-  syscall_nr_eventfd          = 308;
-  syscall_nr_sync_file_range2 = 309;
+  syscall_nr_signalfd         = 305;
+  syscall_nr_timerfd_create   = 306;
+  syscall_nr_eventfd          = 307;
+  syscall_nr_sync_file_range2 = 308;
+  syscall_nr_fallocate        = 309;
+  syscall_nr_subpage_prot     = 310;
+  syscall_nr_timerfd_settime  = 311;
+  syscall_nr_timerfd_gettime  = 312;
+  syscall_nr_signalfd4        = 313;
+  syscall_nr_eventfd2         = 314;
+  syscall_nr_epoll_create1    = 315;
+  syscall_nr_dup3             = 316;
+  syscall_nr_pipe2            = 317;
+  syscall_nr_inotify_init1    = 318;
+  syscall_nr_perf_event_open  = 319;
+  syscall_nr_preadv           = 320;
+  syscall_nr_pwritev          = 321;
+  syscall_nr_rt_tgsigqueueinfo = 322;
+  syscall_nr_fanotify_init    = 323;
+  syscall_nr_fanotify_mark    = 324;
+  syscall_nr_prlimit64        = 325;
+  syscall_nr_socket           = 326;
+  syscall_nr_bind             = 327;
+  syscall_nr_connect          = 328;
+  syscall_nr_listen           = 329;
+  syscall_nr_accept           = 330;
+  syscall_nr_getsockname      = 331;
+  syscall_nr_getpeername      = 332;
+  syscall_nr_socketpair       = 333;
+  syscall_nr_send             = 334;
+  syscall_nr_sendto           = 335;
+  syscall_nr_recv             = 336;
+  syscall_nr_recvfrom         = 337;
+  syscall_nr_shutdown         = 338;
+  syscall_nr_setsockopt       = 339;
+  syscall_nr_getsockopt       = 340;
+  syscall_nr_sendmsg          = 341;
+  syscall_nr_recvmsg          = 342;
+  syscall_nr_recvmmsg         = 343;
+  syscall_nr_accept4          = 344;
+  syscall_nr_name_to_handle_at = 345;
+  syscall_nr_open_by_handle_at = 346;
+  syscall_nr_clock_adjtime    = 347;
+  syscall_nr_syncfs           = 348;
+  syscall_nr_sendmmsg         = 349;
+  syscall_nr_setns            = 350;
+  syscall_nr_process_vm_readv = 351;
+  syscall_nr_process_vm_writev = 352;
+  syscall_nr_finit_module     = 353;
+  syscall_nr_kcmp             = 354;
+  syscall_nr_sched_setattr    = 355;
+  syscall_nr_sched_getattr    = 356;
+  syscall_nr_renameat2        = 357;
+  syscall_nr_seccomp          = 358;
+  syscall_nr_getrandom        = 359;
+  syscall_nr_memfd_create     = 360;
+  syscall_nr_bpf              = 361;
+  syscall_nr_execveat         = 362;
+  syscall_nr_switch_endian    = 363;
+  syscall_nr_userfaultfd      = 364;
+  syscall_nr_membarrier       = 365;
+  syscall_nr_mlock2           = 378;
+  syscall_nr_copy_file_range  = 379;
+

+ 4 - 2
rtl/linux/ptypes.inc

@@ -195,7 +195,8 @@ Type
     fsid    : array[0..1] of cint;          { File system ID }
     namelen : clong; { Maximum name length in system }
     frsize  : clong;
-    spare   : array [0..4] of clong; { For later use }
+    flags   : clong; 
+    spare   : array [0..3] of clong; { For later use }
   end;
   {$else}
   TStatfs = record
@@ -209,7 +210,8 @@ Type
     fsid    : array[0..1] of cint;          { File system ID }
     namelen,           { Maximum name length in system }
     frsize  : cint;
-    spare   : array [0..4] of cint; { For later use }
+    flags   : cint; 
+    spare   : array [0..3] of cint; { For later use }
   end;
   {$endif}
   PStatFS=^TStatFS;

+ 49 - 1
rtl/linux/x86_64/sysnr.inc

@@ -340,4 +340,52 @@ const
   syscall_nr_sync_file_range    = 277;
   syscall_nr_vmsplice           = 278;
   syscall_nr_move_pages         = 279;
-
+  syscall_nr_utimensat          = 280;
+  syscall_nr_epoll_pwait        = 281;
+  syscall_nr_signalfd           = 282;
+  syscall_nr_timerfd_create     = 283;
+  syscall_nr_eventfd            = 284;
+  syscall_nr_fallocate          = 285;
+  syscall_nr_timerfd_settime    = 286;
+  syscall_nr_timerfd_gettime    = 287;
+  syscall_nr_accept4            = 288;
+  syscall_nr_signalfd4          = 289;
+  syscall_nr_eventfd2           = 290;
+  syscall_nr_epoll_create1      = 291;
+  syscall_nr_dup3               = 292;
+  syscall_nr_pipe2              = 293;
+  syscall_nr_inotify_init1      = 294;
+  syscall_nr_preadv             = 295;
+  syscall_nr_pwritev            = 296;
+  syscall_nr_rt_tgsigqueueinfo  = 297;
+  syscall_nr_perf_event_open    = 298;
+  syscall_nr_recvmmsg           = 299;
+  syscall_nr_fanotify_init      = 300;
+  syscall_nr_fanotify_mark      = 301;
+  syscall_nr_prlimit64          = 302;
+  syscall_nr_name_to_handle_at  = 303;
+  syscall_nr_open_by_handle_at  = 304;
+  syscall_nr_clock_adjtime      = 305;
+  syscall_nr_syncfs             = 306;
+  syscall_nr_sendmmsg           = 307;
+  syscall_nr_setns              = 308;
+  syscall_nr_getcpu             = 309;
+  syscall_nr_process_vm_readv   = 310;
+  syscall_nr_process_vm_writev  = 311;
+  syscall_nr_kcmp               = 312;
+  syscall_nr_finit_module       = 313;
+  syscall_nr_sched_setattr      = 314;
+  syscall_nr_sched_getattr      = 315;
+  syscall_nr_renameat2          = 316;
+  syscall_nr_seccomp            = 317;
+  syscall_nr_getrandom          = 318;
+  syscall_nr_memfd_create       = 319;
+  syscall_nr_kexec_file_load    = 320;
+  syscall_nr_bpf                = 321;
+  syscall_nr_userfaultfd        = 323;
+  syscall_nr_membarrier         = 324;
+  syscall_nr_mlock2             = 325;
+  syscall_nr_copy_file_range    = 326;
+  syscall_nr_pkey_mprotect      = 329;
+  syscall_nr_pkey_alloc         = 330;
+  syscall_nr_pkey_free          = 331;

+ 2 - 1
rtl/objpas/classes/streams.inc

@@ -1047,6 +1047,7 @@ begin
   inherited Destroy;
 end;
 
+{$push}
 {$warnings off}
 function TStreamAdapter.Read(pv: Pointer; cb: DWORD; pcbRead: PDWORD): HResult; stdcall;
 var
@@ -1267,4 +1268,4 @@ begin
   raise e;
 end;
 
-{$warnings on}
+{$pop}

+ 3 - 3
rtl/objpas/fgl.pp

@@ -900,7 +900,7 @@ end;
 
 function TFPGList.GetList: PTypeList;
 begin
-  Result := PTypeList(FList);
+  Result := PTypeList(@FList);
 end;
 
 function TFPGList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
@@ -1035,7 +1035,7 @@ end;
 
 function TFPGObjectList.GetList: PTypeList;
 begin
-  Result := PTypeList(FList);
+  Result := PTypeList(@FList);
 end;
 
 function TFPGObjectList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
@@ -1165,7 +1165,7 @@ end;
 
 function TFPGInterfacedObjectList.GetList: PTypeList;
 begin
-  Result := PTypeList(FList);
+  Result := PTypeList(@FList);
 end;
 
 function TFPGInterfacedObjectList.ItemPtrCompare(Item1, Item2: Pointer): Integer;

+ 45 - 1
rtl/objpas/sysutils/sysencoding.inc

@@ -22,7 +22,13 @@ begin
   try
 {$endif}
     if not Assigned(FStandardEncodings[seAnsi]) then
-      FStandardEncodings[seAnsi] := TMBCSEncoding.Create(DefaultSystemCodePage);
+    begin
+      // DefaultSystemCodePage can be set to non-ANSI
+      if Assigned(widestringmanager.GetStandardCodePageProc) then
+        FStandardEncodings[seAnsi] := TMBCSEncoding.Create(widestringmanager.GetStandardCodePageProc(scpAnsi))
+      else
+        FStandardEncodings[seAnsi] := TMBCSEncoding.Create(DefaultSystemCodePage);
+    end;
 {$ifdef FPC_HAS_FEATURE_THREADING}
   finally
     LeaveCriticalSection(FLock);
@@ -91,6 +97,40 @@ begin
   Result := GetANSI;
 end;
 
+class function TEncoding.GetSystemEncoding: TEncoding;
+var
+  I: Integer;
+begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  EnterCriticalSection(FLock);
+  try
+{$endif}
+    for I := Low(FSystemEncodings) to High(FSystemEncodings) do
+    begin
+      if FSystemEncodings[I].CodePage=DefaultSystemCodePage then
+      begin
+        Result := FSystemEncodings[I];
+        if I<>Low(FSystemEncodings) then // exchange with first position to find it faster the next time
+        begin
+          FSystemEncodings[I] := FSystemEncodings[Low(FSystemEncodings)];
+          FSystemEncodings[Low(FSystemEncodings)] := Result;
+        end;
+        Exit;
+      end;
+    end;
+    // not found - create new encoding at first position
+    Result := TMBCSEncoding.Create(DefaultSystemCodePage);
+    SetLength(FSystemEncodings, Length(FSystemEncodings)+1);
+    if High(FSystemEncodings)<>Low(FSystemEncodings) then
+      FSystemEncodings[High(FSystemEncodings)] := FSystemEncodings[Low(FSystemEncodings)];
+    FSystemEncodings[Low(FSystemEncodings)] := Result;
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  finally
+    LeaveCriticalSection(FLock);
+  end;
+{$endif}
+end;
+
 class function TEncoding.GetUnicode: TEncoding;
 begin
 {$ifdef FPC_HAS_FEATURE_THREADING}
@@ -142,6 +182,7 @@ end;
 class procedure TEncoding.FreeEncodings;
 var
   E: TStandardEncoding;
+  I: Integer;
 begin
 {$ifdef FPC_HAS_FEATURE_THREADING}
   EnterCriticalSection(FLock);
@@ -149,6 +190,9 @@ begin
 {$endif}
     for E := Low(FStandardEncodings) to High(FStandardEncodings) do
       FreeAndNil(FStandardEncodings[E]);
+    for I := Low(FSystemEncodings) to High(FSystemEncodings) do
+      FSystemEncodings[I].Free;
+    SetLength(FSystemEncodings, 0);
 {$ifdef FPC_HAS_FEATURE_THREADING}
   finally
     LeaveCriticalSection(FLock);

+ 3 - 0
rtl/objpas/sysutils/sysencodingh.inc

@@ -30,12 +30,14 @@ type
         seUTF8);
     var
       FStandardEncodings: array[TStandardEncoding] of TEncoding; static;
+      FSystemEncodings: array of TEncoding; static;
     Class Var
       FLock : TRTLCriticalSection;
     class function GetANSI: TEncoding; static;
     class function GetASCII: TEncoding; static;
     class function GetBigEndianUnicode: TEncoding; static;
     class function GetDefault: TEncoding; static;
+    class function GetSystemEncoding: TEncoding; static;
     class function GetUnicode: TEncoding; static;
     class function GetUTF7: TEncoding; static;
     class function GetUTF8: TEncoding; static;
@@ -99,6 +101,7 @@ type
     class property ASCII: TEncoding read GetASCII;
     class property BigEndianUnicode: TEncoding read GetBigEndianUnicode;
     class property Default: TEncoding read GetDefault;
+    class property SystemEncoding: TEncoding read GetSystemEncoding;
     class property Unicode: TEncoding read GetUnicode;
     class property UTF7: TEncoding read GetUTF7;
     class property UTF8: TEncoding read GetUTF8;

+ 6 - 3
rtl/openbsd/ptypes.inc

@@ -61,7 +61,7 @@ type
     pSize    = ^size_t;
     pSize_t  = ^size_t;
 
-    ssize_t  = cint32;          { used by function for returning number of bytes }
+    ssize_t  = clong;          { used by function for returning number of bytes }
     TsSize   = ssize_t;
     psSize   = ^ssize_t;
 
@@ -107,7 +107,6 @@ type
    pthread_mutexattr_t_rec	= record end;
    pthread_cond_t_rec		= record end;
    pthread_condattr_t_rec	= record end;
-   pthread_once_t_rec		= record end;
    pthread_rwlock_t_rec   	= record end;
    pthread_rwlockattr_t_rec	= record end;
 
@@ -118,7 +117,11 @@ type
    pthread_cond_t       = ^pthread_cond_t_rec;
    pthread_condattr_t   = ^pthread_condattr_t_rec;
    pthread_key_t        = cint;
-   pthread_once_t	= ^pthread_once_t_rec;
+   pthread_once_t_rec		= record
+     state : cint;
+     mutex : pthread_mutex_t;
+   end;
+   pthread_once_t	= pthread_once_t_rec;
    pthread_rwlock_t     = ^pthread_rwlock_t_rec;
    pthread_rwlockattr_t = ^pthread_rwlockattr_t_rec;
 

+ 60 - 0
rtl/openbsd/t_openbsd.h2paschk

@@ -8,8 +8,11 @@
 # supported architecture.
 
 @Pascal uses baseunix;
+@Pascal {$i ptypes.inc}
+@Pascal {$i ostypes.inc}
 @Pascal begin
 
+# Adds support for M_PIl constant inside math.h header
 @C #include <sys/types.h>
 @C #include <sys/stat.h>
 @C #include <sys/time.h>
@@ -23,9 +26,66 @@
 @C #include <unistd.h>
 @C #include <stdio.h>
 @C #include <stddef.h>
+@C #include <fcntl.h>
+@C #include <pthread.h>
+@C #include <netdb.h>
+@C #include <semaphore.h>
+@C #include <wchar.h>
+@C #include <math.h>
 @C int main()
 @C {
 
+@type dev_t
+@type gid_t
+@type ino_t
+@type mode_t
+@type nlink_t
+@type off_t
+@type pid_t
+@type size_t
+@type ssize_t
+@type uid_t
+@type wint_t
+@type clock_t
+@type time_t
+@type socklen_t
+
+@record timeval,struct timeval
+.tv_sec
+.tv_usec
+
+@record timespec,struct timespec
+.tv_sec
+.tv_nsec
+
+@type pthread_t
+@type pthread_attr_t
+@type pthread_mutex_t
+@type pthread_mutexattr_t
+@type pthread_cond_t
+@type pthread_condattr_t
+@type pthread_key_t
+@type pthread_rwlock_t
+@type pthread_rwlockattr_t
+@type sem_t
+@type rlim_t
+
+@record pthread_once_t,struct pthread_once
+.state
+.mutex
+
+@constant O_RDONLY
+@constant O_WRONLY
+@constant O_RDWR
+@constant O_CREAT
+@constant O_EXCL
+@constant O_TRUNC
+@constant O_NOCTTY
+@constant O_APPEND
+@constant O_NONBLOCK
+
+@floatconstant PI,M_PI
+
 @record stat,struct stat
 .st_mode
 .st_dev

+ 322 - 37
rtl/unix/scripts/check_sys.sh

@@ -7,20 +7,79 @@
 syscall_header=/usr/include/syscall.h
 fpc_sysnr=./sysnr.inc
 
-os=`uname -s`
+i=0
+for arg in $* ; do
+  let i++
+  echo "Handling arg $i, \"$arg\""
+  if [ "${arg//=}" != "$arg" ] ; then
+    echo "Evaluating $arg"
+    eval $arg
+  elif [ "$arg" == "-v" ] ; then
+    verbose=1
+  else
+    echo "arg not handled!"
+  fi
+done
 
-if [ "$os" == "OpenBSD" ] ; then
-  c_syscall_header=sys/syscall.h
-else
-  c_syscall_header=syscall.h
+start_pwd=`pwd`
+start_dir=`basename $start_pwd`
+
+if [ -d "rtl" ] ; then
+  echo "Entering rtl directory"
+  cd rtl
+fi
+
+os=`uname -s | tr [:upper:] [:lower:] `
+now_pwd=`pwd`
+now_dir=`basename $now_pwd`
+if [ -d "$os" ] ; then
+  echo "Entering $os directory"
+  cd $os
+fi
+
+case "$os" in
+  freebsd|openbsd|netbsd) c_syscall_header=sys/syscall.h;;
+  *)  c_syscall_header=syscall.h;;
+esac
+
+if [ -z "$FPC" ] ; then
+  FPC=fpc
 fi
 
-if ! [ -f $fpc_sysnr ] ; then
-  cpu=`fpc -iTP`
+if [ ! -f $fpc_sysnr ] ; then
+  cpu=`$FPC -iTP`
+  if [ "${cpu//sparc/}" != "$cpu" ] ; then
+    cpu=sparcgen
+  fi
   fpc_sysnr=./$cpu/sysnr.inc
+  if [ ! -f "$fpc_sysnr" ] ; then
+    fpc_sysnr=`ls -1 ./${cpu}*/sysnr.inc| head -1`
+  fi
+  if [ ! -f "$fpc_sysnr" ] ; then
+    if [ "${cpu//sparc/}" != "$cpu" ] ; then
+      cpu=sparcgen
+    fi
+    fpc_sysnr=./$cpu/sysnr.inc
+    if [ ! -f "$fpc_sysnr" ] ; then
+      echo "sysnr.inc file not found, try again in rtl/$os directory"
+      exit
+    fi
+  fi
 fi
 
-verbose=0
+if [ -f "$fpc_sysnr" ] ; then
+  echo "Checking $fpc_sysnr content for Free Pascal syscall numbers"
+  fpc_sysnr_dir=`dirname $fpc_sysnr `
+  sysnr_includes=`grep -o '{\$i  *[a-z_A-Z0-9/.]*' $fpc_sysnr | sed 's:.*{\$i *:'$fpc_sysnr_dir/: `
+  if [ -n "$sysnr_includes" ] ; then
+    echo "Found $sysnr_includes include files"
+    fpc_sysnr="$fpc_sysnr $sysnr_includes"
+  fi
+fi
+
+if [ -z "$verbose" ] ; then
+  verbose=0
+fi
 
 os=`uname -s`
 
@@ -39,22 +98,64 @@ EOF
 # Can be overwritten by setting CC variable
 # But I don't know if other compilers also generate
 # .i files with --save-temps option
-if [ "$CC" == "" ] ; then
+if [ -z "$CC" ] ; then
   CC=gcc
 fi
 
+cpu=`$FPC -iTP`
+is_16=0
+is_32=0
+is_64=0
+case $cpu in
+  aarch64)   is_64=1;;
+  alpha)     is_32=1;;
+  arm)       is_32=1;;
+  avr)       is_16=1;;
+  i386)      is_32=1;;
+  i8086)     is_16=1;;
+  ia64)      is_64=1;;
+  jvm)       is_32=1;;
+  m68k)      is_32=1;;
+  mips)      is_32=1;;
+  mipsel)    is_32=1;;
+  powerpc)   is_32=1;;
+  powerpc64) is_64=1;;
+  riscv32)   is_32=1;;
+  riscv64)   is_64=1;;
+  sparc)     is_32=1;;
+  sparc64)   is_64=1;;
+  vis)       is_32=1;;
+  x86_64)    is_64=1;;
+esac
+
+if [ $is_64 -eq 1 ] ; then
+  CC_OPT="$CC_OPT -m64"
+  CPUBITS=64
+elif [ $is_32 -eq 1 ] ;then
+  CC_OPT="$CC_OPT -m32"
+  CPUBITS=32
+elif [ $is_16 -eq 1 ] ; then
+  CPUBITS=16
+else
+  CPUBITS=unknown
+fi
+
 # Use gcc with --save-temps option to create .i file
-$CC --save-temps -o test-syscall ./test-syscall.c
+echo "Calling $CC $CC_OPT --save-temps -o test-syscall ./test-syscall.c"
+$CC $CC_OPT --save-temps -o ./test-syscall ./test-syscall.c
 res=$?
 if [ $res -ne 0 ] ; then
   echo "Call to $CC failed"
   exit
+else
+  rm -f ./test-syscall.c ./test-syscall
 fi
 # list of errno.h headers listed
 syscall_headers=` sed -n "s:.*\"\(.*/.*\.h\)\".*:\1:p" test-syscall.i |sort | uniq`
-echo "Headers found are \"$syscall_headers\""
+rm -f test-syscall.*
+echo "C syscall headers files found are \"$syscall_headers\""
 
-if [ "$syscall_headers" != "" ] ; then
+if [ -n "$syscall_headers" ] ; then
   syscall_header="$syscall_headers"
 fi
 
@@ -70,15 +171,109 @@ fi
 
 # You should only need to change the variables above
 
-sed -n "s:^[ \t]*${fpc_syscall_prefix}\\([_a-zA-Z0-9]*\\)[ \t]*=[ \t]*\\([0-9]*\\).*:check_syscall_number ${syscall_prefix}\1 \2:p" ${fpc_sysnr} > check_sys_list.sh
-sed -n "s:^.*define[[:space:]]*${syscall_prefix}\\([_a-zA-Z0-9]*\\)[[:space:]]*\\([0-9]*\\).*:check_syscall_number_reverse ${fpc_syscall_prefix}\1 \2:p" ${syscall_header} > check_sys_list_reverse.sh
+awkfile=preproc.awk
+tmp_fpc_sysnr=tmp-sysnr-${cpu}.inc
+
+c_syscall_source=test-syscall-${cpu}.c
+
+# Test C file to grab all loaded headers
+# must be called with -DSYS_MACRO=$sys
+cat > $c_syscall_source <<EOF
+#include <${c_syscall_header}>
+#include <stdio.h>
+
+int
+main ()
+{
+  printf ("%d\n", (int) SYS_MACRO);
+  return 0;
+}
+EOF
+
+cat > $awkfile <<EOF
+BEGIN {IGNORECASE = 1;
+enable=1;
+macro="";
+incfile="";
+cpu= "cpu" proc;
+cpubits= "cpu" cpubits;
+}
+/\{\\\$i / { incfile=\$2;
+  print "Include file  " incfile " found"; }
+/\{\\\$ifdef / { macro=gensub("[^A-Za-z_0-9].*","","",\$2);
+  if ( (macro == cpu) || (macro == cpubits)) { enable=1;
+    print "// ifdef " macro " found and accepted at line " FNR;
+  } else {enable=0;
+    print "// ifdef " macro " found and rejected at line " FNR;
+  };
+  }
+/\{\\\$ifndef / { macro=gensub("[^A-Za-z_0-9].*","","",\$2);
+  if ( (macro == cpu) || (macro == cpubits) ) { enable=0;
+   print "// ifndef " macro " found and rejected at line " FNR;
+ } else {enable=1;
+   print "// ifndef " macro " found and accepted at line " FNR;
+ };
+  }
+/\{\\\$else/ { if (enable == 1) {enable=0;} else {enable = 1;}}
+/.*/ { if (enable == 1) {
+  wholeline=\$0;
+  code=gensub("{.*}","","g",\$0);
+  code=gensub("[(][*].*[*][)]","","g",code);
+  comments=gensub(code,"","",\$0);
+  comments1=gensub(".*({.*}).*","\1","g",comments);
+  if (comments == comments1)
+    comments1="";
+  comments2=gensub(".*[(][*].*[*][)]).*","\1","g",comments);
+  if (comments == comments2)
+    comments2="";
+  comments3=gensub(".*//","","",comments);
+  if (comments == comments3)
+    comments3="";
+  all_comments= comments1 comments2 comments3;
+  if (all_comments != "")
+    print code "// " comments1 comments2 comments3 ;
+  else
+    print code;
+  } 
+}
+/\{\\\$endif/ {enable=1;}
+EOF
+
+if [ -z "$AWK" ] ; then
+  AWK=`which gawk 2> /dev/null`
+fi
+
+if [ -z "$AWK" ] ; then
+  AWK=`which awk 2> /dev/null`
+fi
+
+if [ -n "$AWK" ] ; then
+  echo "Preprocessing ${fpc_sysnr} to $tmp_fpc_sysnr"
+  echo "$AWK -v proc=$cpu -v cpubits=$CPUBITS -f $awkfile ${fpc_sysnr} > $tmp_fpc_sysnr"
+  $AWK -v proc=$cpu -v cpubits=$CPUBITS -f $awkfile ${fpc_sysnr} > $tmp_fpc_sysnr
+  fpc_sysnr=$tmp_fpc_sysnr
+fi
+sed -n "s:^\(.*\)*[ \t]*${fpc_syscall_prefix}\\([_a-zA-Z0-9]*\\)[ \t]*=[ \t]*\\([0-9]*\\)\\(.*\\)$:check_c_syscall_number_from_fpc_rtl \2 \3 \"\1 \4\":p" $fpc_sysnr > check_sys_list.sh
+
+
+sed -n "s:^.*#[[:space:]]*define[[:space:]]*${syscall_prefix}\\([_a-zA-Z0-9]*\\)[[:space:]]*\\([0-9]*\\)\\(.*\\)$:check_c_syscall_number_in_fpc_rtl \1 \2 \"\3\":p" ${syscall_header} > check_sys_list_reverse.sh
  
+forward_count=0
+forward_ok_count=0
+forward_failure_count=0
 
-function check_syscall_number ()
+function check_c_syscall_number_from_fpc_rtl ()
 {
-  sys=$1
+  bare_sys=$1
+  sys=${syscall_prefix}$bare_sys
   value=$2
+  comment="$3"
+  if [[ ! ( ( -n "$value" ) && ( $value -ge 0 ) ) ]] ; then
+    echo "Computing $2 value"
+    let value=$2
+  fi
   obsolete=0
+  let forward_count++
   if [[ "$value" =~ ^[0-9]+$ ]] ; then
     eval $sys=\$$value
     if [ $verbose -ne 0 ] ; then
@@ -92,11 +287,28 @@ function check_syscall_number ()
   fi
   # Remember this value for later
   eval $sys=$value
-  if [ $verbose -ne 0 ] ; then
-    echo Testing $sys value $value
+  echo -en "Testing $sys value $value                    \r"
+  found=`sed -n "/#[[:space:]]*define[[:space:]]*${sys}[^A-Za-z0-9_]/p" ${syscall_header}`
+  val=`sed -n "s:#[[:space:]]*define[[:space:]]*${sys}[^A-Za-z0-9_][^A-Za-z0-9_]*\([0-9]*\).*:\1:p" ${syscall_header}`
+  $CC $CC_OPT -DSYS_MACRO=${syscall_prefix}${bare_sys} -o ./test_c_${bare_sys} $c_syscall_source > ./test_${bare_sys}.comp-log 2>&1
+  C_COMP_RES=$?
+  if [ $C_COMP_RES -eq 0 ] ; then
+    CC_value=`./test_c_${bare_sys} `
+    if [ "$value" != "$CC_value" ] ; then
+      echo "$CC returns $CC_value, while $value is expected"
+      let forward_failure_count++
+      return
+    else
+      rm -f ./test_c_${bare_sys}
+    fi
+    rm -f ./test-${bare_sys}.comp-log
+  else
+    echo "$CC failed to compile code containing $sys syscall number $value"
+    echo "$CC $CC_OPT -DSYS_MACRO=${syscall_prefix}${bare_sys} -o ./test_c_${bare_sys} $c_syscall_source > ./test_${bare_sys}.comp-log 2>&1"
+    let forward_failure_count++
+    return
   fi
-  found=`sed -n "/#define[[:space:]]*${sys}[^A-Za-z0-9_]/p" ${syscall_header}`
-  val=`sed -n "s:#define[[:space:]]*${sys}[^A-Za-z0-9_][^A-Za-z0-9_]*\([0-9]*\).*:\1:p" ${syscall_header}`
+
   if [ $verbose -ne 0 ] ; then
     echo Test for $sys found \"${found}\" \"${value}\" \"${val}\"
   fi
@@ -104,34 +316,87 @@ function check_syscall_number ()
     if [ $verbose -ne 0 ] ; then
       echo ${sys} value ${val} is correct
     fi
+    let forward_ok_count++
   else
-    if [ "${val}" == "" ] ; then
-      found=`sed -n "/#define.*[^A-Za-z0-9_]${value}$/p" ${syscall_header}`
-      if [ "${found}" == "" ] ; then
+    if [ -z "${val}" ] ; then
+      found=`sed -n ".*define[[:space:]].*[^A-Za-z0-9_][[:space:]]${value}$/p" ${syscall_header}`
+      if [ -z "${found}" ] ; then
         found=`sed -n "s:\/\* ${value} is compa:/* ${value} is compa:p" ${syscall_header}`
-        if [ "$found" != "" ] ; then
+        if [ -n "$found" ] ; then
           obsolete=1
         fi
       fi
     fi
-    if [ "$found" == "" ] ; then
+    if [ -z "$found" ] ; then
       found=`grep -n -w $value ${syscall_header}`
     fi
     if [ $obsolete -eq 1 ] ; then
-      echo Warning: ${sys} expected ${value}, is obsolete line is \"${found}\"
+      echo Warning: ${bare_sys} expected ${value}, is obsolete line is \"${found}\"
     else
-      echo Problem: ${sys} expected ${value}, line is \"${found}\", val found is \"${val}\"
+      echo Problem: ${bare_sys} expected ${value}, line is \"${found}\", val found is \"${val}\"
     fi
+    let forward_failure_count++
   fi
 }
 
-function check_syscall_number_reverse ()
+reverse_count=0
+reverse_ok_count=0
+reverse_failure_count=0
+add_file=./add_missing_syscalls.inc
+suggested_addition_count=0
+echo "{ Generated by check_rtl_sys.sh script }" > $add_file
+
+function check_c_syscall_number_in_fpc_rtl ()
 {
-  sys=$1
+  bare_sys=$1
+  sys=${fpc_syscall_prefix}${bare_sys}
+  c_sys=${syscall_prefix}${bare_sys}
   value=$2
+  comment="$3"
+  echo -en "Testing $sys value $value                        \r"
+  $CC $CC_OPT -DSYS_MACRO=${c_sys} -o ./test_c_${bare_sys} $c_syscall_source > ./test_${bare_sys}.comp-log 2>&1
+  C_COMP_RES=$?
+  if [ $C_COMP_RES -eq 0 ] ; then
+    rm ./test_${bare_sys}.comp-log
+    CC_value=`./test_c_${bare_sys} `
+    if [ "$value" != "$CC_value" ] ; then
+      echo "For sys=$sys, $CC returns $CC_value, while $value is expected"
+      let reverse_failure_count++
+      return
+    else
+      rm -f ./test_c_$bare_sys
+    fi
+  else
+    # if C syscall is not accepted do nothing
+    #echo "For sys=$sys, $CC compilation failed"
+    #cat ./test_${bare_sys}.comp-log
+    # let reverse_failure_count++
+    rm -f ./test_c_${bare_sys}
+    rm ./test_${bare_sys}.comp-log
+    return
+  fi
+
+  if [ $verbose -ne 0 ] ; then
+    echo "Full comment is \"$comment \""
+  fi
+  if [ "${comment/*\/\*/}" != "$comment" ] ; then
+    comment="${comment/*\/\*/}"
+    if [ $verbose -ne 0 ] ; then
+      echo "comment is \"$comment \""
+    fi
+    comment="${comment/\*\/*/}"
+    if [ $verbose -ne 0 ] ; then
+      echo "comment is \"$comment \""
+    fi
+    comment=`echo $comment | sed 's:^[[:space:]]*\(.*\)[[:space:]]*$:\1' `
+    if [ $verbose -ne 0 ] ; then
+      echo "comment is \"$comment \""
+    fi
+  fi
   if [ $verbose -ne 0 ] ; then
     echo Testing syscall header entry $sys value $value
   fi
+  let reverse_count++
   found=`sed -n "/.*${sys}/p" ${fpc_sysnr}`
   val=`sed -n "s:.*${sys}[ \t]*=[ \t]*\([0-9]*\).*:\1:p" ${fpc_sysnr}`
   if [ $verbose -ne 0 ] ; then
@@ -141,14 +406,24 @@ function check_syscall_number_reverse ()
     if [ $verbose -ne 0 ] ; then
       echo ${sys} value ${val} is correct
     fi
+    let reverse_ok_count++
   else
-    if [ "${val}" == "" ] ; then
-      found=`sed -n "/#define.*[^A-Za-z0-9_]${value}$/p" ${syscall_header}`
-      if [ "${found}" == "" ] ; then
-        found=`sed -n "s:\/\* ${value} is compa: ${value} is compa:p" ${syscall_header}`
+    if [ -z "${val}" ] ; then
+      found=`sed -n "/#[[:space:]]*define.*[^A-Za-z0-9_][[:space:]]*${value}([[:space:]]|$)/p" ${syscall_header}`
+      if [ -z "${found}" ] ; then
+        found=`sed -n "s:\/\*.*i[[:space:]]${value} is compa: ${value} is compa:p" ${syscall_header}`
       fi
     fi
-    echo Problem: ${sys} expected ${value}, line is \"${found}\", val found is \"${val}\"
+    echo "Problem: ${bare_sys} expected ${value}, line is \"${found}\", val found is \"${val}\""
+    if [ -n "$comment" ] ; then
+      echo "    ${fpc_syscall_prefix}${bare_sys} = ${value}; { $comment }" >> $add_file
+      echo "Suggest adding:  ${fpc_syscall_prefix}${bare_sys} = ${value}; { $comment }"
+    else
+      echo "    ${fpc_syscall_prefix}${bare_sys} = ${value};" >> $add_file
+      echo "Suggest adding:  ${fpc_syscall_prefix}${bare_sys} = ${value};"
+    fi
+    let suggested_addition_count++
+    let reverse_failure_count++
   fi
 }
 
@@ -157,8 +432,18 @@ function check_syscall_number_reverse ()
 # to system define 
 set -f
 
-echo "Checking values from \"${fpc_sysnr}\" in \"${syscall_header}\""
+echo "Checking values from \"${fpc_sysnr}\" in C syscall headers"
 source ./check_sys_list.sh
-echo "Checking if values in \"${syscall_header}\" are missing in \"${fpc_sysnr}\""
+echo "Checking if values in C syscall headers are in \"${fpc_sysnr}\""
 source ./check_sys_list_reverse.sh
-
+echo "Forward counts: OK=$forward_ok_count, failures=$forward_failure_count, total=$forward_count"
+echo "Reverse counts: OK=$reverse_ok_count, failures=$reverse_failure_count, total=$reverse_count"
+if [ $suggested_addition_count -gt 0 ] ; then
+  echo "Missing $suggested_addition_count syscall numbers in $add_file"
+else
+ rm $add_file
+fi
+rm ./check_sys_list.sh ./check_sys_list_reverse.sh ./$awkfile
+if [ -f "$tmp_fpc_sysnr" ] ; then
+  echo   rm $tmp_fpc_sysnr
+fi

+ 1 - 0
rtl/win/wininc/ascdef.inc

@@ -480,6 +480,7 @@ function FindFirstFileEx(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lp
 function FindFirstFileTransacted(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall;
     external 'kernel32' name 'FindFirstFileTransactedA';
 function GetComputerNameEx(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExA';
+function QueryFullProcessImageName(hProcess:THandle;dwFlags:DWord; lpexename :lpstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameA';
 {$endif read_interface}
 
 

+ 1 - 0
rtl/win/wininc/ascfun.inc

@@ -493,6 +493,7 @@ function GetConsoleAliasExesLengthA:DWORD;stdcall;external 'kernel32' name 'GetC
 function GetConsoleAliasesA(AliasBuffer:LPSTR; AliasBufferLength:DWORD; ExeName:LPSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesA';
 function GetConsoleAliasExesA(ExeNameBuffer:LPSTR; ExeNameBufferLength:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesA';
 function GetComputerNameExA(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExA';
+function QueryFullProcessImageNameA(hProcess:THandle;dwFlags:DWord; lpexename :lpstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameA';
 {$endif read_interface}
 
 

+ 3 - 3
rtl/win/wininc/defines.inc

@@ -1167,6 +1167,7 @@
      PROCESS_CREATE_THREAD = 2;
      PROCESS_DUP_HANDLE = 64;
      PROCESS_QUERY_INFORMATION = 1024;
+     PROCESS_QUERY_LIMITED_INFORMATION = $1000;
      PROCESS_SET_INFORMATION = 512;
      PROCESS_TERMINATE = 1;
      PROCESS_VM_OPERATION = 8;
@@ -6377,9 +6378,8 @@ const
 
 
     CONSOLE_FULLSCREEN_MODE = 1;    
-    CONSOLE_WINDOWED_MODE = 2;    
-
-
+    CONSOLE_WINDOWED_MODE   = 2;    
+    PROCESS_NAME_NATIVE     = 1;
 
 {$endif read_interface}
 

+ 6 - 1
rtl/win/wininc/func.inc

@@ -1320,7 +1320,12 @@ function CONSOLE_REAL_OUTPUT_HANDLE : HANDLE;
   function GetConsoleWindow:HWND;stdcall;external 'kernel32' name 'GetConsoleWindow';
   function GetConsoleProcessList(lpdwProcessList:LPDWORD; dwProcessCount:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleProcessList';
   function ReadDirectoryChangesW(hDirectory: HANDLE; lpBuffer: LPVOID;nBufferLength: DWORD; bWatchSubtree: BOOL; dwNotifyFilter: DWORD;lpBytesReturned: LPDWORD;lpOverlapped: LPOVERLAPPED;lpCompletionRoutine: LPOVERLAPPED_COMPLETION_ROUTINE): BOOL; stdcall; external 'kernel32' name 'ReadDirectoryChangesW';  
-
+  function IsDebuggerPresent : BOOL; stdcall; external 'kernel32.dll' name 'IsDebuggerPresent';
+  function Wow64DisableWow64FsRedirection(RedirectionState : ppointer) : BOOL; stdcall;   external 'kernel32.dll' name 'Wow64DisableWow64FsRedirection';
+  function Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection:BYTE) : BOOL; stdcall;   external 'kernel32.dll' name 'Wow64EnableWow64FsRedirection';
+  function Wow64RevertWow64FsRedirection(RedirectionState : pointer) : BOOL; stdcall; external 'kernel32.dll' name 'Wow64RevertWow64FsRedirection';
+  function IsWow64Process(hProcess:THandle; Wow64Process:PBOOL):BOOL;stdcall; external 'kernel32.dll' name 'IsWow64Process';
+  function GetPhysicallyInstalledSystemMemory(TotalMemoryInKilobytes: PULONGLONG ):BOOL; stdcall; external 'kernel32.dll' name 'GetPhysicallyInstalledSystemMemory';
 {$endif read_interface}
 
 

+ 16 - 16
rtl/win/wininc/messages.inc

@@ -270,22 +270,22 @@
      HDM_HITTEST = 4614;
      HDM_LAYOUT = 4613;
   { Header control notifications  }
-     HDN_BEGINTRACKW = -(326);
-     HDN_DIVIDERDBLCLICKW = -(325);
-     HDN_ENDTRACKW = -(327);
-     HDN_ITEMCHANGEDW = -(321);
-     HDN_ITEMCHANGINGW = -(320);
-     HDN_ITEMCLICKW = -(322);
-     HDN_ITEMDBLCLICKW = -(323);
-     HDN_TRACKW = -(328);
-     HDN_BEGINTRACKA = -(306);
-     HDN_DIVIDERDBLCLICKA = -(305);
-     HDN_ENDTRACKA = -(307);
-     HDN_ITEMCHANGEDA = -(301);
-     HDN_ITEMCHANGINGA = -(300);
-     HDN_ITEMCLICKA = -(302);
-     HDN_ITEMDBLCLICKA = -(303);
-     HDN_TRACKA = -(308);
+     HDN_BEGINTRACKW = UINT(-326);
+     HDN_DIVIDERDBLCLICKW = UINT(-325);
+     HDN_ENDTRACKW = UINT(-327);
+     HDN_ITEMCHANGEDW = UINT(-321);
+     HDN_ITEMCHANGINGW = UINT(-320);
+     HDN_ITEMCLICKW = UINT(-322);
+     HDN_ITEMDBLCLICKW = UINT(-323);
+     HDN_TRACKW = UINT(-328);
+     HDN_BEGINTRACKA = UINT(-306);
+     HDN_DIVIDERDBLCLICKA = UINT(-305);
+     HDN_ENDTRACKA = UINT(-307);
+     HDN_ITEMCHANGEDA = UINT(-301);
+     HDN_ITEMCHANGINGA = UINT(-300);
+     HDN_ITEMCLICKA = UINT(-302);
+     HDN_ITEMDBLCLICKA = UINT(-303);
+     HDN_TRACKA = UINT(-308);
 {$ifdef UNICODE}
 
   const

+ 1 - 0
rtl/win/wininc/unidef.inc

@@ -473,6 +473,7 @@ function FindFirstFileEx(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;l
 // winver>$0600 
 function FindFirstFileTransacted(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external 'kernel32' name 'FindFirstFileTransactedW';
 function GetComputerNameEx(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPWSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExW';
+function QueryFullProcessImageName(hProcess:THandle;dwFlags:DWord; lpexename :lpwstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameW';
 {$endif read_interface}
 
 

+ 1 - 0
rtl/win/wininc/unifun.inc

@@ -496,6 +496,7 @@ function GetConsoleAliasExesLengthW:DWORD;stdcall;external 'kernel32' name 'GetC
 function GetConsoleAliasesW(AliasBuffer:LPWSTR; AliasBufferLength:DWORD; ExeName:LPWSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesW';
 function GetConsoleAliasExesW(ExeNameBuffer:LPWSTR; ExeNameBufferLength:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesW';
 function GetComputerNameExW(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPWSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExW';
+function QueryFullProcessImageNameW(hProcess:THandle;dwFlags:DWord; lpexename :lpwstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameW';
 {$endif read_interface}
 
 

+ 29 - 0
tests/tbs/tb0657.pp

@@ -0,0 +1,29 @@
+program tb0657;
+
+{$mode objfpc}
+
+uses
+  fgl;
+
+type
+  TIntList = specialize TFPGList<LongInt>;
+
+const
+  c = 3;
+
+var
+  l: TIntList;
+  i: LongInt;
+begin
+  l := TIntList.Create;
+  try
+    for i := 0 to c do
+      l.Add(i);
+
+    for i := 0 to l.Count - 1 do
+      if l.List^[i] <> i then
+        Halt(i + 1);
+  finally
+    l.Free;
+  end;
+end.

+ 4 - 1
tests/utils/testsuite/utests.pp

@@ -211,7 +211,10 @@ type
     ver_3_0_3,
     ver_3_0_4,
     ver_3_0_5,
-    ver_3_1_1);
+    ver_3_1_1,
+    ver_3_2_0,
+    ver_3_2_1,
+    ver_3_3_1);
 
 const
   ver_trunk = high (known_versions);

+ 180 - 40
utils/h2pas/h2paschk.pas

@@ -48,6 +48,9 @@ program h2paschk;
 .blue
 .alpha
 
+@TYPE size_t
+@CONSTANT O_RW
+
 @C   return 0;
 @C }
 
@@ -91,6 +94,20 @@ type
     procedure DoneLangOutputs;
 
     procedure StartRecord(RecordID: TIdentifier);
+    procedure HandleType(TypeID: TIdentifier);
+    procedure HandleConstant(ConstantID: TIdentifier;PascalType,PascalHexStrSize,CType,CFormat : string);
+    procedure HandleConstant(ConstantID: TIdentifier);
+    procedure HandleConstantU8(ConstantID: TIdentifier);
+    procedure HandleConstantU16(ConstantID: TIdentifier);
+    procedure HandleConstantU32(ConstantID: TIdentifier);
+    procedure HandleConstantU64(ConstantID: TIdentifier);
+    procedure HandleSignedConstant(ConstantID: TIdentifier;PascalType,CType,CFormat : string);
+    procedure HandleSignedConstant(ConstantID: TIdentifier);
+    procedure HandleConstantS8(ConstantID: TIdentifier);
+    procedure HandleConstantS16(ConstantID: TIdentifier);
+    procedure HandleConstantS32(ConstantID: TIdentifier);
+    procedure HandleConstantS64(ConstantID: TIdentifier);
+    procedure HandleFloatConstant(ConstantID: TIdentifier);
     procedure ProcessField(FieldID: TIdentifier);
   public
     destructor Destroy; override;
@@ -127,11 +144,86 @@ begin
     DoneLangOutput(Lang);
 end;
 
+
+procedure TH2PasCheckerCodeGen.HandleType(TypeID: TIdentifier);
+begin
+  Writeln(FLangOutput[lPascal], '  Writeln(''SizeOf(', TypeID[CommLangID], ')='',SizeOf(', TypeID[lPascal], '));');
+  Writeln(FLangOutput[lC], '  printf("SizeOf(', TypeID[CommLangID], ')=%lu\n",sizeof(', TypeID[lC], '));');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstant(ConstantID: TIdentifier;PascalType,PascalHexStrSize,CType,CFormat : string);
+begin
+  Writeln(FLangOutput[lPascal], '  Writeln(''Unsigned value Of(', ConstantID[CommLangID], ')=0x'',hexstr(',PascalType,'(', ConstantID[lPascal], '),',PascalHexStrSize,'));');
+  Writeln(FLangOutput[lC], '  printf("Unsigned value Of(', ConstantID[CommLangID], ')=0x',CFormat,'\n",(',CType,') ', ConstantID[lC], ');');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleSignedConstant(ConstantID: TIdentifier;PascalType,CType,CFormat : string);
+begin
+  Writeln(FLangOutput[lPascal], '  Writeln(''Signed value Of(', ConstantID[CommLangID], ')='',',PascalType,'(', ConstantID[lPascal],'));');
+  Writeln(FLangOutput[lC], '  printf("Signed value Of(', ConstantID[CommLangID], ')=',CFormat,'\n",(',CType,') ', ConstantID[lC],');');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleFloatConstant(ConstantID: TIdentifier);
+begin
+  Writeln(FLangOutput[lPascal], '  Writeln(''Value Of(', ConstantID[CommLangID], ')='',',ConstantID[lPascal],':25:25);');
+  Writeln(FLangOutput[lC], '  printf("Value Of(', ConstantID[CommLangID], ')=%0.25f\n",',ConstantID[lC],');');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstant(ConstantID: TIdentifier);
+begin
+  HandleConstant(ConstantID,'qword','16','unsigned long long','%016llx');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantU8(ConstantID: TIdentifier);
+begin
+  HandleConstant(ConstantID,'byte','2','unsigned char','%02x');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantU16(ConstantID: TIdentifier);
+begin
+  HandleConstant(ConstantID,'word','4','unsigned short','%04x');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantU32(ConstantID: TIdentifier);
+begin
+  HandleConstant(ConstantID,'dword','8','unsigned int','%08x');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantU64(ConstantID: TIdentifier);
+begin
+  HandleConstant(ConstantID,'qword','16','unsigned int','%016llx');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleSignedConstant(ConstantID: TIdentifier);
+begin
+  HandleSignedConstant(ConstantID,'int64','signed long long','%lld');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantS8(ConstantID: TIdentifier);
+begin
+  HandleSignedConstant(ConstantID,'int8','signed char','%d');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantS16(ConstantID: TIdentifier);
+begin
+  HandleSignedConstant(ConstantID,'int16','signed short','%d');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantS32(ConstantID: TIdentifier);
+begin
+  HandleSignedConstant(ConstantID,'int32','signed int','%d');
+end;
+
+procedure TH2PasCheckerCodeGen.HandleConstantS64(ConstantID: TIdentifier);
+begin
+  HandleSignedConstant(ConstantID,'int64','unsigned int','%lld');
+end;
+
+
 procedure TH2PasCheckerCodeGen.StartRecord(RecordID: TIdentifier);
 begin
   FCurrentRecord := RecordID;
-  Writeln(FLangOutput[lPascal], '  Writeln(''SizeOf(', RecordID[CommLangID], ')='',SizeOf(', RecordID[lPascal], '));');
-  Writeln(FLangOutput[lC], '  printf("SizeOf(', RecordID[CommLangID], ')=%lu\n",sizeof(', RecordID[lC], '));');
+  HandleType(RecordID);
 end;
 
 procedure TH2PasCheckerCodeGen.ProcessField(FieldID: TIdentifier);
@@ -156,6 +248,30 @@ var
   I: Integer;
   ID: TIdentifier;
   Lang: TLanguage;
+
+  procedure ReadID;
+  begin
+    if Pos(',', InS) >= 1 then
+    begin
+      for Lang in TLanguage do
+      begin
+        if Pos(',', InS) >= 1 then
+        begin
+          ID[Lang] := Copy(InS, 1, Pos(',', InS) - 1);
+          Delete(InS, 1, Pos(',', InS));
+        end
+        else
+        begin
+          ID[Lang] := InS;
+          InS := '';
+        end;
+      end;
+    end
+    else
+      for Lang in TLanguage do
+        ID[Lang] := InS;
+  end;
+
 begin
   FInFileName := InFileName;
   AssignFile(InF, InFileName);
@@ -192,27 +308,69 @@ begin
                   Writeln(FLangOutput[lPascal], InS);
                 '@C':
                   Writeln(FLangOutput[lC], InS);
+                '@FLOATCONSTANT':
+                  begin
+                    ReadID;
+                    HandleFloatConstant(ID);
+                  end;
+                '@CONSTANT':
+                  begin
+                    ReadID;
+                    HandleConstant(ID);
+                  end;
+                '@CONSTANT_U8':
+                  begin
+                    ReadID;
+                    HandleConstantU8(ID);
+                  end;
+                '@CONSTANT_U16':
+                  begin
+                    ReadID;
+                    HandleConstantU16(ID);
+                  end;
+                '@CONSTANT_U32':
+                  begin
+                    ReadID;
+                    HandleConstantU32(ID);
+                  end;
+                '@CONSTANT_U64':
+                  begin
+                    ReadID;
+                    HandleConstantU64(ID);
+                  end;
+                '@CONSTANT_S':
+                  begin
+                    ReadID;
+                    HandleSignedConstant(ID);
+                  end;
+                '@CONSTANT_S8':
+                  begin
+                    ReadID;
+                    HandleConstantS8(ID);
+                  end;
+                '@CONSTANT_S16':
+                  begin
+                    ReadID;
+                    HandleConstantS16(ID);
+                  end;
+                '@CONSTANT_S32':
+                  begin
+                    ReadID;
+                    HandleConstantU32(ID);
+                  end;
+                '@CONSTANT_S64':
+                  begin
+                    ReadID;
+                    HandleConstantS64(ID);
+                  end;
+                '@TYPE':
+                  begin
+                    ReadID;
+                    HandleType(ID);
+                  end;
                 '@RECORD':
                   begin
-                    if Pos(',', InS) >= 1 then
-                    begin
-                      for Lang in TLanguage do
-                      begin
-                        if Pos(',', InS) >= 1 then
-                        begin
-                          ID[Lang] := Copy(InS, 1, Pos(',', InS) - 1);
-                          Delete(InS, 1, Pos(',', InS));
-                        end
-                        else
-                        begin
-                          ID[Lang] := InS;
-                          InS := '';
-                        end;
-                      end;
-                    end
-                    else
-                      for Lang in TLanguage do
-                        ID[Lang] := InS;
+                    ReadID;
                     StartRecord(ID);
                   end;
                 else
@@ -222,25 +380,7 @@ begin
           '.':
             begin
               Delete(InS, 1, 1);
-              if Pos(',', InS) >= 1 then
-              begin
-                for Lang in TLanguage do
-                begin
-                  if Pos(',', InS) >= 1 then
-                  begin
-                    ID[Lang] := Copy(InS, 1, Pos(',', InS) - 1);
-                    Delete(InS, 1, Pos(',', InS));
-                  end
-                  else
-                  begin
-                    ID[Lang] := InS;
-                    InS := '';
-                  end;
-                end;
-              end
-              else
-                for Lang in TLanguage do
-                  ID[Lang] := InS;
+              ReadID;
               ProcessField(ID);
             end;
         end;