* synchronized with fixes_3_0 till r30840

git-svn-id: branches/fixes_3_0_ios@30961 -

.gitattributes

@@ -12354,6 +12354,7 @@ tests/test/tunit3.pp svneol=native#text/plain
 tests/test/tunroll1.pp svneol=native#text/plain
 tests/test/tutf81.pp svneol=native#text/plain
 tests/test/tutf82.pp svneol=native#text/plain
+tests/test/tutf8cpl.pp svneol=native#text/plain
 tests/test/tvarpropsetter1.pp svneol=native#text/plain
 tests/test/tvarpropsetter2.pp svneol=native#text/plain
 tests/test/tvarset1.pp svneol=native#text/plain

packages/amunits/src/coreunits/amigados.pas

@@ -1069,7 +1069,7 @@ Type
        tExAllData = record
         ed_Next     : pExAllData;
         ed_Name     : STRPTR;
-        ed_Type,
+        ed_Type     : LongInt;
         ed_Size,
         ed_Prot,
         ed_Days,

packages/arosunits/src/amigados.pas

@@ -1023,7 +1023,7 @@ type
   TExAllData = record
     ed_Next: PExAllData;
     ed_Name: PChar;        // Name of the file
-    ed_Type,               // Type of File
+    ed_Type: LongInt;      // Type of File
     ed_Size,               // Size of File
     ed_Prot,               // Protection Bits
 { The following three fields are de facto an embedded datestamp

packages/fcl-image/src/freetype.pp

@@ -461,6 +461,7 @@ begin
       CurSize := CreateSize (aSize,aResolution)
     else
       CurSize := PMgrSize(CurFont.FSizes[r]);
+    SetPixelSize(CurSize^.Size, CurSize^.resolution);
     CurFont.LastSize := CurSize;
     end;
 end;

packages/libc/src/typesh.inc

@@ -37,7 +37,7 @@ type
         __val : array[0..1] of longint;
      end;
    __daddr_t = longint;
-   __caddr_t = char;
+   __caddr_t = pchar;
    __time_t = longint;
    __useconds_t = dword;
    __suseconds_t = longint;
@@ -169,7 +169,7 @@ Type
   Ppid_t = ^pid_t;
   Pssize_t = ^ssize_t;
   Pdaddr_t = ^daddr_t;
-  Pcaddr_t = ^caddr_t;
+//  Pcaddr_t = ^caddr_t;
   Pkey_t = ^key_t;
   Puseconds_t = ^useconds_t;
   Psuseconds_t = ^suseconds_t;
@@ -207,7 +207,7 @@ Type
   P__id_t = ^__id_t;
   P__fsid_t = ^__fsid_t;
   P__daddr_t = ^__daddr_t;
-  P__caddr_t = ^__caddr_t;
+  //P__caddr_t = ^__caddr_t;
   P__time_t = ^__time_t;
   P__useconds_t = ^__useconds_t;
   P__suseconds_t = ^__suseconds_t;

packages/paszlib/src/zipper.pp

@@ -33,6 +33,38 @@ Const
   CENTRAL_FILE_HEADER_SIGNATURE              = $02014B50;
   ZIP64_HEADER_ID                            = $0001;
 
+const
+  OS_FAT  = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32)
+  OS_UNIX = 3;
+  OS_OS2  = 6; //OS/2 HPFS
+  OS_NTFS = 10;
+  OS_VFAT = 14;
+  OS_OSX  = 19;
+
+  UNIX_MASK = $F000;
+  UNIX_FIFO = $1000;
+  UNIX_CHAR = $2000;
+  UNIX_DIR  = $4000;
+  UNIX_BLK  = $6000;
+  UNIX_FILE = $8000;
+  UNIX_LINK = $A000;
+  UNIX_SOCK = $C000;
+
+
+  UNIX_RUSR = $0100;
+  UNIX_WUSR = $0080;
+  UNIX_XUSR = $0040;
+
+  UNIX_RGRP = $0020;
+  UNIX_WGRP = $0010;
+  UNIX_XGRP = $0008;
+
+  UNIX_ROTH = $0004;
+  UNIX_WOTH = $0002;
+  UNIX_XOTH = $0001;
+
+  UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH;
+
 Type
    Local_File_Header_Type = Packed Record //1 per zipped file
      Signature              :  LongInt; //4 bytes
@@ -692,37 +724,6 @@ begin
   DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
 end;
 
-const
-  OS_FAT  = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32)
-  OS_UNIX = 3;
-  OS_OS2  = 6; //OS/2 HPFS
-  OS_NTFS = 10;
-  OS_VFAT = 14;
-  OS_OSX  = 19;
-
-  UNIX_MASK = $F000;
-  UNIX_FIFO = $1000;
-  UNIX_CHAR = $2000;
-  UNIX_DIR  = $4000;
-  UNIX_BLK  = $6000;
-  UNIX_FILE = $8000;
-  UNIX_LINK = $A000;
-  UNIX_SOCK = $C000;
-
-
-  UNIX_RUSR = $0100;
-  UNIX_WUSR = $0080;
-  UNIX_XUSR = $0040;
-
-  UNIX_RGRP = $0020;
-  UNIX_WGRP = $0010;
-  UNIX_XGRP = $0008;
-
-  UNIX_ROTH = $0004;
-  UNIX_WOTH = $0002;
-  UNIX_XOTH = $0001;
-
-  UNIX_DEFAULT = UNIX_RUSR or UNIX_WUSR or UNIX_XUSR or UNIX_RGRP or UNIX_ROTH;
 
 
 function ZipUnixAttrsToFatAttrs(const Name: String; Attrs: Longint): Longint;
@@ -1357,17 +1358,20 @@ Begin
         Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
       end
     else
-      begin
+    begin
       If (F.ArchiveFileName='') then
         Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
       F.Size:=F.Stream.Size;
-    {$IFDEF UNIX}
-      F.Attributes := UNIX_FILE or UNIX_DEFAULT;
-    {$ELSE}
-      F.Attributes := faArchive;
-    {$ENDIF}
-      end;
+      if (F.Attributes = 0) then
+      begin
+      {$IFDEF UNIX}
+        F.Attributes := UNIX_FILE or UNIX_DEFAULT;
+      {$ELSE}
+        F.Attributes := faArchive;
+      {$ENDIF}
+      end;	
     end;
+  end;
 end;
 
 
@@ -2634,6 +2638,8 @@ begin
   FCompressionLevel:=cldefault;
   FDateTime:=now;
   FNeedsZip64:=false;
+  FAttributes:=0;
+
   inherited create(ACollection);
 end;
 

packages/winunits-base/src/eventsink.pp

@@ -81,6 +81,7 @@ type
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure Connect(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID);
+  procedure Disconnect;
  published
   property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke;
  end;
@@ -182,6 +183,11 @@ begin
  FSink.Connect(AnAppDispatch, AnAppDispIntfIID);
 end;
 
+procedure TEventSink.Disconnect;
+begin
+  FSink.Disconnect;
+end;
+
 constructor TEventSink.Create(AOwner: TComponent);
 begin
  inherited Create(AOwner);

packages/winunits-jedi/src/jwaiptypes.pas

@@ -350,7 +350,7 @@ const
 
 type
   IF_OPER_STATUS = (
-    IfOperStatusUp,
+    IfOperStatusUp = 1,
     IfOperStatusDown,
     IfOperStatusTesting,
     IfOperStatusUnknown,

packages/winunits-jedi/src/jwawinnt.pas

@@ -9155,7 +9155,7 @@ end;
 
 function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader;
 begin
-  Result := PImageSectionHeader(Cardinal(NtHeader) +
+  Result := PImageSectionHeader(ptruint(NtHeader) +
       FieldOffset(NtHeader^, NtHeader^.OptionalHeader) +
       NtHeader^.FileHeader.SizeOfOptionalHeader);
 end;

rtl/inc/generic.inc

@@ -1076,6 +1076,144 @@ function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {$endif not cpujvm}
 
+
+function Utf8CodePointLen(P: PAnsiChar; MaxLookAhead: SizeInt; IncludeCombiningDiacriticalMarks: Boolean): SizeInt;
+  var
+    bytes: sizeint;
+    firstzerobit: byte;
+  begin
+    { see https://en.wikipedia.org/wiki/UTF-8#Description for details }
+
+    if maxlookahead<=0 then
+      begin
+        { incomplete }
+        result:=0;
+        exit;
+      end;
+    { inlcude the first byte }
+    result:=1;
+    { multiple byte utf-8 code point? }
+    if p[0]>#127 then
+      begin
+        { bsr searches for the leftmost 1 bit. We are interested in the
+          leftmost 0 bit, so first invert the value
+        }
+        firstzerobit:=bsrbyte(not(byte(p[0])));
+        { if there is no zero bit or the first zero bit is the rightmost bit
+          (bit 0), this is an invalid UTF-8 byte ($ff cannot appear in an
+          UTF-8-encoded string, and in the worst case bit 1 has to be zero)
+          Additionally, 5-byte UTF-8 sequences don't exist either, so bit 1
+          cannot be the first zero-bit either. And bits 6 and 7 can't be 0
+          either in the first byte.
+        }
+        if (firstzerobit<=1) or (firstzerobit>=6)  then
+          begin
+            result:=-result;
+            exit;
+          end;
+        { the number of bytes belonging to this code point is
+          7-(pos first 0-bit). Subtract 1 since we're already at the first
+          byte. All subsequent bytes of the same sequence must have their
+          highest bit set and the next one unset. We stop when we detect an
+          invalid sequence.
+        }
+        bytes:=6-firstzerobit;
+        while (result<maxlookahead) and
+              (bytes>0) and
+              ((ord(p[result]) and %11000000)=%10000000) do
+          begin
+            inc(result);
+            dec(bytes);
+          end;
+        { stopped because of invalid/incomplete sequence -> exit }
+        if bytes<>0 then
+          begin
+            if result>=maxlookahead then
+              result:=0
+            else
+              result:=-result;
+            exit;
+          end;
+      end;
+    if includecombiningdiacriticalmarks then
+      begin
+        { combining diacritical marks?
+            1) U+0300 - U+036F in UTF-8 = %11001100 10000000 - %11001101 10101111
+            2) U+1AB0 - U+1AFF in UTF-8 = %11100001 10101010 10110000 - %11100001 10101011 10111111
+            3) U+1DC0 - U+1DFF in UTF-8 = %11100001 10110111 10000000 - %11100001 10110111 10111111
+            4) U+20D0 - U+20FF in UTF-8 = %11100010 10000011 10010000 - %11100010 10000011 10111111
+            5) U+FE20 - U+FE2F in UTF-8 = %11101111 10111000 10100000 - %11101111 10111000 10101111
+        }
+        repeat
+          bytes:=result;
+          if result+1<maxlookahead then
+            begin
+              { case 1) }
+              if ((ord(p[result]) and %11001100=%11001100)) and
+                  (ord(p[result+1])>=%10000000) and
+                  (ord(p[result+1])<=%10101111) then
+                inc(result,2)
+                  { case 2), 3), 4), 5) }
+              else if (result+2<maxlookahead) and
+                 (ord(p[result])>=%11100001) then
+                begin
+                     { case 2) }
+                  if ((ord(p[result])=%11100001) and
+                      (ord(p[result+1])=%10101010) and
+                      (ord(p[result+2])>=%10110000) and
+                      (ord(p[result+2])<=%10111111)) or
+                     { case 3) }
+                     ((ord(p[result])=%11100001) and
+                      (ord(p[result+1])=%10110111) and
+                      (ord(p[result+2])>=%10000000) and
+                      (ord(p[result+2])<=%10111111)) or
+                     { case 4) }
+                     ((ord(p[result])=%11100010) and
+                      (ord(p[result+1])=%10000011) and
+                      (ord(p[result+2])>=%10010000) and
+                      (ord(p[result+2])<=%10111111)) or
+                     { case 5) }
+                     ((ord(p[result])=%11101111) and
+                      (ord(p[result+1])=%10111000) and
+                      (ord(p[result+2])>=%10100000) and
+                      (ord(p[result+2])<=%10101111)) then
+                    inc(result,3);
+                end;
+            end;
+        until bytes=result;
+        { is there an incomplete diacritical mark? (invalid makes little sense:
+          either a sequence is a combining diacritical mark, or it's not ; if
+          it's invalid, it may also not have been a combining diacritical mark)
+        }
+        if result<maxlookahead then
+          begin
+               { case 1) }
+            if (((ord(p[result]) and %11001100=%11001100)) and
+                (result+1>=maxlookahead)) or
+               { case 2) and 3)}
+               ((ord(p[result])=%11100001) and
+                ((result+1>=maxlookahead) or
+                 (((ord(p[result+1])=%10101010) or
+                   (ord(p[result+1])=%10110111)) and
+                  (result+2>=maxlookahead)))) or
+               { case 4 }
+               ((ord(p[result])=%11100010) and
+                ((result+1>=maxlookahead) or
+                 ((ord(p[result+1])=%10000011) and
+                  (result+2>=maxlookahead)))) or
+               { case 5 }
+               ((ord(p[result])=%11101111) and
+                ((result+1>=maxlookahead) or
+                 ((ord(p[result+1])=%10111000) and
+                  (result+2>=maxlookahead)))) then
+              begin
+                result:=0;
+                exit;
+              end;
+          end;
+      end;
+  end;
+
 {$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
 
 procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true);[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;

rtl/inc/systemh.inc

@@ -1081,6 +1081,14 @@ Function  Sseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
 function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
 
+{ result:
+  <0: invalid sequence detected after processing "-result" bytes
+  0: incomplete (may still be valid if MaxLookAhead is increased)
+  >0: sequence of result bytes forms a codepoint (+ combining diacritics if that
+      parameter was true)
+}
+function Utf8CodePointLen(P: PAnsiChar; MaxLookAhead: SizeInt; IncludeCombiningDiacriticalMarks: Boolean): SizeInt;
+
 { Shortstring functions }
 Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt);
 Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt);

rtl/java/jsystemh.inc

@@ -442,6 +442,15 @@ function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
 *)
 
+{ result:
+  <0: invalid sequence detected after processing "-result" bytes
+  0: incomplete (may still be valid if MaxLookAhead is increased)
+  >0: sequence of result bytes forms a codepoint (+ combining diacritics if that
+      parameter was true)
+}
+function Utf8CodePointLen(P: PAnsiChar; MaxLookAhead: SizeInt; IncludeCombiningDiacriticalMarks: Boolean): SizeInt;
+
+
 var
   { separated compared to generic version, for Java type safety }
   FPC_EMPTYANSICHAR : array[0..0] of ansichar;

rtl/netbsd/ptypes.inc

@@ -169,7 +169,8 @@ struct statfs12 {
         1: (_mbstateL: cint64); { for alignment }
     end;
    pmbstate_t = ^mbstate_t;
-  
+ 
+{ records transcripted fromm NetBSD 5.1 libpthread sources } 
    pthread_t            = pointer;
    pthread_attr_t       = record
      pta_magic : cuint;
@@ -181,8 +182,21 @@ struct statfs12 {
      ptma_magic : cint;
      ptma_private : pointer;
    end;
-   pthread_cond_t       = pointer;
-   pthread_condattr_t   = pointer;
+   pthread_spin_t = char;
+   pthread_queue_t = record
+       first, last : pointer;
+     end;
+   pthread_cond_t       = record
+       ptc_magic : cuint;
+       ptc_lock : pthread_spin_t;
+       ptc_waiters : pthread_queue_t;
+       ptc_mutex : ^pthread_mutex_t;
+       ptc_private : pointer;
+     end;
+   pthread_condattr_t   = record
+       ptca_magic : cuint;
+       ptca_private : pointer;
+     end;
    pthread_key_t        = cint;
    pthread_rwlock_t     = pointer;
    pthread_rwlockattr_t = pointer;

rtl/win/wininc/base.inc

@@ -593,6 +593,21 @@
   #endif
    }
 
+
+  function IMAGE_ORDINAL64(Ordinal : uint64) : uint64; inline;
+  function IMAGE_ORDINAL32(Ordinal : cardinal) : cardinal;inline;
+  function IMAGE_SNAP_BY_ORDINAL64(Ordinal : uint64) : boolean;  inline;
+  function IMAGE_SNAP_BY_ORDINAL32(Ordinal : cardinal) : boolean; inline;
+  {$ifdef WIN64}
+    function IMAGE_ORDINAL(Ordinal : uint64) : uint64; inline;
+    function IMAGE_SNAP_BY_ORDINAL(Ordinal : uint64) : boolean; inline;
+  {$else}
+    function IMAGE_ORDINAL(Ordinal : cardinal) : cardinal; inline;
+    function IMAGE_SNAP_BY_ORDINAL(Ordinal : cardinal) : boolean; inline;
+  {$endif}
+ 
+
+
  {
     Definitions for callback procedures
  }
@@ -1057,5 +1072,49 @@ type
        PALETTERGB:=$02000000 or (RGB(r,g,b));
     end;
 
+  function IMAGE_ORDINAL64(Ordinal : uint64) : uint64;
+  begin
+    IMAGE_ORDINAL64:=Ordinal and $ffff;
+  end;
+
+  function IMAGE_ORDINAL32(Ordinal : cardinal) : cardinal;
+  begin
+    IMAGE_ORDINAL32:=Ordinal and $ffff;
+  end;
+
+  function IMAGE_SNAP_BY_ORDINAL64(Ordinal : uint64) : boolean;
+  begin
+    IMAGE_SNAP_BY_ORDINAL64:=(Ordinal and IMAGE_ORDINAL_FLAG64)<>0;
+  end;
+
+  function IMAGE_SNAP_BY_ORDINAL32(Ordinal : cardinal) : boolean;
+  begin
+    IMAGE_SNAP_BY_ORDINAL32:=(Ordinal and IMAGE_ORDINAL_FLAG32)<>0;
+  end;
+
+  {$ifdef win64}
+  function IMAGE_ORDINAL(Ordinal : uint64) : uint64;
+  begin
+    IMAGE_ORDINAL:=IMAGE_ORDINAL64(Ordinal);
+  end;
+
+
+  function IMAGE_SNAP_BY_ORDINAL(Ordinal : uint64) : boolean;
+  begin
+    IMAGE_SNAP_BY_ORDINAL:=IMAGE_SNAP_BY_ORDINAL64(Ordinal);
+  end;
+
+  {$else}
+
+  function IMAGE_ORDINAL(Ordinal : cardinal) : cardinal;
+  begin
+    IMAGE_ORDINAL:=IMAGE_ORDINAL32(Ordinal);
+  end;
+
+  function IMAGE_SNAP_BY_ORDINAL(Ordinal : cardinal) : boolean;
+  begin
+    IMAGE_SNAP_BY_ORDINAL:=IMAGE_SNAP_BY_ORDINAL32(Ordinal);
+  end;
+ {$endif}
 {$endif read_implementation}
 

rtl/win/wininc/defines.inc

@@ -5913,6 +5913,68 @@ const
     IMAGE_FILE_MACHINE_CEE               = $C0EE;
     IMAGE_FILE_LARGE_ADDRESS_AWARE       = $20;    // for peflags.
 
+  //
+  // Section characteristics.
+  //
+  //      IMAGE_SCN_TYPE_REG                   = $00000000;  // Reserved.
+  //      IMAGE_SCN_TYPE_DSECT                 = $00000001;  // Reserved.
+  //      IMAGE_SCN_TYPE_NOLOAD                = $00000002;  // Reserved.
+  //      IMAGE_SCN_TYPE_GROUP                 = $00000004;  // Reserved.
+     IMAGE_SCN_TYPE_NO_PAD                = $00000008;  // Reserved.
+  //      IMAGE_SCN_TYPE_COPY                  = $00000010;  // Reserved.
+
+     IMAGE_SCN_CNT_CODE                   = $00000020;  // Section contains code.
+     IMAGE_SCN_CNT_INITIALIZED_DATA       = $00000040;  // Section contains initialized data.
+     IMAGE_SCN_CNT_UNINITIALIZED_DATA     = $00000080;  // Section contains uninitialized data.
+
+     IMAGE_SCN_LNK_OTHER                  = $00000100;  // Reserved.
+     IMAGE_SCN_LNK_INFO                   = $00000200;  // Section contains comments or some other type of information.
+  //      IMAGE_SCN_TYPE_OVER                  = $00000400  // Reserved.
+     IMAGE_SCN_LNK_REMOVE                 = $00000800;  // Section contents will not become part of image.
+     IMAGE_SCN_LNK_COMDAT                 = $00001000;  // Section contents comdat.
+  //                                           = $00002000  // Reserved.
+  //      IMAGE_SCN_MEM_PROTECTED - Obsolete   = $00004000
+     IMAGE_SCN_NO_DEFER_SPEC_EXC          = $00004000;  // Reset speculative exceptions handling bits in the TLB entries for this section.
+     IMAGE_SCN_GPREL                      = $00008000;  // Section content can be accessed relative to GP
+     IMAGE_SCN_MEM_FARDATA                = $00008000;
+  //      IMAGE_SCN_MEM_SYSHEAP  - Obsolete    = $00010000;
+     IMAGE_SCN_MEM_PURGEABLE              = $00020000;
+     IMAGE_SCN_MEM_16BIT                  = $00020000;
+     IMAGE_SCN_MEM_LOCKED                 = $00040000;
+     IMAGE_SCN_MEM_PRELOAD                = $00080000;
+
+     IMAGE_SCN_ALIGN_1BYTES               = $00100000;  //
+     IMAGE_SCN_ALIGN_2BYTES               = $00200000;  //
+     IMAGE_SCN_ALIGN_4BYTES               = $00300000;  //
+     IMAGE_SCN_ALIGN_8BYTES               = $00400000;  //
+     IMAGE_SCN_ALIGN_16BYTES              = $00500000;  // Default alignment if no others are specified.
+     IMAGE_SCN_ALIGN_32BYTES              = $00600000;  //
+     IMAGE_SCN_ALIGN_64BYTES              = $00700000;  //
+     IMAGE_SCN_ALIGN_128BYTES             = $00800000;  //
+     IMAGE_SCN_ALIGN_256BYTES             = $00900000;  //
+     IMAGE_SCN_ALIGN_512BYTES             = $00A00000;  //
+     IMAGE_SCN_ALIGN_1024BYTES            = $00B00000;  //
+     IMAGE_SCN_ALIGN_2048BYTES            = $00C00000;  //
+     IMAGE_SCN_ALIGN_4096BYTES            = $00D00000;  //
+     IMAGE_SCN_ALIGN_8192BYTES            = $00E00000;  //
+  // Unused                                    = $00F00000;
+     IMAGE_SCN_ALIGN_MASK                 = $00F00000;
+
+     IMAGE_SCN_LNK_NRELOC_OVFL            = $01000000;  // Section contains extended relocations.
+     IMAGE_SCN_MEM_DISCARDABLE            = $02000000;  // Section can be discarded.
+     IMAGE_SCN_MEM_NOT_CACHED             = $04000000;  // Section is not cachable.
+     IMAGE_SCN_MEM_NOT_PAGED              = $08000000;  // Section is not pageable.
+     IMAGE_SCN_MEM_SHARED                 = $10000000;  // Section is shareable.
+     IMAGE_SCN_MEM_EXECUTE                = $20000000;  // Section is executable.
+     IMAGE_SCN_MEM_READ                   = $40000000;  // Section is readable.
+     IMAGE_SCN_MEM_WRITE                  = $80000000;  // Section is writeable.
+
+  //
+  // TLS Characteristic Flags
+  //
+     IMAGE_SCN_SCALE_INDEX                = $00000001;  // Tls index is scaled
+
+
     GWLP_WNDPROC        		 = -4; 
     GWLP_HINSTANCE      		 = -6; 
     GWLP_HWNDPARENT     		 = -8; 
@@ -5927,6 +5989,26 @@ const
     GCLP_WNDPROC                         = -24;
     GCLP_HICONSM                         = -34;
 
+    IMAGE_ORDINAL_FLAG64 = uint64($8000000000000000);
+    IMAGE_ORDINAL_FLAG32 = uint32($80000000);
+    bm__IMAGE_TLS_DIRECTORY64_Reserved0 = $FFFFF;
+    bp__IMAGE_TLS_DIRECTORY64_Reserved0 = 0;
+    bm__IMAGE_TLS_DIRECTORY64_Alignment = $F00000;
+    bp__IMAGE_TLS_DIRECTORY64_Alignment = 20;
+    bm__IMAGE_TLS_DIRECTORY64_Reserved1 = $FF000000;
+    bp__IMAGE_TLS_DIRECTORY64_Reserved1 = 24;
+    bm__IMAGE_TLS_DIRECTORY32_Reserved0 = $FFFFF;
+    bp__IMAGE_TLS_DIRECTORY32_Reserved0 = 0;
+    bm__IMAGE_TLS_DIRECTORY32_Alignment = $F00000;
+    bp__IMAGE_TLS_DIRECTORY32_Alignment = 20;
+    bm__IMAGE_TLS_DIRECTORY32_Reserved1 = $FF000000;
+    bp__IMAGE_TLS_DIRECTORY32_Reserved1 = 24;
+
+{$ifdef WIN64}
+    IMAGE_ORDINAL_FLAG = IMAGE_ORDINAL_FLAG64;
+{$else}
+    IMAGE_ORDINAL_FLAG = IMAGE_ORDINAL_FLAG32;
+{$endif}                                                          
 
 // #if(WINVER >= 0x0500)
 {/*

rtl/win/wininc/func.inc

@@ -245,6 +245,7 @@ function SetSystemTime(lpSystemTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' n
 procedure GetLocalTime(lpSystemTime:LPSYSTEMTIME); external 'kernel32' name 'GetLocalTime';
 function SetLocalTime(lpSystemTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' name 'SetLocalTime';
 procedure GetSystemInfo(lpSystemInfo:LPSYSTEM_INFO); external 'kernel32' name 'GetSystemInfo';
+procedure GetNativeSystemInfo(lpSystemInfo:LPSYSTEM_INFO); external 'kernel32' name 'GetNativeSystemInfo';
 function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION; lpUniversalTime:LPSYSTEMTIME; lpLocalTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' name 'SystemTimeToTzSpecificLocalTime';
 function GetTimeZoneInformation(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION):DWORD; external 'kernel32' name 'GetTimeZoneInformation';
 function SetTimeZoneInformation(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION):WINBOOL; external 'kernel32' name 'SetTimeZoneInformation';
@@ -1273,6 +1274,7 @@ function EndMenu:BOOL; external 'user32' name 'EndMenu';
 
 
 function GetMenuBarInfo(_hwnd:HWND; idObject:longint; idItem:longint; pmbi:LPMENUBARINFO):BOOL; external 'user32' name 'GetMenuBarInfo';
+function IMAGE_FIRST_SECTION(ntheader : PIMAGE_NT_HEADERS):PIMAGE_SECTION_HEADER;
 
 {$endif read_interface}
 
@@ -2372,5 +2374,20 @@ begin
   GetLargestConsoleWindowSize:=COORD(res);
 end;
 
+{
+#define IMAGE_FIRST_SECTION( ntheader ) ((PIMAGE_SECTION_HEADER) \
+    ((ULONG_PTR)(ntheader) + \
+     FIELD_OFFSET( IMAGE_NT_HEADERS, OptionalHeader ) + \
+     ((ntheader))->FileHeader.SizeOfOptionalHeader \
+    )) 
+
+}
+
+function IMAGE_FIRST_SECTION(ntheader : PIMAGE_NT_HEADERS):PIMAGE_SECTION_HEADER;
+// (PTRUINT(ntheader)+ OFS(ntheader^.OptionalHeader) - OFS(NTHEADER);  -> address of ntheader cancels.
+begin
+  IMAGE_FIRST_SECTION:=PIMAGE_SECTION_HEADER(OFS(ntheader^.OptionalHeader) + ntheader^.FileHeader.SizeOfOptionalHeader);
+end;
+
 {$endif read_implementation}
 

rtl/win/wininc/struct.inc

@@ -8344,6 +8344,221 @@ type
      PIMAGE_LOAD_CONFIG_DIRECTORY = PIMAGE_LOAD_CONFIG_DIRECTORY32;
 {$endif}
 
+{$push}
+{$packrecords 4}
+
+    PIMAGE_EXPORT_DIRECTORY = ^TIMAGE_EXPORT_DIRECTORY;
+    IMAGE_EXPORT_DIRECTORY = record
+        Characteristics : DWORD;
+        TimeDateStamp   : DWORD;
+        MajorVersion    : WORD;
+        MinorVersion    : WORD;
+        Name 	        : DWORD;
+        Base 		    : DWORD;
+        NumberOfFunctions : DWORD;
+        NumberOfNames   : DWORD;
+        AddressOfFunctions : DWORD;     { RVA from base of image }
+        AddressOfNames  : DWORD;        { RVA from base of image }
+        AddressOfNameOrdinals : DWORD;  { RVA from base of image }
+      end;
+    TIMAGE_EXPORT_DIRECTORY = IMAGE_EXPORT_DIRECTORY; 
+    _IMAGE_EXPORT_DIRECTORY = IMAGE_EXPORT_DIRECTORY;
+    LPIMAGE_EXPORT_DIRECTORY= PIMAGE_EXPORT_DIRECTORY;
+
+  P_IMAGE_IMPORT_BY_NAME = ^_IMAGE_IMPORT_BY_NAME;
+  _IMAGE_IMPORT_BY_NAME =  record
+      Hint : WORD;
+      Name : array[0..0] of AnsiCHAR;
+    end;
+  IMAGE_IMPORT_BY_NAME = _IMAGE_IMPORT_BY_NAME;
+  PIMAGE_IMPORT_BY_NAME = ^IMAGE_IMPORT_BY_NAME;
+  LPIMAGE_IMPORT_BY_NAME = P_IMAGE_IMPORT_BY_NAME;
+  PPIMAGE_IMPORT_BY_NAME = ^PIMAGE_IMPORT_BY_NAME;
+
+  {$push}{$packrecords 8}              // Use align 8 for the 64-bit IAT.}
+  P_IMAGE_THUNK_DATA64 = ^_IMAGE_THUNK_DATA64;
+  _IMAGE_THUNK_DATA64 =  record
+      u1 :  record
+          case longint of
+            0 : ( ForwarderString : ULONGLONG );    { PBYTE  }
+            1 : ( _Function : ULONGLONG );          { PDWORD }
+            2 : ( Ordinal : ULONGLONG );
+            3 : ( AddressOfData : ULONGLONG );      { PIMAGE_IMPORT_BY_NAME }
+          end;
+    end;
+  IMAGE_THUNK_DATA64 = _IMAGE_THUNK_DATA64;
+  PIMAGE_THUNK_DATA64 = ^IMAGE_THUNK_DATA64;
+
+  PPIMAGE_THUNK_DATA64 = ^PIMAGE_THUNK_DATA64;
+  LPIMAGE_THUNK_DATA64 = PIMAGE_THUNK_DATA64;
+  {$pop}                        // Back to 4 byte packing}
+
+  P_IMAGE_THUNK_DATA32 = ^_IMAGE_THUNK_DATA32;
+  _IMAGE_THUNK_DATA32 =  record
+      u1 :  record
+          case longint of
+            0 : ( ForwarderString : DWORD );          { PBYTE  }
+            1 : ( _Function : DWORD );                { PDWORD }
+            2 : ( Ordinal : DWORD );
+            3 : ( AddressOfData : DWORD );            { PIMAGE_IMPORT_BY_NAME }
+          end;
+    end;
+  IMAGE_THUNK_DATA32 = _IMAGE_THUNK_DATA32;
+  PIMAGE_THUNK_DATA32 = ^IMAGE_THUNK_DATA32;
+
+  PPIMAGE_THUNK_DATA32 = ^PIMAGE_THUNK_DATA32;
+  LPIMAGE_THUNK_DATA32 = PIMAGE_THUNK_DATA32;
+
+  { }
+  { Thread Local Storage }
+  { }
+
+  PIMAGE_TLS_CALLBACK = procedure (DllHandle:PVOID; Reason:DWORD; Reserved:PVOID);stdcall; {NTAPI}
+
+  P_IMAGE_TLS_DIRECTORY64 = ^_IMAGE_TLS_DIRECTORY64;
+  _IMAGE_TLS_DIRECTORY64 =  record
+      StartAddressOfRawData : ULONGLONG;
+      EndAddressOfRawData : ULONGLONG;
+      AddressOfIndex : ULONGLONG;               { PDWORD }
+      AddressOfCallBacks : ULONGLONG;           { PIMAGE_TLS_CALLBACK *; }
+      SizeOfZeroFill : DWORD;
+          case longint of
+            0 : ( Characteristics : DWORD );
+            1 : ( CharacteristicsFields:  bitpacked record
+                                  Reserved0 : 0..$FFFFF; // 5 nibbles=20 bits
+                                  Alignment : 0..$F;      // 4 bits
+                                  Reserved1 : 0..$FF;     // 8 bits
+              end );
+    end;
+  IMAGE_TLS_DIRECTORY64 = _IMAGE_TLS_DIRECTORY64;
+  PIMAGE_TLS_DIRECTORY64 = ^IMAGE_TLS_DIRECTORY64;
+
+  PPIMAGE_TLS_DIRECTORY64 = ^PIMAGE_TLS_DIRECTORY64;
+  LPIMAGE_TLS_DIRECTORY64 = PIMAGE_TLS_DIRECTORY64;
+  P_IMAGE_TLS_DIRECTORY32 = ^_IMAGE_TLS_DIRECTORY32;
+  _IMAGE_TLS_DIRECTORY32 =  record
+      StartAddressOfRawData : DWORD;
+      EndAddressOfRawData : DWORD;
+      AddressOfIndex : DWORD;                      { PDWORD }
+      AddressOfCallBacks : DWORD;                  { PIMAGE_TLS_CALLBACK * }
+      SizeOfZeroFill : DWORD;
+          case longint of
+            0 : ( Characteristics : DWORD );
+            1 : ( CharacteristicsFields : bitpacked  record
+                                 Reserved0 : 0..$FFFFF; // 5 nibbles=20 bits
+                                 Alignment : 0..$F;      // 4 bits
+                                 Reserved1 : 0..$FF;     // 8 bits
+              end );
+
+    end;
+  IMAGE_TLS_DIRECTORY32 = _IMAGE_TLS_DIRECTORY32;
+  PIMAGE_TLS_DIRECTORY32 = ^IMAGE_TLS_DIRECTORY32;
+
+
+
+  PPIMAGE_TLS_DIRECTORY32 = ^PIMAGE_TLS_DIRECTORY32;
+  LPIMAGE_TLS_DIRECTORY32 = PIMAGE_TLS_DIRECTORY32;
+
+  {$ifdef WIN64}
+
+  PIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA64;
+  IMAGE_THUNK_DATA = IMAGE_THUNK_DATA64;
+
+  PPIMAGE_THUNK_DATA = ^PIMAGE_THUNK_DATA64;
+  LPIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA64;
+
+  PIMAGE_TLS_DIRECTORY = ^IMAGE_TLS_DIRECTORY;
+  IMAGE_TLS_DIRECTORY = IMAGE_TLS_DIRECTORY64;
+
+  PPIMAGE_TLS_DIRECTORY = ^PIMAGE_TLS_DIRECTORY;
+  LPIMAGE_TLS_DIRECTORY = PIMAGE_TLS_DIRECTORY64;
+  {$else}
+
+  PIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA32;
+  IMAGE_THUNK_DATA = IMAGE_THUNK_DATA32;
+
+  PPIMAGE_THUNK_DATA = ^PIMAGE_THUNK_DATA;
+  LPIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA32;
+  PIMAGE_TLS_DIRECTORY = ^IMAGE_TLS_DIRECTORY;
+  IMAGE_TLS_DIRECTORY = IMAGE_TLS_DIRECTORY32;
+
+  PPIMAGE_TLS_DIRECTORY = ^PIMAGE_TLS_DIRECTORY;
+  LPIMAGE_TLS_DIRECTORY = PIMAGE_TLS_DIRECTORY32;
+  {$endif}
+
+  P_IMAGE_IMPORT_DESCRIPTOR = ^_IMAGE_IMPORT_DESCRIPTOR;
+  _IMAGE_IMPORT_DESCRIPTOR =  record
+          case longint of
+            0 : ( Characteristics : DWORD );     { 0 for terminating null import descriptor }
+            1 : ( OriginalFirstThunk : DWORD;    { RVA to original unbound IAT (PIMAGE_THUNK_DATA) }
+                  TimeDateStamp : DWORD;         { 0 if not bound, }
+                                                 // -1 if bound, and real date\time stamp
+                                                 //     in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND)
+                                                 // O.W. date/time stamp of DLL bound to (Old BIND)
+                  ForwarderChain : DWORD;        // -1 if no forwarders
+                  Name : DWORD;
+                  FirstThunk : DWORD;            // RVA to IAT (if bound this IAT has actual addresses)
+                );  
+    end;
+  IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR;
+  PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR   {UNALIGNED  }     ;
+
+
+  PPIMAGE_IMPORT_DESCRIPTOR = ^PIMAGE_IMPORT_DESCRIPTOR;
+  LPIMAGE_IMPORT_DESCRIPTOR = PIMAGE_IMPORT_DESCRIPTOR;
+  { }
+  { New format import descriptors pointed to by DataDirectory[ IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT ] }
+  { }
+
+
+  P_IMAGE_BOUND_IMPORT_DESCRIPTOR = ^_IMAGE_BOUND_IMPORT_DESCRIPTOR;
+  _IMAGE_BOUND_IMPORT_DESCRIPTOR =  record
+      TimeDateStamp : DWORD;
+      OffsetModuleName : WORD;
+      NumberOfModuleForwarderRefs : WORD;
+      { Array of zero or more IMAGE_BOUND_FORWARDER_REF follows }
+    end;
+
+  IMAGE_BOUND_IMPORT_DESCRIPTOR = _IMAGE_BOUND_IMPORT_DESCRIPTOR;
+  PIMAGE_BOUND_IMPORT_DESCRIPTOR = ^IMAGE_BOUND_IMPORT_DESCRIPTOR;
+  LPIMAGE_BOUND_IMPORT_DESCRIPTOR = P_IMAGE_BOUND_IMPORT_DESCRIPTOR;
+  PPIMAGE_BOUND_IMPORT_DESCRIPTOR = ^PIMAGE_BOUND_IMPORT_DESCRIPTOR;
+
+  P_IMAGE_BOUND_FORWARDER_REF = ^_IMAGE_BOUND_FORWARDER_REF;
+  _IMAGE_BOUND_FORWARDER_REF =  record
+      TimeDateStamp : DWORD;
+      OffsetModuleName : WORD;
+      Reserved : WORD;
+    end;
+  IMAGE_BOUND_FORWARDER_REF = _IMAGE_BOUND_FORWARDER_REF;
+  PIMAGE_BOUND_FORWARDER_REF = ^IMAGE_BOUND_FORWARDER_REF;
+  LPIMAGE_BOUND_FORWARDER_REF = P_IMAGE_BOUND_FORWARDER_REF;
+  PPIMAGE_BOUND_FORWARDER_REF = ^PIMAGE_BOUND_FORWARDER_REF;
+  { Delay load version 2 }
+
+  _IMAGE_DELAYLOAD_DESCRIPTOR = record
+        case longint of
+        0: (AllAttributes :Dword;
+            DllNameRVA,                       // RVA to the name of the target library (NULL-terminate ASCII string)
+            ModuleHandleRVA,                  // RVA to the HMODULE caching location (PHMODULE)
+            ImportAddressTableRVA,            // RVA to the start of the IAT (PIMAGE_THUNK_DATA)
+            ImportNameTableRVA,               // RVA to the start of the name table (PIMAGE_THUNK_DATA::AddressOfData)
+            BoundImportAddressTableRVA,       // RVA to an optional bound IAT
+            UnloadInformationTableRVA,        // RVA to an optional unload info table
+            TimeDateStamp            : DWORD; // 0 if not bound,
+                                            // Otherwise, date/time of the target DLL
+         );
+        1: (Attributes:bitpacked record
+             rvabased:0..1;  {1 bits}                 // Delay load version 2
+             ReservedAttributes: 0..$7FFFFFF; {31 bits}
+             end;)
+     end;
+
+  IMAGE_DELAYLOAD_DESCRIPTOR= _IMAGE_DELAYLOAD_DESCRIPTOR;
+  PIMAGE_DELAYLOAD_DESCRIPTOR= ^_IMAGE_DELAYLOAD_DESCRIPTOR;
+  PCIMAGE_DELAYLOAD_DESCRIPTOR= PIMAGE_DELAYLOAD_DESCRIPTOR;
+{$pop}
+
  tagCOMBOBOXINFO = record
     cbSize: DWORD;
     rcItem: TRect;

tests/test/tutf8cpl.pp

@@ -0,0 +1,148 @@
+{$mode objfpc}
+{$codepage utf8}
+
+var
+  name: utf8string;
+  
+procedure check(index, lookahead: longint; combiningdiacritics: boolean; expectedresult: longint; checknr: longint);
+begin
+  if Utf8CodePointLen(pchar(@name[index]),lookahead,combiningdiacritics)<>expectedresult then
+    begin
+      writeln('check ',checknr,': Utf8CodePointLen(',copy(name,index,length(name)),',',lookahead,',',combiningdiacritics,') = ',Utf8CodePointLen(pchar(@name[index]),lookahead,false),' <> expected ',expectedresult);
+      halt(1);
+    end;
+end;
+
+begin
+  name:='a';
+  check(1,0,false,0,1);
+  check(1,1,false,1,2);
+  check(1,1,true,1,3);
+  check(1,6,false,1,4);
+  check(1,6,true,1,5);
+  name:='ab';
+  check(1,6,false,1,6);
+  check(1,6,true,1,7);
+  check(1,1,false,1,8);
+  check(1,1,true,1,9);
+  check(2,6,false,1,10);
+  check(2,6,true,1,11);
+  name:='é';
+  check(1,1,false,0,12);
+  check(1,1,true,0,13);
+  check(1,2,false,2,14);
+  check(1,2,true,2,15);
+  check(2,1,false,-1,16);
+  check(2,1,true,-1,17);
+  check(2,3,false,-1,18);
+  check(2,3,true,-1,19);
+  name:='éa';
+  check(1,1,false,0,20);
+  check(1,1,true,0,21);
+  check(1,2,false,2,22);
+  check(1,2,true,2,23);
+  check(2,1,false,-1,24);
+  check(2,1,true,-1,25);
+  check(2,3,false,-1,26);
+  check(2,3,true,-1,27);
+  check(3,1,false,1,28);
+  check(3,1,true,1,29);
+  check(3,4,false,1,30);
+  check(3,4,true,1,31);
+  name[3]:=name[2];
+  check(1,1,false,0,32);
+  check(1,1,true,0,33);
+  check(1,2,false,2,34);
+  check(1,2,true,2,35);
+  check(2,1,false,-1,36);
+  check(2,1,true,-1,37);
+  check(2,3,false,-1,38);
+  check(2,3,true,-1,39);
+  check(3,1,false,-1,40);
+  check(3,1,true,-1,41);
+  check(3,4,false,-1,42);
+  check(3,4,true,-1,43);
+  { e + combining ` }
+  name:='e'#$0300'b';
+  { check just the e without accent }
+  check(1,1,false,1,44);
+  check(1,1,true,1,45);
+  check(1,2,false,1,46);
+  { partial diacritical mark }
+  check(1,2,true,0,47);
+  check(1,3,false,1,48);
+  { complete diacritical mark }
+  check(1,3,true,3,49);
+  check(1,4,false,1,50);
+  { complete diacritical mark (ignore extra character) }
+  check(1,4,true,3,51);
+  { start of combining diacritical mark -- treated as independent utf-8 codepoint }
+  check(2,1,false,0,52);
+  check(2,1,true,0,53);
+  check(2,3,false,2,54);
+  check(2,3,true,2,55);
+  { middle of the combining diacritical mark }
+  check(3,1,false,-1,56);
+  check(3,1,true,-1,57);
+  check(3,4,false,-1,58);
+  check(3,4,true,-1,59);
+  { corrupt diacritical mark = no diacritical mark }
+  name[3]:=name[4];
+  { partial diacritical mark (the corrupted byte is not included in the
+    lookahead) }
+  check(1,2,true,0,60);
+  check(1,3,false,1,61);
+  { ignore corrupt diacritical mark }
+  check(1,3,true,1,62);
+  check(1,4,false,1,63);
+  check(1,4,true,1,64);
+  { e + combining circle + combining superscript 'n' }
+  name:='e'#$20DD#$1DE0'b';
+  { partial diacritical mark }
+  check(1,2,true,0,65);
+  check(1,3,false,1,66);
+  check(1,3,true,0,67);
+  check(1,4,false,1,68);
+  { complete diacritical mark }
+  check(1,4,true,4,69);
+  check(1,4,false,1,70);
+  { partial second diacritical mark }
+  check(1,5,true,0,71);
+  check(1,5,false,1,72);
+  check(1,6,true,0,73);
+  check(1,6,false,1,74);
+  { complete both diacritical marks }
+  check(1,7,true,7,75);
+  check(1,7,false,1,76);
+  check(1,10,true,7,77);
+  check(1,10,false,1,78);
+  { complete both diacritical marks without first character }
+  check(2,6,true,6,79);
+  check(2,20,true,6,80);
+  { only the first one, treated as independent codepoint }
+  check(2,7,false,3,81);
+  { corrupt second diacritical mark }
+  name[7]:=name[8];
+  { partial second diacritical mark }
+  check(1,5,true,0,82);
+  check(1,5,false,1,83);
+  check(1,6,true,0,84);
+  check(1,6,false,1,85);
+  { including bad byte -> ignore second diacritical mark completely
+    (can't know it's part of a diacritical mark or something else) }
+  check(1,7,true,4,86);
+  check(1,7,false,1,87);
+  { complete both diacritical marks without first character,
+    but with corrupted byte }
+  check(2,7,true,3,88);
+  check(2,20,true,3,89);
+  { corrupted diacritical mark by itself }
+  { 1) incomplete }
+  check(5,1,false,0,90);
+  check(5,1,true,0,91);
+  check(5,2,false,0,92);
+  check(5,2,true,0,93);
+  { 2) invalid }
+  check(5,3,false,-2,94);
+  check(5,3,true,-2,95);
+end.

utils/fpdoc/dglobals.pp

@@ -475,9 +475,6 @@ begin
       LastChild := Child;
       Child := Child.NextSibling;
     end;
-    { No child found, let's create one if we are at the end of the path }
-    if DotPos > 0 then
-      Raise Exception.CreateFmt('Link path does not exist: %s',[APathName]);
     Result := TLinkNode.Create(ChildName, ALinkTo);
     if Assigned(LastChild) then
       LastChild.FNextSibling := Result

utils/fpdoc/fpdoc.pp

@@ -284,7 +284,7 @@ begin
   else if s = '--warn-no-node' then
     FCreator.Options.WarnNoNode := True
   else if s = '--show-private' then
-    FCreator.Options.ShowPrivate := False
+    FCreator.Options.ShowPrivate := True
   else if s = '--stop-on-parser-error' then
     FCreator.Options.StopOnParseError := True
   else if s = '--dont-trim' then

utils/fpdoc/unitdiff.pp

@@ -12,6 +12,8 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 
+{$mode objfpc}
+{$h+}
 
 program unitdiff;
 

utils/fppkg/lnet/lcontrolstack.pp

@@ -37,15 +37,18 @@ type
    private
     FItems: array of Char;
     FIndex: Byte;
+    FAllowInflation: Boolean;
     FOnFull: TLOnFull;
     function GetFull: Boolean;
     function GetItem(const i: Byte): Char;
     procedure SetItem(const i: Byte; const Value: Char);
+    procedure SetAllowInflation(const b: boolean);
    public
     constructor Create;
     procedure Clear;
     procedure Push(const Value: Char);
     property ItemIndex: Byte read FIndex;
+    property AllowInflation: Boolean read FAllowInflation write SetAllowInflation;
     property Items[i: Byte]: Char read GetItem write SetItem; default;
     property Full: Boolean read GetFull;
     property OnFull: TLOnFull read FOnFull write FOnFull;
@@ -55,47 +58,80 @@ implementation
 
 uses
   lTelnet;
+
+(* The normal situation is that there are up to TL_CSLENGTH items on the stack. *)
+(* However this may be relaxed in cases (assumed to be rare) where subcommand   *)
+(* parameters are being accumulated.                                            *)
   
 constructor TLControlStack.Create;
 begin
   FOnFull:=nil;
-  FIndex:=0;
+  FIndex:=0;                            (* Next insertion point, [0] when empty *)
+  FAllowInflation := false;
   SetLength(FItems, TL_CSLENGTH);
 end;
 
 function TLControlStack.GetFull: Boolean;
 begin
-  Result:=False;
-  if FIndex >= TL_CSLENGTH then
-    Result:=True;
+  Result:=False;                        (* It's full when it has a complete     *)
+  if FIndex >= TL_CSLENGTH then         (* command, irrespective of whether the *)
+    Result:=True;                       (* stack's inflated by a subcommand.    *)
 end;
 
 function TLControlStack.GetItem(const i: Byte): Char;
 begin
   Result:=TS_NOP;
-  if i < TL_CSLENGTH then
-    Result:=FItems[i];
+  if not FAllowInflation then begin
+    if i < TL_CSLENGTH then
+      Result:=FItems[i]
+  end else
+    if i < Length(FItems) then
+      Result:=FItems[i]
 end;
 
 procedure TLControlStack.SetItem(const i: Byte; const Value: Char);
 begin
-  if i < TL_CSLENGTH then
-    FItems[i]:=Value;
+  if not FAllowInflation then begin
+    if i < TL_CSLENGTH then
+      FItems[i]:=Value
+  end else begin
+    while i >= Length(FItems) do begin
+      SetLength(FItems, Length(FItems) + 1);
+      FItems[Length(FItems) - 1] := TS_NOP
+    end;
+    FItems[i] := Value
+  end
+end;
+
+procedure TLControlStack.SetAllowInflation(const b: boolean);
+
+begin
+  FAllowInflation := b;
+  if not b then                         (* No more funny stuff please           *)
+    Clear
 end;
 
 procedure TLControlStack.Clear;
 begin
   FIndex:=0;
+  FAllowInflation := false;
+  SetLength(FItems, TL_CSLENGTH)        (* In case inflation was allowed        *)
 end;
 
 procedure TLControlStack.Push(const Value: Char);
 begin
-  if FIndex < TL_CSLENGTH then begin
-    FItems[FIndex]:=Value;
-    Inc(FIndex);
-    if Full and Assigned(FOnFull) then
-      FOnFull;
+  if not FAllowInflation then
+    if FIndex < TL_CSLENGTH then begin
+      FItems[FIndex]:=Value;
+      Inc(FIndex)
+    end else begin end
+  else begin
+    SetLength(FItems, Length(FItems) + 1);
+    FItems[Length(FItems) - 1] := Value;
+    FIndex := Length(FItems)
   end;
+  if Full and Assigned(FOnFull) then
+    FOnFull;
 end;
 
 end.

utils/fppkg/lnet/lftp.pp

@@ -106,7 +106,7 @@ type
   
   TLFTPTelnetClient = class(TLTelnetClient)
    protected
-    procedure React(const Operation, Command: Char); override;
+    function React(const Operation, Command: Char):boolean; override;
   end;
 
   { TLFTPClient }
@@ -368,8 +368,9 @@ end;
 
 { TLFTPTelnetClient }
 
-procedure TLFTPTelnetClient.React(const Operation, Command: Char);
+function TLFTPTelnetClient.React(const Operation, Command: Char):boolean;
 begin
+  result:=false;
   // don't do a FUCK since they broke Telnet in FTP as per-usual
 end;
 

utils/fppkg/lnet/ltelnet.pp

@@ -27,7 +27,7 @@ unit lTelnet;
 interface
 
 uses
-  Classes, lNet, lControlStack;
+  Classes, SysUtils, lNet, lControlStack;
   
 const
   // Telnet printer signals
@@ -72,9 +72,11 @@ type
   TLSubcommandCallback= function(command: char; const parameters, defaultResponse: string): string;
   TLSubcommandEntry= record
                        callback: TLSubcommandCallback;
-                       defaultResponse: string
+                       defaultResponse: string;
+                       requiredParams: integer
                      end;
   TLSubcommandArray= array[#$00..#$ff] of TLSubcommandEntry;
+  EInsufficientSubcommandParameters= class(Exception);
 
   { TLTelnet }
 
@@ -117,7 +119,7 @@ type
     procedure StackFull;
     procedure DoubleIAC(var s: string);
     function TelnetParse(const msg: string): Integer;
-    procedure React(const Operation, Command: Char); virtual; abstract;
+    function React(const Operation, Command: Char): boolean; virtual; abstract;
     procedure SendCommand(const Command: Char; const Value: Boolean); virtual; abstract;
 
     procedure OnCs(aSocket: TLSocket);
@@ -136,7 +138,8 @@ type
     procedure SetOption(const Option: Char);
     procedure UnSetOption(const Option: Char);
 
-    function RegisterSubcommand(aOption: char; callback: TLSubcommandCallback; const defaultResponse: string= ''): boolean;
+    function RegisterSubcommand(aOption: char; callback: TLSubcommandCallback;
+                const defaultResponse: string= ''; requiredParams: integer= 0): boolean;
 
     procedure Disconnect(const Forced: Boolean = True); override;
     
@@ -164,7 +167,7 @@ type
     procedure OnRe(aSocket: TLSocket);
     procedure OnCo(aSocket: TLSocket);
 
-    procedure React(const Operation, Command: Char); override;
+    function React(const Operation, Command: Char): boolean; override;
     
     procedure SendCommand(const Command: Char; const Value: Boolean); override;
    public
@@ -190,7 +193,9 @@ function LTelnetSubcommandCallback(command: char; const parameters, defaultRespo
 implementation
 
 uses
-  SysUtils, Math;
+  Math;
+
+const   subcommandEndLength= 2;
 
 var
   zz: Char;
@@ -306,8 +311,10 @@ begin
     begin
       FOutput.WriteByte(Byte(FStack[1]));
       FOutput.WriteByte(Byte(FStack[2]));
-    end else React(FStack[1], FStack[2]);
-  FStack.Clear;
+      FStack.Clear
+    end else
+      if React(FStack[1], FStack[2]) then
+        FStack.Clear
 end;
 
 procedure TLTelnet.DoubleIAC(var s: string);
@@ -394,15 +401,22 @@ end;
 
 (* If already set, the callback can be reverted to nil but it can't be changed  *)
 (* in a single step. The default response, if specified, is used by the         *)
-(* LTelnetSubcommandCallback() function and is available to others.             *)
+(* LTelnetSubcommandCallback() function and is available to others; the         *)
+(* callback will not be invoked until there is at least the indicated number of *)
+(* parameter bytes available.                                                   *)
 //
-function TLTelnet.RegisterSubcommand(aOption: char; callback: TLSubcommandCallback; const defaultResponse: string= ''): boolean;
+function TLTelnet.RegisterSubcommand(aOption: char; callback: TLSubcommandCallback;
+            const defaultResponse: string= ''; requiredParams: integer= 0): boolean;
 
 begin
   result := (not Assigned(FSubcommandCallbacks[aOption].callback)) or (@callback = nil);
   if result then begin
     FSubcommandCallbacks[aOption].callback := callback;
-    FSubcommandCallbacks[aOption].defaultResponse := defaultResponse
+    FSubcommandCallbacks[aOption].defaultResponse := defaultResponse;
+    Inc(requiredParams, subcommandEndLength);
+    if requiredParams < 0 then          (* Assume -subcommandEndLength is a     *)
+      requiredParams := 0;              (* valid parameter.                     *)
+    FSubcommandCallbacks[aOption].requiredParams := requiredParams;
   end
 end { TLTelnet.RegisterSubcommand } ;
 
@@ -464,7 +478,7 @@ begin
     FOnConnect(aSocket);
 end;
 
-procedure TLTelnetClient.React(const Operation, Command: Char);
+function TLTelnetClient.React(const Operation, Command: Char): boolean;
 
   procedure Accept(const Operation, Command: Char);
   begin
@@ -487,17 +501,28 @@ procedure TLTelnetClient.React(const Operation, Command: Char);
   end;
 
 (* Retrieve the parameters from the current instance, and pass them explicitly  *)
-(* to the callback.                                                             *)
+(* to the callback. Return false if there are insufficient parameters on the    *)
+(* stack.                                                                       *)
 //
-  procedure subcommand(command: char);
+  function subcommand(command: char): boolean;
 
   var   parameters, response: string;
         i: integer;
 
   begin
-    if FStack.ItemIndex > 5 then begin
-      SetLength(parameters, FStack.ItemIndex - 5);
-      Move(FStack[3], parameters[1], FStack.ItemIndex - 5);
+    FStack.AllowInflation := true;      (* We might need more than the standard *)
+    if FStack.ItemIndex > 65536 then    (* command, but protect against parse   *)
+      {%H- 6018 } exit(true);           (* failure which could be a DoS attack. *)
+    i := FStack.ItemIndex - TL_CSLENGTH; (* Number of parameter bytes available.*)
+    if i < FSubcommandCallbacks[command].requiredParams then
+      exit(false);                      (* Early insufficient-parameters decision *)
+    result := true;
+    if FStack.ItemIndex > TL_CSLENGTH then begin
+      SetLength(parameters, FStack.ItemIndex - TL_CSLENGTH );
+      Move(FStack[3], parameters[1], FStack.ItemIndex - TL_CSLENGTH );
+      if (Length(parameters) >= 2) and (parameters[Length(parameters)] = TS_IAC) and
+                                (parameters[Length(parameters) - 1] <> TS_IAC) then
+        exit(false);                    (* Special case: need at least one more *)
       i := 1;
       while i <= Length(parameters) - 1 do      (* Undouble IACs                *)
         if (parameters[i] = TS_IAC) and (parameters[i + 1] = TS_IAC) then
@@ -506,13 +531,27 @@ procedure TLTelnetClient.React(const Operation, Command: Char);
           Inc(i)
     end else
       parameters := '';
-    response := FSubcommandCallbacks[command].callback(command, parameters, FSubcommandCallbacks[command].defaultResponse);
+    if Length(parameters) < FSubcommandCallbacks[command].requiredParams then
+      exit(false);                      (* Insufficient params after IAC undouble *)
+    if (FSubcommandCallbacks[command].requiredParams >= subcommandEndLength) and
+                                (Length(parameters) >= subcommandEndLength) then
+      SetLength(parameters, Length(parameters) - subcommandEndLength);
+    try
+      response := FSubcommandCallbacks[command].callback(command, parameters,
+                                FSubcommandCallbacks[command].defaultResponse)
+    except
+      on e: EInsufficientSubcommandParameters do
+        Exit(false)                     (* Late insufficient-parameters decision *)
+      else
+        Raise                           (* Application-specific error           *)
+    end;
     DoubleIAC(response);
     AddToBuffer(TS_IAC + TS_SB + command + response + TS_IAC + TS_SE);
     OnCs(nil)
   end { subcommand } ;
 
 begin
+  result := true;                       (* Stack will normally be cleared       *)
   {$ifdef debug}
   Writeln('**GOT** ', TNames[Operation], ' ', TNames[Command]);
   {$endif}
@@ -529,7 +568,12 @@ begin
     TS_SB   : if not Assigned(FSubcommandCallbacks[command].callback) then
                 refuse(TS_WONT, command)
               else
-                subcommand(command)
+                result := subcommand(command)
+
+(* In the final case above, the stack will not be cleared if sufficient         *)
+(* parameters to keep the subcommand happy have not yet been parsed out of the  *)
+(* message.                                                                     *)
+
   end;
 end;
 
@@ -559,7 +603,7 @@ end;
 
 function TLTelnetClient.Get(out aData; const aSize: Integer; aSocket: TLSocket): Integer;
 begin
-  Result := FOutput.Read(aData, aSize);
+  Result := FOutput.Read(aData {%H- 5058 } , aSize);
   if FOutput.Position = FOutput.Size then
     FOutput.Clear;
 end;

utils/h2pas/h2pas.pas

@@ -4,7 +4,7 @@
 (* global definitions: *)
 
 program h2pas;
-
+{$H+}
 (*
     Copyright (c) 1998-2000 by Florian Klaempfl
 
@@ -9392,4 +9392,4 @@ begin
   PTypeList.Free;
   freedynlibproc.free;
   loaddynlibproc.free;
-end.
+end.

utils/h2pas/h2pas.y

@@ -1,6 +1,6 @@
 %{
 program h2pas;
-
+{$H+}
 (*
     Copyright (c) 1998-2000 by Florian Klaempfl
 

utils/h2pas/h2plexlib.pas

@@ -1,6 +1,5 @@
-
 unit h2pLexLib;
-
+{$H+}
 (* Standard Lex library unit for TP Lex Version 3.0.
    2-11-91 AG *)
 
@@ -25,7 +24,8 @@ interface
 
 (* Variables:
 
-   The variable yytext contains the current match, yyleng its length.
+   The variable yytext contains the current match, yyleng(was removed because of
+   $H+) its length.
    The variable yyline contains the current input line, and yylineno and
    yycolno denote the current input position (line, column). These values
    are often used in giving error diagnostics (however, they will only be
@@ -43,8 +43,6 @@ yyinput, yyoutput : Text;        (* input and output file *)
 yyline,yyprevline : String;      (* current and previous input line *)
 yylineno, yycolno : Integer;     (* current input position *)
 yytext            : String;      (* matched text (should be considered r/o) *)
-yyleng            : Byte         (* length of matched text *)
-  absolute yytext;
 
 (* I/O routines:
 
@@ -256,14 +254,14 @@ yysstate, yylstate : Integer;
 yymatches          : Integer;
 yystack            : array [1..max_matches] of Integer;
 yypos              : array [1..max_rules] of Integer;
-yysleng            : Byte;
+yysleng            : Integer;
 
 (* Utilities: *)
 
 procedure echo;
   var i : Integer;
   begin
-    for i := 1 to yyleng do
+    for i := 1 to Length(yytext) do
       put_char(yytext[i])
   end(*echo*);
 
@@ -275,16 +273,16 @@ procedure yymore;
 procedure yyless ( n : Integer );
   var i : Integer;
   begin
-    for i := yyleng downto n+1 do
+    for i := Length(yytext) downto n+1 do
       unget_char(yytext[i]);
-    yyleng := n;
+    SetLength(yytext,n);
   end(*yyless*);
 
 procedure reject;
   var i : Integer;
   begin
     yyreject := true;
-    for i := yyleng+1 to yysleng do
+    for i := Length(yytext)+1 to yysleng do
       yytext := yytext+get_char;
     dec(yymatches);
   end(*reject*);
@@ -333,16 +331,14 @@ procedure yynew;
 
 procedure yyscan;
   begin
-    if yyleng=255 then fatal('yytext overflow');
     yyactchar := get_char;
-    inc(yyleng);
-    yytext[yyleng] := yyactchar;
+    yytext:=yytext+yyactchar;
   end(*yyscan*);
 
 procedure yymark ( n : Integer );
   begin
     if n>max_rules then fatal('too many rules');
-    yypos[n] := yyleng;
+    yypos[n] := Length(yytext);
   end(*yymark*);
 
 procedure yymatch ( n : Integer );
@@ -359,12 +355,12 @@ function yyfind ( var n : Integer ) : Boolean;
       dec(yymatches);
     if yymatches>0 then
       begin
-        yysleng := yyleng;
+        yysleng := Length(yytext);
         n       := yystack[yymatches];
         yyless(yypos[n]);
         yypos[n] := 0;
-        if yyleng>0 then
-          yylastchar := yytext[yyleng]
+        if Length(yytext)>0 then
+          yylastchar := yytext[Length(yytext)]
         else
           yylastchar := #0;
         yyfind := true;

utils/h2pas/h2poptions.pas

@@ -16,7 +16,9 @@
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
  ****************************************************************************}
+
 unit h2poptions;
+{$H+}
 interface
 
 const
@@ -138,7 +140,7 @@ end;
 
 Procedure ProcessOptions;
 Var
-  cp : string;
+  cp : string[255];   {because of cp[3] indexing}
   I : longint;
 
   Function GetNextParam (const Opt,Name : String) : string;

utils/h2pas/h2pyacclib.pas

@@ -34,7 +34,7 @@ $History: YACCLIB.PAS $
 
 
 {$I-}
-
+{$H+}
 unit h2pYaccLib;
 
 (* Yacc Library Unit for TP Yacc Version 3.0, 6-17-91 AG *)

utils/h2pas/scan.l

@@ -20,6 +20,7 @@
 
 
 unit scan;
+{$H+}
 
   interface
 

utils/h2pas/scan.pas

@@ -23,6 +23,7 @@
 
 
 unit scan;
+{$H+}
 
   interface
 

utils/pas2jni/readme.txt

@@ -1,9 +1,11 @@
 pas2jni - JNI bridge generator for Pascal.
 
-Copyright (c) 2013 by Yury Sidorov.
+Copyright (c) 2013-2015 by Yury Sidorov.
 
 The pas2jni utility generates a JNI (Java Native Interface) bridge for a Pascal code. Then the Pascal code (including classes and other advanced features) can be easily used in Java programs.
 
+The pas2jni wiki page is available here: http://wiki.freepascal.org/pas2jni
+
 For example you can do the following in Java:
 
 import pas.classes.*;
@@ -31,7 +33,7 @@ The following Pascal features are supported by pas2jni:
 - pointer type;
 - string types;
 - all numeric types;
-- method poiner.
+- method pointer.
 
 USUPPORTED features:
 - array;
@@ -51,7 +53,7 @@ pas2jni myunit -U/path/to/my/units;/path/to/FPC/units/*
 
 Here you specify myunit as the main unit and provide path to your compiled units and FPC compiled units. 
 
-After successfull run of pas2jni you will get the following output files:
+After successful run of pas2jni you will get the following output files:
 - file "myunitjni.pas" - a generated library unit to be compiled to a shared library. It will contain all your Pascal code to be used from Java.
 - folder "pas" - generated Java package "pas" to be used in your Java program. Interface to each Pascal unit is placed to a separate Java public class. 
 

utils/tply/README.txt

@@ -16,7 +16,7 @@ available from the TPLY homepage:
 
 For information about the Free Pascal Compiler, please refer to:
 
-	http://tfdec1.fys.kuleuven.ac.be/~michael/fpc/fpc.html
+	http://www.freepascal.org/
 
 The manual can be found in the files tply.tex (TeX version) and tply.doc
 (ASCII version) contained in the package. An extended version of the manual
@@ -44,7 +44,7 @@ The original version of the TPLY package was written by Albert Graef
 4.0-6.0. Berend de Boer <[email protected]>, the current maintainer of the
 Turbo/Borland Pascal version, adapted TPLY to take advantage of the large
 memory models in Borland Pascal 7.0 and Delphi. Michael Van Canneyt
-<[email protected]>, who maintains the Linux version of
+<[email protected]>, who maintains the Linux version of
 the Free Pascal compiler, is the author of the Free Pascal port.
 
 
@@ -77,10 +77,9 @@ to store things :-) The 16-bit DPMI platforms have tables extended as large as
 possible without changing basic Lex or Yacc sources.
 
 This version was ported to Free Pascal by Michael Van Canneyt
-<[email protected]> (April 1998).
+<[email protected]> (April 1998).
 
-*** Version 4.1		Michael Van Canneyt
-			<[email protected]>
+*** Version 4.1		Michael Van Canneyt <[email protected]>
 			Albert Graef <[email protected]>
 
 May 1998. Merges the Turbo and Free Pascal versions into a single package.
@@ -142,6 +141,18 @@ from the lex.pas and yacc.pas programs), the Lex and Yacc code templates
 (*.cod files), and the LexLib and YaccLib library units (compiled from
 lexlib.pas and yacclib.pas).
 
+The plex and pyacc programs will look for the *.cod files in the following locations:
+For unix-like operating systems:
+1. Current directory.
+2. Directory given by FPCDIR
+3. Directory /usr/local/lib/fpc/lexyacc
+4. Directory /usr/lib/fpc/lexyacc
+
+For other operating systems (dos/windows-like) : 
+1. Current directory.
+2. Directory given by FPCDIR 
+3. Directory where the executable is located.
+
 For the Free Pascal/Linux version, a Makefile is provided. To install, issue
 the command `make' (maybe you have to edit the Makefile before this to reflect
 your setup) and then `make install'. Note that in the Linux version the

utils/tply/lexbase.pas

@@ -65,7 +65,8 @@ lfilename     : String;
 pasfilename   : String;
 lstfilename   : String;
 codfilename   : String;
-codfilepath   : String; { Under linux, binary and conf file
+codfilepath1,
+codfilepath2  : String; { Under linux, binary and conf file
                           are not in the same path}
 
 (* Lex input, output, list and code template file: *)

utils/tply/plex.pas

@@ -62,7 +62,7 @@ $History: LEX.PAS $
 program Lex;
 
 uses
-  LexBase, LexTable, LexPos, LexDFA, LexOpt, LexList, LexRules, LexMsgs;
+  LexBase, LexTable, LexPos, LexDFA, LexOpt, LexList, LexRules, LexMsgs, SysUtils;
 
 
 procedure get_line;
@@ -597,15 +597,14 @@ var i : Integer;
 
 begin
 {$ifdef Unix}
- {$ifdef BSD}
-  codfilepath:='/usr/local/lib/fpc/lexyacc/';
- {$else}
-  codfilepath:='/usr/lib/fpc/lexyacc/';
- {$endif}
+  codfilepath1:='/usr/local/lib/fpc/lexyacc/';
+  codfilepath2:='/usr/lib/fpc/lexyacc/';
 {$else}
-  codfilepath:=path(paramstr(0));
+  codfilepath1:=path(paramstr(0));
+  codfilepath2:='';
 {$endif}
 
+
   (* sign-on: *)
 
   writeln(sign_on);
@@ -662,17 +661,29 @@ begin
   rewrite(yyout); if ioresult<>0 then fatal(cannot_open_file+pasfilename);
   rewrite(yylst); if ioresult<>0 then fatal(cannot_open_file+lstfilename);
 
-  (* search code template in current directory, then on path where Lex
-     was executed from: *)
+  (* search code template *)
   codfilename := 'yylex.cod';
   assign(yycod, codfilename);
   reset(yycod);
   if ioresult<>0 then
     begin
-      codfilename := codfilepath+'yylex.cod';
+      codfilename := IncludeTrailingPathDelimiter(GetEnvironmentVariable('FPCDIR'))+'lexyacc'+DirectorySeparator+'yylex.cod';
       assign(yycod, codfilename);
       reset(yycod);
-      if ioresult<>0 then fatal(cannot_open_file+codfilename);
+      if ioresult<>0 then
+        begin
+          codfilename := codfilepath1+'yylex.cod';
+          assign(yycod, codfilename);
+          reset(yycod);
+          if (codfilepath2<>'') and (ioresult<>0) then 
+            begin
+              codfilename := codfilepath2+'yylex.cod';
+              assign(yycod, codfilename);
+              reset(yycod);
+              if ioresult<>0 then 
+                fatal(cannot_open_file+codfilename);
+            end;
+        end;
     end;
 
   (* parse source grammar: *)

utils/tply/pyacc.pas

@@ -36,7 +36,7 @@ Last changes:
     updates)
 
 $History: YACC.PAS $
- *
+ * 
  * *****************  Version 2  *****************
  * User: Berend       Date: 96-10-10   Time: 21:16
  * Updated in $/Lex and Yacc/tply
@@ -110,7 +110,7 @@ uses
     YaccChk source not available anymore PM }
 {$ENDIF}
 {$ENDIF}
-  YaccLib, YaccBase, YaccMsgs, YaccSem, YaccTabl, YaccPars;
+  YaccLib, YaccBase, YaccMsgs, YaccSem, YaccTabl, YaccPars, SysUtils;
 
 const ID = 257;
 const C_ID = 258;
@@ -161,28 +161,28 @@ begin
          yyval := yyv[yysp-0];
        end;
    6 : begin
-         yyerrok;
+         yyerrok; 
        end;
    7 : begin
-         yyerrok;
+         yyerrok; 
        end;
    8 : begin
-         yyerrok;
+         yyerrok; 
        end;
    9 : begin
-         yyerrok;
+         yyerrok; 
        end;
   10 : begin
-         yyerrok;
+         yyerrok; 
        end;
   11 : begin
-         yyerrok;
+         yyerrok; 
        end;
   12 : begin
          yyval := yyv[yysp-0];
        end;
   13 : begin
-         yyerrok;
+         yyerrok; 
        end;
   14 : begin
          yyval := yyv[yysp-0];
@@ -191,19 +191,19 @@ begin
          yyval := yyv[yysp-0];
        end;
   16 : begin
-         error(rcurl_expected);
+         error(rcurl_expected); 
        end;
   17 : begin
          yyval := yyv[yysp-0];
        end;
   18 : begin
-         yyerrok;
+         yyerrok; 
        end;
   19 : begin
-         yyerrok;
+         yyerrok; 
        end;
   20 : begin
-         yyerrok;
+         yyerrok; 
        end;
   21 : begin
          yyval := yyv[yysp-0];
@@ -212,7 +212,7 @@ begin
          yyval := yyv[yysp-0];
        end;
   23 : begin
-         error(rbrace_expected);
+         error(rbrace_expected); 
        end;
   24 : begin
          yyval := yyv[yysp-0];
@@ -221,7 +221,7 @@ begin
          yyval := yyv[yysp-0];
        end;
   26 : begin
-         error(rangle_expected);
+         error(rangle_expected); 
        end;
   27 : begin
          yyval := yyv[yysp-0];
@@ -229,12 +229,12 @@ begin
   28 : begin
          sort_types;
          definitions;
-         next_section;
+         next_section; 
        end;
   29 : begin
          next_section;
          generate_parser;
-         next_section;
+         next_section; 
        end;
   30 : begin
          yyval := yyv[yysp-5];
@@ -242,48 +242,48 @@ begin
   31 : begin
        end;
   32 : begin
-         copy_rest_of_file;
+         copy_rest_of_file; 
        end;
   33 : begin
        end;
   34 : begin
-         yyerrok;
+         yyerrok; 
        end;
   35 : begin
-         error(error_in_def);
+         error(error_in_def); 
        end;
   36 : begin
-         startnt := ntsym(yyv[yysp-0]);
+         startnt := ntsym(yyv[yysp-0]); 
        end;
   37 : begin
-         error(ident_expected);
+         error(ident_expected); 
        end;
   38 : begin
-         copy_code;
+         copy_code; 
        end;
   39 : begin
          yyval := yyv[yysp-2];
        end;
   40 : begin
-         act_prec := 0;
+         act_prec := 0; 
        end;
   41 : begin
          yyval := yyv[yysp-3];
        end;
   42 : begin
-         act_prec := new_prec_level(left);
+         act_prec := new_prec_level(left); 
        end;
   43 : begin
          yyval := yyv[yysp-3];
        end;
   44 : begin
-         act_prec := new_prec_level(right);
+         act_prec := new_prec_level(right); 
        end;
   45 : begin
          yyval := yyv[yysp-3];
        end;
   46 : begin
-         act_prec := new_prec_level(nonassoc);
+         act_prec := new_prec_level(nonassoc); 
        end;
   47 : begin
          yyval := yyv[yysp-3];
@@ -295,169 +295,169 @@ begin
          yyval := yyv[yysp-1];
        end;
   50 : begin
-         act_type := 0;
+         act_type := 0; 
        end;
   51 : begin
-         act_type := yyv[yysp-1]; add_type(yyv[yysp-1]);
+         act_type := yyv[yysp-1]; add_type(yyv[yysp-1]); 
        end;
   52 : begin
          yyval := yyv[yysp-0];
        end;
   53 : begin
-         yyerrok;
+         yyerrok; 
        end;
   54 : begin
-         yyerrok;
+         yyerrok; 
        end;
   55 : begin
-         error(ident_expected);
+         error(ident_expected); 
        end;
   56 : begin
-         error(error_in_def);
+         error(error_in_def); 
        end;
   57 : begin
-         error(ident_expected);
+         error(ident_expected); 
        end;
   58 : begin
          if act_type<>0 then
          sym_type^[yyv[yysp-0]] := act_type;
          if act_prec<>0 then
-         sym_prec^[yyv[yysp-0]] := act_prec;
+         sym_prec^[yyv[yysp-0]] := act_prec; 
        end;
   59 : begin
          litsym(yyv[yysp-0], 0);
          if act_type<>0 then
          sym_type^[litsym(yyv[yysp-0], 0)] := act_type;
          if act_prec<>0 then
-         sym_prec^[litsym(yyv[yysp-0], 0)] := act_prec;
+         sym_prec^[litsym(yyv[yysp-0], 0)] := act_prec; 
        end;
   60 : begin
          litsym(yyv[yysp-0], 0);
          if act_type<>0 then
          sym_type^[litsym(yyv[yysp-0], 0)] := act_type;
          if act_prec<>0 then
-         sym_prec^[litsym(yyv[yysp-0], 0)] := act_prec;
+         sym_prec^[litsym(yyv[yysp-0], 0)] := act_prec; 
        end;
   61 : begin
          litsym(yyv[yysp-1], 0);
          if act_type<>0 then
          sym_type^[litsym(yyv[yysp-1], yyv[yysp-0])] := act_type;
          if act_prec<>0 then
-         sym_prec^[litsym(yyv[yysp-1], 0)]  := act_prec;
+         sym_prec^[litsym(yyv[yysp-1], 0)]  := act_prec; 
        end;
   62 : begin
          litsym(yyv[yysp-1], 0);
          if act_type<>0 then
          sym_type^[litsym(yyv[yysp-1], yyv[yysp-0])] := act_type;
          if act_prec<>0 then
-         sym_prec^[litsym(yyv[yysp-1], 0)]  := act_prec;
+         sym_prec^[litsym(yyv[yysp-1], 0)]  := act_prec; 
        end;
   63 : begin
          yyval := yyv[yysp-0];
        end;
   64 : begin
-         yyerrok;
+         yyerrok; 
        end;
   65 : begin
-         yyerrok;
+         yyerrok; 
        end;
   66 : begin
-         error(ident_expected);
+         error(ident_expected); 
        end;
   67 : begin
-         error(error_in_def);
+         error(error_in_def); 
        end;
   68 : begin
-         error(ident_expected);
+         error(ident_expected); 
        end;
   69 : begin
          if act_type<>0 then
-         sym_type^[ntsym(yyv[yysp-0])] := act_type;
+         sym_type^[ntsym(yyv[yysp-0])] := act_type; 
        end;
   70 : begin
-         next_section;
+         next_section; 
        end;
   71 : begin
          yyval := yyv[yysp-1];
        end;
   72 : begin
-         copy_code;
+         copy_code; 
        end;
   73 : begin
-         next_section;
+         next_section; 
        end;
   74 : begin
          yyval := yyv[yysp-4];
        end;
   75 : begin
-         yyerrok;
+         yyerrok; 
        end;
   76 : begin
-         error(error_in_rule);
+         error(error_in_rule); 
        end;
   77 : begin
-         error(error_in_rule);
+         error(error_in_rule); 
        end;
   78 : begin
-         start_rule(ntsym(yyv[yysp-0]));
+         start_rule(ntsym(yyv[yysp-0])); 
        end;
   79 : begin
-         start_body;
+         start_body; 
        end;
   80 : begin
-         end_body;
+         end_body; 
        end;
   81 : begin
          yyval := yyv[yysp-0];
        end;
   82 : begin
-         start_body;
+         start_body; 
        end;
   83 : begin
-         end_body;
+         end_body; 
        end;
   84 : begin
        end;
   85 : begin
-         add_symbol(yyv[yysp-0]); yyerrok;
+         add_symbol(yyv[yysp-0]); yyerrok; 
        end;
   86 : begin
-         add_symbol(sym(yyv[yysp-0])); yyerrok;
+         add_symbol(sym(yyv[yysp-0])); yyerrok; 
        end;
   87 : begin
-         add_symbol(sym(yyv[yysp-0])); yyerrok;
+         add_symbol(sym(yyv[yysp-0])); yyerrok; 
        end;
   88 : begin
-         add_action; yyerrok;
+         add_action; yyerrok; 
        end;
   89 : begin
-         error(error_in_rule);
+         error(error_in_rule); 
        end;
   90 : begin
-         copy_action;
+         copy_action; 
        end;
   91 : begin
          yyval := yyv[yysp-2];
        end;
   92 : begin
-         copy_single_action;
+         copy_single_action; 
        end;
   93 : begin
        end;
   94 : begin
-         add_rule_prec(yyv[yysp-0]);
+         add_rule_prec(yyv[yysp-0]); 
        end;
   95 : begin
          yyval := yyv[yysp-3];
        end;
   96 : begin
-         add_rule_prec(litsym(yyv[yysp-0], 0));
+         add_rule_prec(litsym(yyv[yysp-0], 0)); 
        end;
   97 : begin
          yyval := yyv[yysp-3];
        end;
   98 : begin
-         add_rule_prec(litsym(yyv[yysp-0], 0));
+         add_rule_prec(litsym(yyv[yysp-0], 0)); 
        end;
   99 : begin
          yyval := yyv[yysp-3];
@@ -468,7 +468,7 @@ begin
  101 : begin
        end;
  102 : begin
-         add_action;
+         add_action; 
        end;
   end;
 end(*yyaction*);
@@ -2131,10 +2131,10 @@ function yylex : integer;
             ('0'<=line[cno]) and (line[cno]<='9') or
             (line[cno]='_') or
             (line[cno]='.') ) do
-        begin
-          idstr := idstr+line[cno];
-          inc(cno)
-        end;
+	begin
+	  idstr := idstr+line[cno];
+	  inc(cno)
+	end;
       yylval := get_key(idstr);
       scan;
       if not end_of_input and (line[cno]=':') then
@@ -2352,9 +2352,9 @@ function yylex : integer;
     else
       case line[cno] of
         'A'..'Z', 'a'..'z', '_' : yylex := scan_ident;
-        '''', '"' : yylex := scan_literal;
-        '0'..'9' : yylex := scan_num;
-        '%', '\' : yylex := scan_keyword;
+	'''', '"' : yylex := scan_literal;
+	'0'..'9' : yylex := scan_num;
+	'%', '\' : yylex := scan_keyword;
         '=' :
           if (cno<length(line)) and (line[succ(cno)]='{') then
             begin
@@ -2363,7 +2363,7 @@ function yylex : integer;
             end
           else
             yylex := scan_char;
-        else yylex := scan_char;
+	else yylex := scan_char;
       end;
     if lno=lno0 then
       tokleng := cno-cno0
@@ -2375,13 +2375,11 @@ var i : Integer;
 
 begin
 {$ifdef Unix}
- {$ifdef BSD}
-  codfilepath:='/usr/local/lib/fpc/lexyacc/';
- {$else}
-  codfilepath:='/usr/lib/fpc/lexyacc/';
- {$endif}
+  codfilepath1:='/usr/local/lib/fpc/lexyacc/';
+  codfilepath2:='/usr/lib/fpc/lexyacc/';
 {$else}
-  codfilepath:=path(paramstr(0));
+  codfilepath1:=path(paramstr(0));
+  codfilepath2:='';
 {$endif}
 
   (* sign-on: *)
@@ -2440,17 +2438,29 @@ begin
   rewrite(yyout); if ioresult<>0 then fatal(cannot_open_file+pasfilename);
   rewrite(yylst); if ioresult<>0 then fatal(cannot_open_file+lstfilename);
 
-  (* search code template in current directory, then on path where Yacc
-     was executed from: *)
+  (* search code template *)
   codfilename := 'yyparse.cod';
   assign(yycod, codfilename);
   reset(yycod);
   if ioresult<>0 then
     begin
-      codfilename := codfilepath+'yyparse.cod';
+      codfilename := IncludeTrailingPathDelimiter(GetEnvironmentVariable('FPCDIR'))+'lexyacc'+DirectorySeparator+'yyparse.cod';
       assign(yycod, codfilename);
       reset(yycod);
-      if ioresult<>0 then fatal(cannot_open_file+codfilename);
+      if ioresult<>0 then
+        begin
+          codfilename := codfilepath1+'yyparse.cod';
+          assign(yycod, codfilename);
+          reset(yycod);
+          if (codfilepath2<>'') and (ioresult<>0) then 
+            begin
+              codfilename := codfilepath2+'yyparse.cod';
+              assign(yycod, codfilename);
+              reset(yycod);
+              if ioresult<>0 then 
+                fatal(cannot_open_file+codfilename);
+            end;
+        end;
     end;
 
   (* parse source grammar: *)
@@ -2513,4 +2523,4 @@ begin
 
   halt(errors);
 
-end(*Yacc*).
+end(*Yacc*).

utils/tply/pyacc.y

@@ -55,7 +55,7 @@
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-$Revision: 1.3 $
+$Revision: 1.5 $
 $Modtime: 96-08-01 11:24 $
 
 
@@ -129,16 +129,6 @@ $History: YACC.PAS $
 
 *)
 
-{$IFDEF MsDos}
-{$M 16384,0,655360}
-{$ENDIF}
-{$IFDEF DPMI}
-{$M 32768}
-{$ENDIF}
-{$IFDEF Windows}
-{$M 32768,0}
-{$ENDIF}
-
 {$X+}
 {$I-}
 program Yacc;
@@ -146,15 +136,11 @@ program Yacc;
 uses
 {$IFDEF Debug}
 {$IFDEF DPMI}
-  YaccChk,
-{$ENDIF}
+  { YaccChk, removed as obsolete,
+    YaccChk source not available anymore PM }
 {$ENDIF}
-{$IFDEF Windows}
-{$IFNDEF Console}
-  WinCrt,
 {$ENDIF}
-{$ENDIF}
-  YaccLib, YaccBase, YaccMsgs, YaccSem, YaccTabl, YaccPars;
+  YaccLib, YaccBase, YaccMsgs, YaccSem, YaccTabl, YaccPars, SysUtils;
 
 %}
 
@@ -725,13 +711,11 @@ var i : Integer;
 
 begin
 {$ifdef Unix}
- {$ifdef BSD}
-  codfilepath:='/usr/local/lib/fpc/lexyacc/';
- {$else}
-  codfilepath:='/usr/lib/fpc/lexyacc/';
- {$endif}
+  codfilepath1:='/usr/local/lib/fpc/lexyacc/';
+  codfilepath2:='/usr/lib/fpc/lexyacc/';
 {$else}
-  codfilepath:=path(paramstr(0));
+  codfilepath1:=path(paramstr(0));
+  codfilepath2:='';
 {$endif}
 
   (* sign-on: *)
@@ -790,17 +774,29 @@ begin
   rewrite(yyout); if ioresult<>0 then fatal(cannot_open_file+pasfilename);
   rewrite(yylst); if ioresult<>0 then fatal(cannot_open_file+lstfilename);
 
-  (* search code template in current directory, then on path where Yacc
-     was executed from: *)
+  (* search code template *)
   codfilename := 'yyparse.cod';
   assign(yycod, codfilename);
   reset(yycod);
   if ioresult<>0 then
     begin
-      codfilename := codfilepath+'yyparse.cod';
+      codfilename := IncludeTrailingPathDelimiter(GetEnvironmentVariable('FPCDIR'))+'lexyacc'+DirectorySeparator+'yyparse.cod';
       assign(yycod, codfilename);
       reset(yycod);
-      if ioresult<>0 then fatal(cannot_open_file+codfilename);
+      if ioresult<>0 then
+        begin
+          codfilename := codfilepath1+'yyparse.cod';
+          assign(yycod, codfilename);
+          reset(yycod);
+          if (codfilepath2<>'') and (ioresult<>0) then 
+            begin
+              codfilename := codfilepath2+'yyparse.cod';
+              assign(yycod, codfilename);
+              reset(yycod);
+              if ioresult<>0 then 
+                fatal(cannot_open_file+codfilename);
+            end;
+        end;
     end;
 
   (* parse source grammar: *)

utils/tply/yaccbase.pas

@@ -66,7 +66,8 @@ yfilename     : String;
 pasfilename   : String;
 lstfilename   : String;
 codfilename   : String;
-codfilepath   : String; { Under Linux,
+codfilepath1,
+codfilepath2  : String; { Under Linux,
                           binary and conf file are never in 1 directory.}
 
 (* Yacc input, output, list and code template file: *)