Merged revisions 12047-12050,12054,12056-12057,12059-12062,12064-12066,12073,12075,12077-12078,12082,12085,12087-12088,12092-12094,12099,12106-12110,12114,12117-12122,12125,12128-12131,12138,12141-12143,12152-12160,12162-12163,12166-12171,12173-12176,12196,12198-12205 via svnmerge from

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

........
r12047 | peter | 2008-11-10 22:04:08 +0100 (Mon, 10 Nov 2008) | 2 lines

  * object_dec can now return tobjectdef instead of tdef

........
r12048 | peter | 2008-11-11 10:05:39 +0100 (Tue, 11 Nov 2008) | 3 lines

  * split tvisibility from tsymoptions
  * replace current_object_option with symtable.currentvisibility

........
r12049 | florian | 2008-11-11 20:10:11 +0100 (Tue, 11 Nov 2008) | 1 line

* fix getlabelwithsym for 64 bit hosts and 32 bit targets
........
r12050 | jonas | 2008-11-11 21:20:29 +0100 (Tue, 11 Nov 2008) | 2 lines

  + new test (not yet fixed)

........
r12054 | marco | 2008-11-12 18:38:18 +0100 (Wed, 12 Nov 2008) | 2 lines

 * fix for win32 chm use.

........
r12056 | marco | 2008-11-12 18:53:13 +0100 (Wed, 12 Nov 2008) | 2 lines

 * Fixing result, no mode Delphi.

........
r12057 | yury | 2008-11-12 19:02:02 +0100 (Wed, 12 Nov 2008) | 1 line

* Removed unused local var.
........
r12059 | peter | 2008-11-12 19:54:39 +0100 (Wed, 12 Nov 2008) | 5 lines

  * current_objectdef is now always valid when parsing is within the
    context of a class. This can be either the class declaration or
    a method implementation
  * replaced all current_procinfo.procdef._class with current_objectdef

........
r12060 | marco | 2008-11-12 21:16:59 +0100 (Wed, 12 Nov 2008) | 1 line

 * fixed another whtmlhlp
........
r12061 | florian | 2008-11-12 21:42:21 +0100 (Wed, 12 Nov 2008) | 1 line

* compilation fixed
........
r12062 | florian | 2008-11-12 21:55:06 +0100 (Wed, 12 Nov 2008) | 1 line

* fixed wrongly fix of r11444 in r12049
........
r12064 | peter | 2008-11-12 23:38:38 +0100 (Wed, 12 Nov 2008) | 5 lines

  * refactor overload collection in tcallcandidates. separate
    the collecting of overloads. The actual building of
    candidate list is now common


........
r12065 | peter | 2008-11-12 23:42:19 +0100 (Wed, 12 Nov 2008) | 2 lines

  * remove obsolete unchain_overloads

........
r12066 | marco | 2008-11-13 09:53:50 +0100 (Thu, 13 Nov 2008) | 1 line

 * fix for 12619, security_descriptor_min_length now a sizeof as in the winsdk headers. (win64)
........
r12073 | jonas | 2008-11-13 20:44:30 +0100 (Thu, 13 Nov 2008) | 2 lines

  * more aint() type casts replaced by int64() type casts

........
r12075 | jonas | 2008-11-13 20:49:46 +0100 (Thu, 13 Nov 2008) | 4 lines

  * changed "Mixing signed expressions and longwords gives a 64bit result"
    from warning into a hint (it's not a potential error, but potential
    optimisation advice)

........
r12077 | andrew | 2008-11-14 05:43:19 +0100 (Fri, 14 Nov 2008) | 3 lines

Added ability for chm's to be searchable. A reader for the search index 
is partially implemented

........
r12078 | andrew | 2008-11-14 05:45:13 +0100 (Fri, 14 Nov 2008) | 2 lines

updated makefiles for chm folder

........
r12082 | michael | 2008-11-14 11:25:59 +0100 (Fri, 14 Nov 2008) | 1 line

* Patch from Mattias gaertner to remove the use of macros
........
r12085 | michael | 2008-11-14 11:33:43 +0100 (Fri, 14 Nov 2008) | 1 line

* Patch from andrew haines to make generated CHMs searchable
........
r12087 | michael | 2008-11-14 14:04:51 +0100 (Fri, 14 Nov 2008) | 1 line

* Fixed bug #12385
........
r12088 | michael | 2008-11-14 14:06:45 +0100 (Fri, 14 Nov 2008) | 1 line

* removed debug statement
........
r12092 | michael | 2008-11-14 14:41:52 +0100 (Fri, 14 Nov 2008) | 1 line

* Added test for bug #12385
........
r12093 | michael | 2008-11-14 14:52:40 +0100 (Fri, 14 Nov 2008) | 1 line

* Patch from Andrew to add searchable chm to usage options
........
r12094 | michael | 2008-11-14 19:19:39 +0100 (Fri, 14 Nov 2008) | 1 line

* Made the components descende from a common ancestor, otherwise lazarus thinks they are the same
........
r12099 | andrew | 2008-11-15 03:05:13 +0100 (Sat, 15 Nov 2008) | 2 lines

Removed some writeln's that were added by mistake from chmwriter

........
r12106 | micha | 2008-11-15 16:42:12 +0100 (Sat, 15 Nov 2008) | 1 line

* update linux syscall numbers (merge powerpc64 to powerpc)
........
r12107 | micha | 2008-11-15 16:43:52 +0100 (Sat, 15 Nov 2008) | 1 line

+ add splice and sync_file_range linux-only syscalls
........
r12108 | micha | 2008-11-15 18:04:27 +0100 (Sat, 15 Nov 2008) | 1 line

+ add fdatasync syscalls for linux
........
r12109 | micha | 2008-11-15 21:44:44 +0100 (Sat, 15 Nov 2008) | 1 line

* move fdatasync to linux unit
........
r12110 | micha | 2008-11-15 21:49:18 +0100 (Sat, 15 Nov 2008) | 1 line

* fix typo
........
r12114 | michael | 2008-11-15 23:13:59 +0100 (Sat, 15 Nov 2008) | 1 line

* Fixed lost default value in case of a property override
........
r12117 | michael | 2008-11-15 23:35:36 +0100 (Sat, 15 Nov 2008) | 1 line

* Test for default of property override: default of parent must be preserved
........
r12118 | florian | 2008-11-16 00:05:36 +0100 (Sun, 16 Nov 2008) | 2 lines

* handle methodpointer function results like records of the same size, resolves #12318

........
r12119 | andrew | 2008-11-16 06:45:19 +0100 (Sun, 16 Nov 2008) | 4 lines

* Fixed several chm bugs. 
* Now searching for particular words is supported instead of a full dump of the index. 
* Generated files don't crash the MS reader when searching.

........
r12120 | florian | 2008-11-16 14:27:59 +0100 (Sun, 16 Nov 2008) | 1 line

* convert int64 properly to c-bools, resolves #12614
........
r12121 | florian | 2008-11-16 15:08:31 +0100 (Sun, 16 Nov 2008) | 1 line

* actually the important part of r12120 containing the compiler change
........
r12122 | micha | 2008-11-16 15:22:36 +0100 (Sun, 16 Nov 2008) | 1 line

* fix lstat syscall for linux/powerpc64 (lstat64 is only for 32 bit platforms)
........
r12125 | michael | 2008-11-16 16:51:17 +0100 (Sun, 16 Nov 2008) | 1 line

* Patch from bug report 12467 applied
........
r12128 | micha | 2008-11-16 18:05:47 +0100 (Sun, 16 Nov 2008) | 1 line

+ add poll support for unix
........
r12129 | marco | 2008-11-16 20:08:03 +0100 (Sun, 16 Nov 2008) | 2 lines

 * compiletime range check fixes. SVN now compiles with -CROriot

........
r12130 | marco | 2008-11-16 20:56:22 +0100 (Sun, 16 Nov 2008) | 2 lines

 * Fix rangecheck problem, IDE now starts up after being compiled with -CROriot

........
r12131 | marco | 2008-11-16 21:03:30 +0100 (Sun, 16 Nov 2008) | 2 lines

 * Read into string with len 0 could cause range check errors.

........
r12138 | florian | 2008-11-16 23:53:17 +0100 (Sun, 16 Nov 2008) | 1 line

* patch by Petr Kirstan to resolve #12333
........
r12141 | florian | 2008-11-17 11:18:25 +0100 (Mon, 17 Nov 2008) | 1 line

* fix of broken r12138
........
r12142 | michael | 2008-11-17 13:31:27 +0100 (Mon, 17 Nov 2008) | 1 line

* Removed empty constructor and destructor
........
r12143 | michael | 2008-11-17 16:15:38 +0100 (Mon, 17 Nov 2008) | 1 line

* Added fpclasschart to Makefile
........
r12152 | peter | 2008-11-17 22:41:40 +0100 (Mon, 17 Nov 2008) | 2 lines

  * refactor is_visible_for_object

........
r12153 | micha | 2008-11-17 22:46:34 +0100 (Mon, 17 Nov 2008) | 1 line

* fix linux syscall numbers naming consistency (fixes x86_64 unit linux build)
........
r12154 | micha | 2008-11-17 22:48:02 +0100 (Mon, 17 Nov 2008) | 1 line

* fix linux syscall numbers naming consistency #2 (overlooked some)
........
r12155 | joost | 2008-11-17 23:05:00 +0100 (Mon, 17 Nov 2008) | 6 lines

 * New algorith to store update-buffers to file
 * RowStateToByte and ByteToRowState
 * Start at the begin of a stream, after the automatic recognition of the stream has been used
 * Implemented TBufDataset.CompareBookmarks
 * Some update-buffer fixes
 * Fixed some warnings
........
r12156 | micha | 2008-11-17 23:20:37 +0100 (Mon, 17 Nov 2008) | 1 line

* enable poll syscall in freebsd
........
r12157 | florian | 2008-11-18 17:08:22 +0100 (Tue, 18 Nov 2008) | 1 line

* write assembler error at the correct position, first fix for #12595
........
r12158 | florian | 2008-11-18 17:21:58 +0100 (Tue, 18 Nov 2008) | 1 line

* correct handling of constant operands of aad/aam
........
r12159 | peter | 2008-11-18 19:49:27 +0100 (Tue, 18 Nov 2008) | 6 lines

  * store vmt entries in ppu
  * give a note if the visibility of a vmt entry is lower than
    the previous (parent) entry
  * refactor vmt method collection using the new always available
    vmt entries

........
r12160 | peter | 2008-11-18 20:45:34 +0100 (Tue, 18 Nov 2008) | 3 lines

  * use random name for tempbuilddir
  * fix uninitialized needfpmkunitsource

........
r12162 | peter | 2008-11-18 20:47:28 +0100 (Tue, 18 Nov 2008) | 5 lines

  * split packages in multiple procedures to prevent
    procedure too complex
  * use separate includes so they can be regenerated
    with simple unix commands that are listed in fpmake.pp

........
r12163 | peter | 2008-11-19 00:01:47 +0100 (Wed, 19 Nov 2008) | 3 lines

  * fix building package in currentdir that was
    broken by the available/installed repository split

........
r12166 | peter | 2008-11-19 00:10:58 +0100 (Wed, 19 Nov 2008) | 2 lines

  * delete svn:mergeinfo

........
r12167 | peter | 2008-11-19 00:16:44 +0100 (Wed, 19 Nov 2008) | 3 lines

  * move dummy implementions to dummy dir and add
    it as fallback in the includepath

........
r12168 | peter | 2008-11-19 00:16:57 +0100 (Wed, 19 Nov 2008) | 2 lines

  * fix archiving

........
r12169 | peter | 2008-11-19 00:58:10 +0100 (Wed, 19 Nov 2008) | 2 lines

  * split externalurl in homepageurl and downloadurl

........
r12170 | peter | 2008-11-19 00:58:52 +0100 (Wed, 19 Nov 2008) | 2 lines

  * change externalurl to homepageurl

........
r12171 | peter | 2008-11-19 00:59:58 +0100 (Wed, 19 Nov 2008) | 4 lines

  * replace showall with list command
  * support new homepageurl and downloadurl
  * update fpmkunit requirement to 2.2.2-1

........
r12173 | joost | 2008-11-19 11:01:35 +0100 (Wed, 19 Nov 2008) | 7 lines

 * Close a TBufDataset on destroy
 * Always use GetCurrentBuffer in TBufDataset.SetFieldData, the old exception for the dsFilter state is not valid anymore
 * Do not pass an AUpdOrder to StoreRecord when there is no update at all
 * When saving the dataset to file, store not only the complete buffer, but also check if there are still records waiting to be fetched
 * Clean up of obsolete code
 * Added comments
 * Updated TXMLDatapacketReader to the new method of storing/loading records from stream
........
r12174 | florian | 2008-11-19 12:03:20 +0100 (Wed, 19 Nov 2008) | 1 line

* forgotten commit of loop strength reduction patch
........
r12175 | florian | 2008-11-19 12:36:43 +0100 (Wed, 19 Nov 2008) | 1 line

+ more c types
........
r12176 | florian | 2008-11-19 12:37:18 +0100 (Wed, 19 Nov 2008) | 1 line

* modified zlib patch to resolve 12667 by zipfelvo
........
r12196 | jonas | 2008-11-21 23:04:03 +0100 (Fri, 21 Nov 2008) | 4 lines

  + darwin/arm signal handling support, except for the definition of the
    signal context structure as the license of the original file isn't
    100% clear yet

........
r12198 | florian | 2008-11-22 10:51:24 +0100 (Sat, 22 Nov 2008) | 1 line

* small avr compilation fixes
........
r12199 | jonas | 2008-11-22 16:13:16 +0100 (Sat, 22 Nov 2008) | 4 lines

  * fixed writing memory references on ppc when there is only an offset
    (mantis #12685 and also the error message noted in mantis #12576,
     although in case of the latter it's only a symptom of another bug)

........
r12200 | jonas | 2008-11-22 19:05:19 +0100 (Sat, 22 Nov 2008) | 2 lines

  * fixed generic uint32->float softfpu conversion

........
r12201 | joost | 2008-11-23 00:25:27 +0100 (Sun, 23 Nov 2008) | 4 lines

 * Added a TBufDataset.GetRecordUpdateBufferCached which first checks if the current updatebuffer is the searched buffer. If it is not, call GetRecordUpdateBuffer
 * GetRecordUpdateBuffer can now be used to loop through all updatebuffers for each record
 * When an update-buffer is linked to a record which is being deleted, re-link that update buffer to the next available record. It is a slow workaround, but the other solutions were too complex
 * Refactored streaming of update-buffers, added support for inserted records
........
r12202 | hajny | 2008-11-23 02:42:36 +0100 (Sun, 23 Nov 2008) | 1 line

  + directory for include files with dummy implementations added
........
r12203 | hajny | 2008-11-23 02:43:41 +0100 (Sun, 23 Nov 2008) | 1 line

  * wrong dependency on subdir win for go32v2 removed
........
r12204 | hajny | 2008-11-23 02:52:33 +0100 (Sun, 23 Nov 2008) | 1 line

  * avoid platform specific ifdefs in eventlog.pp and allow OS/2 implementation being used again
........
r12205 | jonas | 2008-11-23 10:49:34 +0100 (Sun, 23 Nov 2008) | 4 lines

  * do not write the ".file" directive in assembler files for Darwin
    (gcc doesn't do it either, and it causes the assembler to report
     errors as if they occur in the Pascal source file)

........

git-svn-id: branches/llvm@12206 -

.gitattributes

@@ -951,15 +951,18 @@ packages/chm/fpmake.pp svneol=native#text/plain
 packages/chm/src/chmbase.pas svneol=native#text/plain
 packages/chm/src/chmcmd.lpi svneol=native#text/plain
 packages/chm/src/chmcmd.lpr svneol=native#text/plain
+packages/chm/src/chmfiftimain.pas svneol=native#text/plain
 packages/chm/src/chmfilewriter.pas svneol=native#text/plain
 packages/chm/src/chmls.lpi svneol=native#text/plain
 packages/chm/src/chmls.lpr svneol=native#text/plain
+packages/chm/src/chmobjinstconst.inc svneol=native#text/plain
 packages/chm/src/chmreader.pas svneol=native#text/plain
 packages/chm/src/chmsitemap.pas svneol=native#text/plain
 packages/chm/src/chmspecialfiles.pas svneol=native#text/plain
 packages/chm/src/chmtypes.pas svneol=native#text/plain
 packages/chm/src/chmwriter.pas svneol=native#text/plain
 packages/chm/src/fasthtmlparser.pas svneol=native#text/plain
+packages/chm/src/htmlindexer.pas svneol=native#text/plain
 packages/chm/src/htmlutil.pas svneol=native#text/plain
 packages/chm/src/paslznonslide.pas svneol=native#text/plain
 packages/chm/src/paslzx.pas svneol=native#text/plain
@@ -1101,8 +1104,8 @@ packages/fcl-base/src/cachecls.pp svneol=native#text/plain
 packages/fcl-base/src/contnrs.pp svneol=native#text/plain
 packages/fcl-base/src/custapp.pp svneol=native#text/plain
 packages/fcl-base/src/daemonapp.pp svneol=native#text/plain
+packages/fcl-base/src/dummy/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/eventlog.pp svneol=native#text/plain
-packages/fcl-base/src/felog.inc svneol=native#text/plain
 packages/fcl-base/src/fpexprpars.pp svneol=native#text/plain
 packages/fcl-base/src/fptimer.pp svneol=native#text/plain
 packages/fcl-base/src/gettext.pp svneol=native#text/plain
@@ -1489,22 +1492,12 @@ packages/fcl-passrc/src/readme.txt svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/fpmake.pp svneol=native#text/plain
-packages/fcl-process/src/amiga/pipes.inc svneol=native#text/plain
-packages/fcl-process/src/amiga/process.inc svneol=native#text/plain
-packages/fcl-process/src/beos/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/dbugintf.pp svneol=native#text/plain
 packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain
-packages/fcl-process/src/go32v2/pipes.inc svneol=native#text/plain
-packages/fcl-process/src/go32v2/process.inc svneol=native#text/plain
-packages/fcl-process/src/haiku/pipes.inc svneol=native#text/plain
-packages/fcl-process/src/morphos/pipes.inc svneol=native#text/plain
-packages/fcl-process/src/morphos/process.inc svneol=native#text/plain
-packages/fcl-process/src/netware/pipes.inc svneol=native#text/plain
-packages/fcl-process/src/netware/process.inc svneol=native#text/plain
-packages/fcl-process/src/netwlibc/pipes.inc svneol=native#text/plain
-packages/fcl-process/src/netwlibc/process.inc svneol=native#text/plain
+packages/fcl-process/src/dummy/pipes.inc svneol=native#text/plain
+packages/fcl-process/src/dummy/process.inc svneol=native#text/plain
+packages/fcl-process/src/dummy/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/os2/pipes.inc svneol=native#text/plain
-packages/fcl-process/src/os2/process.inc svneol=native#text/plain
 packages/fcl-process/src/os2/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/pipes.pp svneol=native#text/plain
 packages/fcl-process/src/process.pp svneol=native#text/plain
@@ -1516,7 +1509,6 @@ packages/fcl-process/src/unix/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/win/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/win/process.inc svneol=native#text/plain
 packages/fcl-process/src/win/simpleipc.inc svneol=native#text/plain
-packages/fcl-process/src/wince/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/wince/process.inc svneol=native#text/plain
 packages/fcl-process/src/wince/simpleipc.inc svneol=native#text/plain
 packages/fcl-registry/Makefile svneol=native#text/plain
@@ -1690,6 +1682,8 @@ packages/fpgtk/src/fpgtkext.pp svneol=native#text/plain
 packages/fpgtk/src/pgtk/pgtk.pp svneol=native#text/plain
 packages/fpgtk/src/pgtk/pgtk.ppr -text
 packages/fpmake.pp svneol=native#text/plain
+packages/fpmake_add.inc svneol=native#text/plain
+packages/fpmake_proc.inc svneol=native#text/plain
 packages/fpmkunit/Makefile svneol=native#text/plain
 packages/fpmkunit/Makefile.fpc svneol=native#text/plain
 packages/fpmkunit/examples/ppu2fpmake.sh svneol=native#text/plain
@@ -5115,6 +5109,7 @@ rtl/bsd/x86_64/syscall.inc svneol=native#text/plain
 rtl/bsd/x86_64/syscallh.inc svneol=native#text/plain
 rtl/darwin/Makefile svneol=native#text/plain
 rtl/darwin/Makefile.fpc svneol=native#text/plain
+rtl/darwin/arm/sighnd.inc svneol=native#text/plain
 rtl/darwin/console.pp svneol=native#text/plain
 rtl/darwin/errno.inc svneol=native#text/plain
 rtl/darwin/errnostr.inc -text
@@ -6582,6 +6577,7 @@ tests/tbf/tb0210.pp svneol=native#text/plain
 tests/tbf/tb0211.pp svneol=native#text/plain
 tests/tbf/tb0212.pp svneol=native#text/plain
 tests/tbf/tb0213.pp svneol=native#text/plain
+tests/tbf/tb0214.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -7135,6 +7131,7 @@ tests/tbs/tb0553.pp svneol=native#text/plain
 tests/tbs/tb0554.pp svneol=native#text/plain
 tests/tbs/tb0555.pp svneol=native#text/plain
 tests/tbs/tb0556.pp svneol=native#text/plain
+tests/tbs/tb0557.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
@@ -7798,6 +7795,7 @@ tests/test/tparray7.pp svneol=native#text/plain
 tests/test/tparray8.pp svneol=native#text/plain
 tests/test/tparray9.pp svneol=native#text/plain
 tests/test/tpftch1.pp svneol=native#text/plain
+tests/test/tpoll.pp svneol=native#text/plain
 tests/test/tprec1.pp svneol=native#text/plain
 tests/test/tprec10.pp svneol=native#text/plain
 tests/test/tprec11.pp svneol=native#text/plain
@@ -8613,6 +8611,8 @@ tests/webtbs/tw12242.pp svneol=native#text/plain
 tests/webtbs/tw12249.pp svneol=native#text/plain
 tests/webtbs/tw1228.pp svneol=native#text/plain
 tests/webtbs/tw1229.pp svneol=native#text/plain
+tests/webtbs/tw12318.pp svneol=native#text/plain
+tests/webtbs/tw12385.pp svneol=native#text/plain
 tests/webtbs/tw12404.pp svneol=native#text/plain
 tests/webtbs/tw1250.pp svneol=native#text/plain
 tests/webtbs/tw12508a.pp svneol=native#text/plain
@@ -8620,6 +8620,8 @@ tests/webtbs/tw1251b.pp svneol=native#text/plain
 tests/webtbs/tw1255.pp svneol=native#text/plain
 tests/webtbs/tw12575.pp svneol=native#text/plain
 tests/webtbs/tw12597.pp svneol=native#text/plain
+tests/webtbs/tw12614.pp svneol=native#text/plain
+tests/webtbs/tw12685.pp svneol=native#text/plain
 tests/webtbs/tw1269.pp svneol=native#text/plain
 tests/webtbs/tw1275.pp svneol=native#text/plain
 tests/webtbs/tw1279.pp svneol=native#text/plain

compiler/aggas.pas

@@ -1148,7 +1148,13 @@ implementation
         n:=ExtractFileName(current_module.mainsource^)
       else
         n:=InputFileName;
-      AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
+
+      { gcc does not add it either for Darwin (and AIX). Grep for
+        TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
+      }
+      if not(target_info.system in systems_darwin) then
+        AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
+
       WriteExtraHeader;
       AsmStartSize:=AsmSize;
       symendcount:=0;

compiler/aopt.pas

@@ -90,9 +90,9 @@ Unit aopt;
                    (tai_Label(p).labsym.is_used) Then
                   Begin
                     LabelFound := True;
-                    If (tai_Label(p).labsym.labelnr < aint(LowLabel)) Then
+                    If (tai_Label(p).labsym.labelnr < int64(LowLabel)) Then
                       LowLabel := tai_Label(p).labsym.labelnr;
-                    If (tai_Label(p).labsym.labelnr > aint(HighLabel)) Then
+                    If (tai_Label(p).labsym.labelnr > int64(HighLabel)) Then
                       HighLabel := tai_Label(p).labsym.labelnr
                   End;
                 GetNextInstruction(p, p)
@@ -127,7 +127,7 @@ Unit aopt;
                          (tai_Label(p).labsym.labeltype=alt_jump) then
                         begin
                           LabelIdx:=tai_label(p).labsym.labelnr-LowLabel;
-                          if LabelIdx>aint(LabelDif) then
+                          if LabelIdx>int64(LabelDif) then
                             internalerror(200604202);
                           LabelTable^[LabelIdx].PaiObj := p;
                         end;

compiler/aoptobj.pas

@@ -890,8 +890,8 @@ Unit AoptObj;
 {$endif}
     function tAOptObj.getlabelwithsym(sym: tasmlabel): tai;
       begin
-        if (sym.labelnr >= aint(labelinfo^.lowlabel)) and
-           (sym.labelnr <= aint(labelinfo^.highlabel)) then   { range check, a jump can go past an assembler block! }
+        if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
+           (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then   { range check, a jump can go past an assembler block! }
           getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
         else
           getlabelwithsym := nil;

compiler/avr/cgcpu.pas

@@ -46,7 +46,7 @@ unit cgcpu;
         procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
         procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
 
-        procedure a_call_name(list : TAsmList;const s : string);override;
+        procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
         procedure a_call_reg(list : TAsmList;reg: tregister);override;
         procedure a_call_ref(list : TAsmList;ref: treference);override;
 
@@ -230,7 +230,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.a_call_name(list : TAsmList;const s : string);
+    procedure tcgavr.a_call_name(list : TAsmList;const s : string; weak: boolean);
       begin
         list.concat(taicpu.op_sym(A_RCALL,current_asmdata.RefAsmSymbol(s)));
 {
@@ -685,7 +685,7 @@ unit cgcpu;
         paramanager.freeparaloc(list,paraloc2);
         paramanager.freeparaloc(list,paraloc1);
         alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-        a_call_name(list,'FPC_MOVE');
+        a_call_name_static(list,'FPC_MOVE');
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         paraloc3.done;
         paraloc2.done;

compiler/cgutils.pas

@@ -109,6 +109,9 @@ unit cgutils;
                 { overlay a 64 Bit register type }
                 2 : (register64 : tregister64);
 {$endif cpu64bitalu}
+{$ifdef avr}
+                3 : (registers : array[0..3] of tregister);
+{$endif avr}
               );
             LOC_SUBSETREG,
             LOC_CSUBSETREG : (

compiler/dbgbase.pas

@@ -444,7 +444,7 @@ implementation
         for i:=0 to st.SymList.Count-1 do
           begin
             sym:=tsym(st.SymList[i]);
-            if not(sp_hidden in sym.symoptions) and
+            if (sym.visibility<>vis_hidden) and
                (not sym.isdbgwritten) then
               appendsym(list,sym);
           end;

compiler/dbgdwarf.pas

@@ -1873,7 +1873,8 @@ implementation
         fieldoffset,
         fieldnatsize: aint;
       begin
-        if ([sp_static,sp_hidden] * sym.symoptions <> []) then
+        if (sp_static in sym.symoptions) or
+           (sym.visibility=vis_hidden) then
           exit;
 
         if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or

compiler/dbgstabs.pas

@@ -351,19 +351,23 @@ implementation
         newss   : ansistring;
         ss      : pansistring absolute arg;
       begin
-        if (sp_hidden in tsym(p).symoptions) then
+        if (tsym(p).visibility=vis_hidden) then
           exit;
         { static variables from objects are like global objects }
         if (Tsym(p).typ=fieldvarsym) and
            not(sp_static in Tsym(p).symoptions) then
           begin
-            if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
-              spec:='/1'
-            else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
-              spec:='/0'
-            else
-              spec:='';
-            if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then
+           case tsym(p).visibility of
+             vis_private,
+             vis_strictprivate :
+               spec:='/0';
+             vis_protected,
+             vis_strictprotected :
+               spec:='/1';
+             else
+               spec:='';
+           end;
+           if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then
               begin
                 varsize:=tfieldvarsym(p).vardef.size;
                 { open arrays made overflows !! }
@@ -447,12 +451,16 @@ implementation
               end;
            { here 2A must be changed for private and protected }
            { 0 is private 1 protected and 2 public }
-           if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
-             sp:='0'
-           else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
-             sp:='1'
-           else
-             sp:='2';
+           case tsym(p).visibility of
+             vis_private,
+             vis_strictprivate :
+               sp:='0';
+             vis_protected,
+             vis_strictprotected :
+               sp:='1'
+             else
+               sp:='2';
+           end;
            newss:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[GetSymName(tsym(p)),def_stab_number(pd),
                                     def_stab_number(pd.returndef),argnames,sp,
                                     virtualind]);

compiler/defcmp.pas

@@ -245,15 +245,15 @@ implementation
                      else
                       begin
                         if cdo_explicit in cdoptions then
-                         doconv:=basedefconvertsexplicit[basedeftbl[torddef(def_from).ordtype],basedeftbl[torddef(def_to).ordtype]]
+                          doconv:=basedefconvertsexplicit[basedeftbl[torddef(def_from).ordtype],basedeftbl[torddef(def_to).ordtype]]
                         else
-                         doconv:=basedefconvertsimplicit[basedeftbl[torddef(def_from).ordtype],basedeftbl[torddef(def_to).ordtype]];
+                          doconv:=basedefconvertsimplicit[basedeftbl[torddef(def_from).ordtype],basedeftbl[torddef(def_to).ordtype]];
                         if (doconv=tc_not_possible) then
                           eq:=te_incompatible
                         else if (not is_in_limit(def_from,def_to)) then
                           { "punish" bad type conversions :) (JM) }
                           eq:=te_convert_l3
-                         else
+                        else
                           eq:=te_convert_l1;
                       end;
                    end;

compiler/fmodule.pas

@@ -217,7 +217,7 @@ implementation
       SysUtils,globals,
       verbose,systems,
       scanner,ppu,dbgbase,
-      procinfo;
+      procinfo,symdef;
 
 {$ifdef MEMDEBUG}
     var
@@ -550,7 +550,10 @@ implementation
         if assigned(procinfo) then
           begin
             if current_procinfo=tprocinfo(procinfo) then
-             current_procinfo:=nil;
+              begin
+                current_procinfo:=nil;
+                current_objectdef:=nil;
+              end;
             { release procinfo tree }
             while assigned(procinfo) do
              begin
@@ -629,7 +632,10 @@ implementation
         if assigned(procinfo) then
           begin
             if current_procinfo=tprocinfo(procinfo) then
-             current_procinfo:=nil;
+              begin
+                current_procinfo:=nil;
+                current_objectdef:=nil;
+              end;
             { release procinfo tree }
             while assigned(procinfo) do
              begin

compiler/htypechk.pas

@@ -26,7 +26,7 @@ unit htypechk;
 interface
 
     uses
-      tokens,cpuinfo,
+      cclasses,tokens,cpuinfo,
       node,globtype,
       symconst,symtype,symdef,symsym,symbase;
 
@@ -58,16 +58,20 @@ interface
 
       tcallcandidates = class
       private
-        FProcSym    : tprocsym;
-        FProcs      : pcandidate;
-        FProcVisibleCnt,
+        FProcsym     : tprocsym;
+        FProcsymtable : tsymtable;
+        FOperator    : ttoken;
+        FCandidateProcs    : pcandidate;
         FProcCnt    : integer;
         FParaNode   : tnode;
         FParaLength : smallint;
         FAllowVariant : boolean;
-        function proc_add(ps:tprocsym;pd:tprocdef):pcandidate;
+        procedure collect_overloads_in_class(ProcdefOverloadList:TFPObjectList);
+        procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList);
+        procedure create_candidate_list(ignorevisibility:boolean);
+        function  proc_add(ps:tprocsym;pd:tprocdef):pcandidate;
       public
-        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;isprop,ignorevis : boolean);
+        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility:boolean);
         constructor create_operator(op:ttoken;ppn:tnode);
         destructor destroy;override;
         procedure list(all:boolean);
@@ -78,7 +82,6 @@ interface
         function  choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer;
         procedure find_wrong_para;
         property  Count:integer read FProcCnt;
-        property  VisibleCount:integer read FProcVisibleCnt;
       end;
 
     type
@@ -165,7 +168,7 @@ implementation
     uses
        sysutils,
        systems,constexp,globals,
-       cutils,cclasses,verbose,
+       cutils,verbose,
        symtable,
        defutil,defcmp,
        nbas,ncnv,nld,nmem,ncal,nmat,ninl,nutils,ncon,
@@ -1582,240 +1585,130 @@ implementation
                            TCallCandidates
 ****************************************************************************}
 
-    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;isprop,ignorevis : boolean);
-      var
-        j          : integer;
-        pd         : tprocdef;
-        hp         : pcandidate;
-        found,
-        has_overload_directive : boolean;
-        topclassh  : tobjectdef;
-        srsymtable : TSymtable;
-        srprocsym  : tprocsym;
-        pt         : tcallparanode;
-        checkstack : psymtablestackitem;
-        hashedid   : THashedIDString;
+    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility:boolean);
       begin
         if not assigned(sym) then
           internalerror(200411015);
-
-        FProcSym:=sym;
-        FProcs:=nil;
-        FProccnt:=0;
-        FProcvisiblecnt:=0;
+        FOperator:=NOTOKEN;
+        FProcsym:=sym;
+        FProcsymtable:=st;
         FParanode:=ppn;
-        FAllowVariant:=true;
-
-        { determine length of parameter list }
-        pt:=tcallparanode(ppn);
-        FParalength:=0;
-        while assigned(pt) do
-         begin
-           inc(FParalength);
-           pt:=tcallparanode(pt.right);
-         end;
+        create_candidate_list(ignorevisibility);
+      end;
 
-        { when the definition has overload directive set, we search for
-          overloaded definitions in the class, this only needs to be done once
-          for class entries as the tree keeps always the same }
-        if (not sym.overloadchecked) and
-           (sym.owner.symtabletype=ObjectSymtable) and
-           (po_overload in tprocdef(sym.ProcdefList[0]).procoptions) then
-         search_class_overloads(sym);
 
-        { when the class passed is defined in this unit we
-          need to use the scope of that class. This is a trick
-          that can be used to access protected members in other
-          units. At least kylix supports it this way (PFV) }
-        if assigned(st) and
-           (
-            (st.symtabletype=ObjectSymtable) or
-            ((st.symtabletype=withsymtable) and
-             (st.defowner.typ=objectdef))
-           ) and
-           (st.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           st.defowner.owner.iscurrentunit then
-          topclassh:=tobjectdef(st.defowner)
-        else
-          begin
-            if assigned(current_procinfo) then
-              topclassh:=current_procinfo.procdef._class
-            else
-              topclassh:=nil;
-          end;
-
-        { link all procedures which have the same # of parameters }
-        for j:=0 to sym.ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(sym.ProcdefList[j]);
-            { Is the procdef visible? This needs to be checked on
-              procdef level since a symbol can contain both private and
-              public declarations. But the check should not be done
-              when the callnode is generated by a property
+    constructor tcallcandidates.create_operator(op:ttoken;ppn:tnode);
+      begin
+        FOperator:=op;
+        FProcsym:=nil;
+        FProcsymtable:=nil;
+        FParanode:=ppn;
+        create_candidate_list(false);
+      end;
 
-              inherited overrides invisible anonymous inherited (FK) }
 
-            if isprop or ignorevis or
-               (pd.owner.symtabletype<>ObjectSymtable) or
-               pd.is_visible_for_object(topclassh,nil) then
-             begin
-               { we have at least one procedure that is visible }
-               inc(FProcvisiblecnt);
-               { only when the # of parameter are supported by the
-                 procedure }
-               if (FParalength>=pd.minparacount) and
-                  ((po_varargs in pd.procoptions) or { varargs }
-                   (FParalength<=pd.maxparacount)) then
-                 proc_add(sym,pd);
-             end;
-          end;
+    destructor tcallcandidates.destroy;
+      var
+        hpnext,
+        hp : pcandidate;
+      begin
+        hp:=FCandidateProcs;
+        while assigned(hp) do
+         begin
+           hpnext:=hp^.next;
+           dispose(hp);
+           hp:=hpnext;
+         end;
+      end;
 
-        { remember if the procedure is declared with the overload directive,
-          it's information is still needed also after all procs are removed }
-        has_overload_directive:=(po_overload in tprocdef(sym.ProcdefList[0]).procoptions);
 
-        { when the definition has overload directive set, we search for
-          overloaded definitions in the symtablestack. The found
-          entries are only added to the procs list and not the procsym, because
-          the list can change in every situation }
-        if has_overload_directive and
-           (sym.owner.symtabletype<>ObjectSymtable) then
-          begin
-            srsymtable:=sym.owner;
-            checkstack:=symtablestack.stack;
-            while assigned(checkstack) and
-                  (checkstack^.symtable<>srsymtable) do
-              checkstack:=checkstack^.next;
-            { we've already processed the current symtable, start with
-              the next symtable in the stack }
-            if assigned(checkstack) then
-              checkstack:=checkstack^.next;
-            hashedid.id:=sym.name;
-            while assigned(checkstack) do
+    procedure tcallcandidates.collect_overloads_in_class(ProcdefOverloadList:TFPObjectList);
+      var
+        j          : integer;
+        pd         : tprocdef;
+        srsym      : tsym;
+        objdef     : tobjectdef;
+        hashedid   : THashedIDString;
+        hasoverload : boolean;
+      begin
+        objdef:=tobjectdef(fprocsym.owner.defowner);
+        hashedid.id:=fprocsym.name;
+        hasoverload:=false;
+        while assigned(objdef) do
+         begin
+           srsym:=tprocsym(objdef.symtable.FindWithHash(hashedid));
+           if assigned(srsym) then
              begin
-               srsymtable:=checkstack^.symtable;
-               if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
-                begin
-                  srprocsym:=tprocsym(srsymtable.FindWithHash(hashedid));
-                  if assigned(srprocsym) and
-                     (srprocsym.typ=procsym) then
-                   begin
-                     { if this visible procedure doesn't have overload we can stop
-                       searching }
-                     if not(po_overload in tprocdef(srprocsym.ProcdefList[0]).procoptions) and
-                        tprocdef(srprocsym.ProcdefList[0]).is_visible_for_object(topclassh,nil) then
-                      break;
-                     { process all overloaded definitions }
-                     for j:=0 to srprocsym.ProcdefList.Count-1 do
-                      begin
-                        pd:=tprocdef(srprocsym.ProcdefList[j]);
-                        { only visible procedures need to be added }
-                        if pd.is_visible_for_object(topclassh,nil) then
-                          begin
-                            { only when the # of parameter are supported by the
-                              procedure }
-                            if (FParalength>=pd.minparacount) and
-                               ((po_varargs in pd.procoptions) or { varargs }
-                               (FParalength<=pd.maxparacount)) then
-                             begin
-                               found:=false;
-                               hp:=FProcs;
-                               while assigned(hp) do
-                                begin
-                                  { Only compare visible parameters for the user }
-                                  if compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
-                                   begin
-                                     found:=true;
-                                     break;
-                                   end;
-                                  hp:=hp^.next;
-                                end;
-                               if not found then
-                                 proc_add(srprocsym,pd);
-                             end;
-                         end;
-                      end;
-                   end;
-                end;
-               checkstack:=checkstack^.next;
+               if (srsym.typ<>procsym) then
+                 internalerror(200111022);
+               { add all definitions }
+               hasoverload:=false;
+               for j:=0 to tprocsym(srsym).ProcdefList.Count-1 do
+                 begin
+                   pd:=tprocdef(tprocsym(srsym).ProcdefList[j]);
+                   if po_overload in pd.procoptions then
+                     hasoverload:=true;
+                   ProcdefOverloadList.Add(tprocsym(srsym).ProcdefList[j]);
+                 end;
+               { when there is no explicit overload we stop searching }
+               if not hasoverload then
+                 break;
              end;
-          end;
+           { next parent }
+           objdef:=objdef.childof;
+         end;
       end;
 
 
-    constructor tcallcandidates.create_operator(op:ttoken;ppn:tnode);
+    procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList);
       var
         j          : integer;
         pd         : tprocdef;
-        hp         : pcandidate;
-        found      : boolean;
         srsymtable : TSymtable;
-        srprocsym  : tprocsym;
-        pt         : tcallparanode;
+        srsym      : tsym;
         checkstack : psymtablestackitem;
         hashedid   : THashedIDString;
+        hasoverload : boolean;
       begin
-        FProcSym:=nil;
-        FProcs:=nil;
-        FProccnt:=0;
-        FProcvisiblecnt:=0;
-        FParanode:=ppn;
-        FAllowVariant:=false;
-
-        { determine length of parameter list }
-        pt:=tcallparanode(ppn);
-        FParalength:=0;
-        while assigned(pt) do
-         begin
-           if pt.resultdef.typ=variantdef then
-             FAllowVariant:=true;
-           inc(FParalength);
-           pt:=tcallparanode(pt.right);
-         end;
-
         { we search all overloaded operator definitions in the symtablestack. The found
           entries are only added to the procs list and not the procsym, because
           the list can change in every situation }
-        hashedid.id:=overloaded_names[op];
+        if FOperator<>NOTOKEN then
+          hashedid.id:=overloaded_names[FOperator]
+        else
+          hashedid.id:=FProcsym.name;
+
         checkstack:=symtablestack.stack;
+        if assigned(FProcsymtable) then
+          begin
+            while assigned(checkstack) and
+                  (checkstack^.symtable<>FProcsymtable) do
+              checkstack:=checkstack^.next;
+          end;
         while assigned(checkstack) do
           begin
             srsymtable:=checkstack^.symtable;
             if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
               begin
-                srprocsym:=tprocsym(srsymtable.FindWithHash(hashedid));
-                if assigned(srprocsym) and
-                   (srprocsym.typ=procsym) then
+                srsym:=tprocsym(srsymtable.FindWithHash(hashedid));
+                if assigned(srsym) and
+                   (srsym.typ=procsym) then
                   begin
                     { Store first procsym found }
                     if not assigned(FProcsym) then
-                      FProcsym:=srprocsym;
-
-                    { process all overloaded definitions }
-                    for j:=0 to srprocsym.ProcdefList.Count-1 do
+                      FProcsym:=tprocsym(srsym);
+                    { add all definitions }
+                    hasoverload:=false;
+                    for j:=0 to tprocsym(srsym).ProcdefList.Count-1 do
                       begin
-                        pd:=tprocdef(srprocsym.ProcdefList[j]);
-                        { only when the # of parameter are supported by the
-                          procedure }
-                        if (FParalength>=pd.minparacount) and
-                           (FParalength<=pd.maxparacount) then
-                          begin
-                            found:=false;
-                            hp:=FProcs;
-                            while assigned(hp) do
-                              begin
-                                { Only compare visible parameters for the user }
-                                if compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
-                                  begin
-                                    found:=true;
-                                    break;
-                                  end;
-                                hp:=hp^.next;
-                              end;
-                            if not found then
-                              proc_add(srprocsym,pd);
-                          end;
+                        pd:=tprocdef(tprocsym(srsym).ProcdefList[j]);
+                        if po_overload in pd.procoptions then
+                          hasoverload:=true;
+                        ProcdefOverloadList.Add(tprocsym(srsym).ProcdefList[j]);
                       end;
+                    { when there is no explicit overload we stop searching }
+                    if not hasoverload then
+                      break;
                   end;
               end;
             checkstack:=checkstack^.next;
@@ -1823,18 +1716,92 @@ implementation
       end;
 
 
-    destructor tcallcandidates.destroy;
+    procedure tcallcandidates.create_candidate_list(ignorevisibility:boolean);
       var
-        hpnext,
-        hp : pcandidate;
+        j     : integer;
+        pd    : tprocdef;
+        hp    : pcandidate;
+        pt    : tcallparanode;
+        found : boolean;
+        contextobjdef : tobjectdef;
+        ProcdefOverloadList : TFPObjectList;
       begin
-        hp:=FProcs;
-        while assigned(hp) do
-         begin
-           hpnext:=hp^.next;
-           dispose(hp);
-           hp:=hpnext;
-         end;
+        FCandidateProcs:=nil;
+
+        { Find all available overloads for this procsym }
+        ProcdefOverloadList:=TFPObjectList.Create(false);
+        if (FOperator=NOTOKEN) and
+           (FProcsym.owner.symtabletype=objectsymtable) then
+          collect_overloads_in_class(ProcdefOverloadList)
+        else
+          collect_overloads_in_units(ProcdefOverloadList);
+
+        { determine length of parameter list.
+          for operators also enable the variant-operators if
+          a variant parameter is passed }
+        FParalength:=0;
+        FAllowVariant:=(FOperator=NOTOKEN);
+        pt:=tcallparanode(FParaNode);
+        while assigned(pt) do
+          begin
+            if (pt.resultdef.typ=variantdef) then
+              FAllowVariant:=true;
+            inc(FParalength);
+            pt:=tcallparanode(pt.right);
+          end;
+
+        { when the class passed is defined in this unit we
+          need to use the scope of that class. This is a trick
+          that can be used to access protected members in other
+          units. At least kylix supports it this way (PFV) }
+        if assigned(FProcSymtable) and
+           (
+            (FProcSymtable.symtabletype=ObjectSymtable) or
+            ((FProcSymtable.symtabletype=withsymtable) and
+             (FProcSymtable.defowner.typ=objectdef))
+           ) and
+           (FProcSymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
+           FProcSymtable.defowner.owner.iscurrentunit then
+          contextobjdef:=tobjectdef(FProcSymtable.defowner)
+        else
+          contextobjdef:=current_objectdef;
+
+        { Process all found overloads }
+        for j:=0 to ProcdefOverloadList.Count-1 do
+          begin
+            pd:=tprocdef(ProcdefOverloadList[j]);
+
+            { only when the # of parameter are supported by the procedure and
+              it is visible }
+            if (FParalength>=pd.minparacount) and
+               (
+                (FParalength<=pd.maxparacount) or
+                (po_varargs in pd.procoptions)
+               ) and
+               (
+                ignorevisibility or
+                (pd.owner.symtabletype<>objectsymtable) or
+                is_visible_for_object(pd,contextobjdef)
+               ) then
+              begin
+                { don't add duplicates, only compare visible parameters for the user }
+                found:=false;
+                hp:=FCandidateProcs;
+                while assigned(hp) do
+                  begin
+                    if compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
+                      begin
+                        found:=true;
+                        break;
+                      end;
+                    hp:=hp^.next;
+                  end;
+                if not found then
+                  proc_add(fprocsym,pd);
+              end;
+          end;
+
+        ProcdefOverloadList.Free;
       end;
 
 
@@ -1846,8 +1813,8 @@ implementation
         new(result);
         fillchar(result^,sizeof(tcandidate),0);
         result^.data:=pd;
-        result^.next:=FProcs;
-        FProcs:=result;
+        result^.next:=FCandidateProcs;
+        FCandidateProcs:=result;
         inc(FProccnt);
         { Find last parameter, skip all default parameters
           that are not passed. Ignore this skipping for varargs }
@@ -1876,7 +1843,7 @@ implementation
       var
         hp : pcandidate;
       begin
-        hp:=FProcs;
+        hp:=FCandidateProcs;
         while assigned(hp) do
          begin
            if all or
@@ -1909,8 +1876,8 @@ implementation
       begin
         if not CheckVerbosity(lvl) then
          exit;
-        Comment(lvl+V_LineInfo,'Overloaded callnode: '+FProcSym.name+'('+ParaTreeStr(tcallparanode(FParaNode))+')');
-        hp:=FProcs;
+        Comment(lvl+V_LineInfo,'Overloaded callnode: '+FProcsym.name+'('+ParaTreeStr(tcallparanode(FParaNode))+')');
+        hp:=FCandidateProcs;
         while assigned(hp) do
          begin
            Comment(lvl,'  '+hp^.data.fullprocname(false));
@@ -1973,7 +1940,7 @@ implementation
         if FAllowVariant then
           include(cdoptions,cdo_allow_variant);
         { process all procs }
-        hp:=FProcs;
+        hp:=FCandidateProcs;
         while assigned(hp) do
          begin
            { We compare parameters in reverse order (right to left),
@@ -2522,15 +2489,15 @@ implementation
         }
         { Setup the first procdef as best, only count it as a result
           when it is valid }
-        bestpd:=FProcs^.data;
-        if FProcs^.invalid then
+        bestpd:=FCandidateProcs^.data;
+        if FCandidateProcs^.invalid then
          cntpd:=0
         else
          cntpd:=1;
-        if assigned(FProcs^.next) then
+        if assigned(FCandidateProcs^.next) then
          begin
-           besthpstart:=FProcs;
-           hp:=FProcs^.next;
+           besthpstart:=FCandidateProcs;
+           hp:=FCandidateProcs^.next;
            while assigned(hp) do
             begin
               if not singlevariant then
@@ -2577,7 +2544,7 @@ implementation
         wrongpara : tparavarsym;
       begin
         { Only process the first overloaded procdef }
-        hp:=FProcs;
+        hp:=FCandidateProcs;
         { Find callparanode corresponding to the argument }
         pt:=tcallparanode(FParanode);
         currparanr:=FParalength;

compiler/msg/errore.msg

@@ -366,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
 #
 # Parser
 #
-# 03248 is the last used one
+# 03250 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1172,7 +1172,10 @@ parser_e_weak_external_not_supported=03248_E_Weak external symbols are not suppo
 parser_e_forward_mismatch=03249_E_Forward type definition does not match
 % Classes and interfaces being defined forward must have the same type
 % when being implemented. A forward interface can not be changed into a class.
-%
+parser_n_ignore_lower_visibility=03250_N_Virtual method "$1" has a lower visibility ($2) than parent class $3 ($4)
+% The virtual method overrides an method that is declared with a higher visibility. This might give
+% unexpected results. In case the new visibility is private than it might be that a call to inherited in a
+% new child class will call the higher visible method in a parent class and ignores the private method.
 % \end{description}
 #
 # Type Checking
@@ -1326,7 +1329,7 @@ type_e_interface_type_expected=04034_E_interface type expected, but got "$1"
 % Type
 %   TMyStream = Class(TStream,Integer)
 % \end{verbatim}
-type_w_mixed_signed_unsigned=04035_W_Mixing signed expressions and longwords gives a 64bit result
+type_h_mixed_signed_unsigned=04035_H_Mixing signed expressions and longwords gives a 64bit result
 % If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa),
 % or if you have overflow and/or range checking turned on and use an arithmetic
 % expression (+, -, *, div, mod) in which both signed numbers and longwords appear,

compiler/msgidx.inc

@@ -337,6 +337,7 @@ const
   parser_e_cant_export_var_different_name=03247;
   parser_e_weak_external_not_supported=03248;
   parser_e_forward_mismatch=03249;
+  parser_n_ignore_lower_visibility=03250;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -371,7 +372,7 @@ const
   type_e_no_assign_to_const=04032;
   type_e_array_required=04033;
   type_e_interface_type_expected=04034;
-  type_w_mixed_signed_unsigned=04035;
+  type_h_mixed_signed_unsigned=04035;
   type_w_mixed_signed_unsigned2=04036;
   type_e_typecast_wrong_size_for_assignment=04037;
   type_e_array_index_enums_with_assign_not_possible=04038;
@@ -757,9 +758,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 47627;
+  MsgTxtSize = 47709;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,87,250,84,65,50,108,22,201,61,
+    24,87,251,84,65,50,108,22,201,61,
     44,1,1,1,1,1,1,1,1,1
   );

compiler/msgtxt.inc

@@ -386,471 +386,476 @@ const msgtxt : array[0..000198,1..240] of char=(
   '03248_E_','Weak external symbols are not supported for the current targ'+
   'et'#000+
   '03249_E_Forward type definition does not match'#000+
+  '03250_N_Virtual method "$1" has a lower visibility ($2) than parent cl'+
+  'ass $3 ($4)'#000+
   '04000_E_Type mismatch'#000+
-  '04001_E_Incompatible types: got "$1" expected "$2"'#000+
+  '04001_E_Incompatible types',': got "$1" expected "$2"'#000+
   '04002_E_Type mismatch between "$1" and "$2"'#000+
-  '04003_E_Type ','identifier expected'#000+
+  '04003_E_Type identifier expected'#000+
   '04004_E_Variable identifier expected'#000+
   '04005_E_Integer expression expected, but got "$1"'#000+
   '04006_E_Boolean expression expected, but got "$1"'#000+
-  '04007_E_Ordinal expression expected'#000+
+  '0','4007_E_Ordinal expression expected'#000+
   '04008_E_pointer type expected, but got "$1"'#000+
-  '040','09_E_class type expected, but got "$1"'#000+
+  '04009_E_class type expected, but got "$1"'#000+
   '04011_E_Can'#039't evaluate constant expression'#000+
   '04012_E_Set elements are not compatible'#000+
-  '04013_E_Operation not implemented for sets'#000+
+  '04013_E_Operation not implemented fo','r sets'#000+
   '04014_W_Automatic type conversion from floating type to COMP which is '+
-  'an in','teger type'#000+
+  'an integer type'#000+
   '04015_H_use DIV instead to get an integer result'#000+
   '04016_E_string types doesn'#039't match, because of $V+ mode'#000+
-  '04017_E_succ or pred on enums with assignments not possible'#000+
+  '04017_E_succ or pred on enums with assignm','ents not possible'#000+
   '04018_E_Can'#039't read or write variables of this type'#000+
-  '04019_E_Can'#039't',' use readln or writeln on typed file'#000+
+  '04019_E_Can'#039't use readln or writeln on typed file'#000+
   '04020_E_Can'#039't use read or write on untyped file.'#000+
   '04021_E_Type conflict between set elements'#000+
-  '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
+  '04022_W_lo/hi(dword/qword) re','turns the upper/lower word/dword'#000+
   '04023_E_Integer or real expression expected'#000+
-  '04024','_E_Wrong type "$1" in array constructor'#000+
+  '04024_E_Wrong type "$1" in array constructor'#000+
   '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+
-  '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+
+  '04026_E_Method (variable) and Procedure (variable) a','re not compatibl'+
+  'e'#000+
   '04027_E_Illegal constant passed to internal math function'#000+
-  '04028_','E_Can'#039't take the address of constant expressions'#000+
+  '04028_E_Can'#039't take the address of constant expressions'#000+
   '04029_E_Argument can'#039't be assigned to'#000+
   '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
   'e'#000+
-  '04031_E_Can'#039't assign values to an address'#000+
-  '04032_E_Can'#039't assign values to const variab','le'#000+
+  '040','31_E_Can'#039't assign values to an address'#000+
+  '04032_E_Can'#039't assign values to const variable'#000+
   '04033_E_Array type required'#000+
   '04034_E_interface type expected, but got "$1"'#000+
-  '04035_W_Mixing signed expressions and longwords gives a 64bit result'#000+
-  '04036_W_Mixing signed expressions and cardinals here may cause a range'+
-  ' check error'#000+
-  '04037_E_Typ','ecast has different size ($1 -> $2) in assignment'#000+
+  '04035_H_Mixing signed expressions and longwords gives a 64bit result'#000+
+  '04036_W_Mixi','ng signed expressions and cardinals here may cause a ran'+
+  'ge check error'#000+
+  '04037_E_Typecast has different size ($1 -> $2) in assignment'#000+
   '04038_E_enums with assignments can'#039't be used as array index'#000+
-  '04039_E_Class or Object types "$1" and "$2" are not related'#000+
+  '04039_E_Class or Object types "$1" and "$2" are ','not related'#000+
   '04040_W_Class types "$1" and "$2" are not related'#000+
-  '04041_E_Class or int','erface type expected, but got "$1"'#000+
+  '04041_E_Class or interface type expected, but got "$1"'#000+
   '04042_E_Type "$1" is not completely defined'#000+
   '04043_W_String literal has more characters than short string length'#000+
-  '04044_W_Comparison is always false due to range of values'#000+
-  '04045_W_Comparison is always true d','ue to range of values'#000+
+  '04044_W_Com','parison is always false due to range of values'#000+
+  '04045_W_Comparison is always true due to range of values'#000+
   '04046_W_Constructing a class "$1" with abstract method "$2"'#000+
   '04047_H_The left operand of the IN operator should be byte sized'#000+
-  '04048_W_Type size mismatch, possible loss of data / range check error'#000+
-  '04049_H_Type size misma','tch, possible loss of data / range check erro'+
+  '04048_W_Typ','e size mismatch, possible loss of data / range check erro'+
   'r'#000+
+  '04049_H_Type size mismatch, possible loss of data / range check error'#000+
   '04050_E_The address of an abstract method can'#039't be taken'#000+
-  '04051_E_Assignments to formal parameters and open arrays are not possi'+
-  'ble'#000+
+  '04051_E_Assignments to formal parameters and open arra','ys are not pos'+
+  'sible'#000+
   '04052_E_Constant Expression expected'#000+
-  '04053_E_Operation "$1" no','t supported for types "$2" and "$3"'#000+
+  '04053_E_Operation "$1" not supported for types "$2" and "$3"'#000+
   '04054_E_Illegal type conversion: "$1" to "$2"'#000+
   '04055_H_Conversion between ordinals and pointers is not portable'#000+
-  '04056_W_Conversion between ordinals and pointers is not portable'#000+
-  '04057_E_Can'#039't determine whic','h overloaded function to call'#000+
+  '04056_W_Con','version between ordinals and pointers is not portable'#000+
+  '04057_E_Can'#039't determine which overloaded function to call'#000+
   '04058_E_Illegal counter variable'#000+
   '04059_W_Converting constant real value to double for C variable argume'+
-  'nt, add explicit typecast to prevent this.'#000+
+  'nt, add explicit typecast',' to prevent this.'#000+
   '04060_E_Class or COM interface type expected, but got "$1"'#000+
-  '04061','_E_Constant packed arrays are not yet supported'#000+
+  '04061_E_Constant packed arrays are not yet supported'#000+
   '04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
   'ed Array"'#000+
-  '04063_E_Incompatible type for arg no. $1: Got "$2" expected "(not pack'+
-  'ed) Array"'#000+
-  '04064_E_Elements of packed arra','ys cannot be of a type which need to '+
-  'be initialised'#000+
+  '04063_E_Incompatible type for ','arg no. $1: Got "$2" expected "(not pa'+
+  'cked) Array"'#000+
+  '04064_E_Elements of packed arrays cannot be of a type which need to be'+
+  ' initialised'#000+
   '04065_E_Constant packed records and objects are not yet supported'#000+
-  '04066_W_Arithmetic "$1" on untyped pointer is unportable to {$T+}, sug'+
-  'gest typecast'#000+
-  '04076_E_Can'#039't take address of a subrou','tine marked as local'#000+
+  '04066_W_Arithmetic "$1" on untyped point','er is unportable to {$T+}, s'+
+  'uggest typecast'#000+
+  '04076_E_Can'#039't take address of a subroutine marked as local'#000+
   '04077_E_Can'#039't export subroutine marked as local from a unit'#000+
   '04078_E_Type is not automatable: "$1"'#000+
-  '04079_H_Converting the operands to "$1" before doing the add could pre'+
-  'vent overflow errors.'#000+
-  '04080_H_Converting the operan','ds to "$1" before doing the subtract co'+
-  'uld prevent overflow errors.'#000+
-  '04081_H_Converting the operands to "$1" before doing the multiply coul'+
+  '04079_H_Converting the operands to "$1"',' before doing the add could p'+
+  'revent overflow errors.'#000+
+  '04080_H_Converting the operands to "$1" before doing the subtract coul'+
   'd prevent overflow errors.'#000+
+  '04081_H_Converting the operands to "$1" before doing the multiply coul'+
+  'd prevent overflow e','rrors.'#000+
   '04082_W_Converting pointers to signed integers may result in wrong com'+
-  'paris','on results and range errors, use an unsigned type instead.'#000+
+  'parison results and range errors, use an unsigned type instead.'#000+
   '04083_E_Interface type $1 has no valid GUID'#000+
   '05000_E_Identifier not found "$1"'#000+
-  '05001_F_Internal Error in SymTableStack()'#000+
+  '05001_F_Internal Erro','r in SymTableStack()'#000+
   '05002_E_Duplicate identifier "$1"'#000+
-  '05003_H_Identifier already ','defined in $1 at line $2'#000+
+  '05003_H_Identifier already defined in $1 at line $2'#000+
   '05004_E_Unknown identifier "$1"'#000+
   '05005_E_Forward declaration not solved "$1"'#000+
   '05007_E_Error in type definition'#000+
-  '05009_E_Forward type not resolved "$1"'#000+
-  '05010_E_Only static variables can be used in static methods or outs','i'+
-  'de methods'#000+
+  '05009_E_Forward type not',' resolved "$1"'#000+
+  '05010_E_Only static variables can be used in static methods or outside'+
+  ' methods'#000+
   '05012_F_record or class type expected'#000+
   '05013_E_Instances of classes or objects with an abstract method are no'+
   't allowed'#000+
-  '05014_W_Label not defined "$1"'#000+
+  '05014_W_Label not defined "$','1"'#000+
   '05015_E_Label used but not defined "$1"'#000+
   '05016_E_Illegal label declaration'#000+
-  '05017','_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
+  '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
   '05018_E_Label not found'#000+
   '05019_E_identifier isn'#039't a label'#000+
   '05020_E_label already defined'#000+
-  '05021_E_illegal type declaration of set elements'#000+
-  '05022_E_Forward class definition not resolved "$1"'#000,
+  '05021_E_illegal ty','pe declaration of set elements'#000+
+  '05022_E_Forward class definition not resolved "$1"'#000+
   '05023_H_Unit "$1" not used in $2'#000+
   '05024_H_Parameter "$1" not used'#000+
   '05025_N_Local variable "$1" not used'#000+
-  '05026_H_Value parameter "$1" is assigned but never used'#000+
+  '05026_H_Value parameter "$1" is assigned but never used'#000,
   '05027_N_Local variable "$1" is assigned but never used'#000+
-  '05028_H_Local $1 "$2" is no','t used'#000+
+  '05028_H_Local $1 "$2" is not used'#000+
   '05029_N_Private field "$1.$2" is never used'#000+
   '05030_N_Private field "$1.$2" is assigned but never used'#000+
   '05031_N_Private method "$1.$2" never used'#000+
-  '05032_E_Set type expected'#000+
+  '05032_E_','Set type expected'#000+
   '05033_W_Function result does not seem to be set'#000+
-  '05034_W_Type "$1','" is not aligned correctly in current record for C'#000+
+  '05034_W_Type "$1" is not aligned correctly in current record for C'#000+
   '05035_E_Unknown record field identifier "$1"'#000+
   '05036_W_Local variable "$1" does not seem to be initialized'#000+
-  '05037_W_Variable "$1" does not seem to be initialized'#000+
-  '05038_E_identifier idents no m','ember "$1"'#000+
+  '05','037_W_Variable "$1" does not seem to be initialized'#000+
+  '05038_E_identifier idents no member "$1"'#000+
   '05039_H_Found declaration: $1'#000+
   '05040_E_Data element too large'#000+
   '05042_E_No matching implementation for interface method "$1" found'#000+
-  '05043_W_Symbol "$1" is deprecated'#000+
+  '05043_W_Symbol "$1"',' is deprecated'#000+
   '05044_W_Symbol "$1" is not portable'#000+
-  '05055_W_Symbol "$1" is not impl','emented'#000+
+  '05055_W_Symbol "$1" is not implemented'#000+
   '05056_E_Can'#039't create unique type from this type'#000+
   '05057_H_Local variable "$1" does not seem to be initialized'#000+
-  '05058_H_Variable "$1" does not seem to be initialized'#000+
+  '05058_H_Variable "$1" does not seem to be ','initialized'#000+
   '05059_W_Function result variable does not seem to initialized'#000+
-  '05060_H_','Function result variable does not seem to be initialized'#000+
+  '05060_H_Function result variable does not seem to be initialized'#000+
   '05061_W_Variable "$1" read but nowhere assigned'#000+
   '05062_H_Found abstract method: $1'#000+
-  '05063_W_Symbol "$1" is experimental'#000+
+  '05063_W_Symbol "$1"',' is experimental'#000+
   '05064_W_Forward declaration "$1" not resolved, assumed external'#000+
-  '0','6009_E_Parameter list size exceeds 65535 bytes'#000+
+  '06009_E_Parameter list size exceeds 65535 bytes'#000+
   '06012_E_File types must be var parameters'#000+
   '06013_E_The use of a far pointer isn'#039't allowed there'#000+
-  '06015_E_EXPORT declared functions can'#039't be called'#000+
-  '06016_W_Possible illegal call of constructor or ','destructor'#000+
+  '06015_E_EXPORT d','eclared functions can'#039't be called'#000+
+  '06016_W_Possible illegal call of constructor or destructor'#000+
   '06017_N_Inefficient code'#000+
   '06018_W_unreachable code'#000+
   '06020_E_Abstract methods can'#039't be called directly'#000+
   '06027_DL_Register $1 weight $2 $3'#000+
-  '06029_DL_Stack frame is omitted'#000+
+  '06029_DL_Stac','k frame is omitted'#000+
   '06031_E_Object or class methods can'#039't be inline.'#000+
-  '06032_E_Procva','r calls cannot be inline.'#000+
+  '06032_E_Procvar calls cannot be inline.'#000+
   '06033_E_No code for inline procedure stored'#000+
   '06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+
-  'sed, use (set)length instead'#000+
+  'sed, use (set)length i','nstead'#000+
   '06037_E_Constructors or destructors can not be called inside a '#039'wi'+
-  'th'#039' claus','e'#000+
+  'th'#039' clause'#000+
   '06038_E_Cannot call message handler methods directly'#000+
   '06039_E_Jump in or outside of an exception block'#000+
-  '06040_E_Control flow statements aren'#039't allowed in a finally block'#000+
+  '06040_E_Control flow statements aren'#039't allowed in a fi','nally bloc'+
+  'k'#000+
   '06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+
-  '06042_W_Local ','variable size exceed limit for certain cpu'#039's'#000+
+  '06042_W_Local variable size exceed limit for certain cpu'#039's'#000+
   '06043_E_Local variables size exceeds supported limit'#000+
   '06044_E_BREAK not allowed'#000+
   '06045_E_CONTINUE not allowed'#000+
-  '06046_F_Unknown compilerproc "$1". Check if you use the correct run ti'+
-  'me library.'#000+
-  '06047','_F_Cannot find system type "$1". Check if you use the correct r'+
-  'un time library.'#000+
+  '06046','_F_Unknown compilerproc "$1". Check if you use the correct run '+
+  'time library.'#000+
+  '06047_F_Cannot find system type "$1". Check if you use the correct run'+
+  ' time library.'#000+
   '06048_H_Inherited call to abstract method ignored'#000+
-  '06049_E_Goto label "$1" not defined or optimized away'#000+
+  '06049_E_Goto label "$1" not ','defined or optimized away'#000+
   '07000_DL_Starting $1 styled assembler parsing'#000+
-  '07001_DL_F','inished $1 styled assembler parsing'#000+
+  '07001_DL_Finished $1 styled assembler parsing'#000+
   '07002_E_Non-label pattern contains @'#000+
   '07004_E_Error building record offset'#000+
   '07005_E_OFFSET used without identifier'#000+
-  '07006_E_TYPE used without identifier'#000+
+  '07006_E_T','YPE used without identifier'#000+
   '07007_E_Cannot use local variable or parameters here'#000+
-  '0','7008_E_need to use OFFSET here'#000+
+  '07008_E_need to use OFFSET here'#000+
   '07009_E_need to use $ here'#000+
   '07010_E_Cannot use multiple relocatable symbols'#000+
   '07011_E_Relocatable symbol can only be added'#000+
-  '07012_E_Invalid constant expression'#000+
+  '07012_E','_Invalid constant expression'#000+
   '07013_E_Relocatable symbol is not allowed'#000+
-  '07014_E_Inv','alid reference syntax'#000+
+  '07014_E_Invalid reference syntax'#000+
   '07015_E_You can not reach $1 from that code'#000+
   '07016_E_Local symbols/labels aren'#039't allowed as references'#000+
-  '07017_E_Invalid base and index register usage'#000+
+  '07017_E_Invalid base and index reg','ister usage'#000+
   '07018_W_Possible error in object field handling'#000+
-  '07019_E_Wrong scale fa','ctor specified'#000+
+  '07019_E_Wrong scale factor specified'#000+
   '07020_E_Multiple index register usage'#000+
   '07021_E_Invalid operand type'#000+
   '07022_E_Invalid string as opcode operand: $1'#000+
-  '07023_W_@CODE and @DATA not supported'#000+
+  '07023_W_@CODE and @DATA not sup','ported'#000+
   '07024_E_Null label references are not allowed'#000+
-  '07025_E_Divide by zero in asm',' evaluator'#000+
+  '07025_E_Divide by zero in asm evaluator'#000+
   '07026_E_Illegal expression'#000+
   '07027_E_escape sequence ignored: $1'#000+
   '07028_E_Invalid symbol reference'#000+
-  '07029_W_Fwait can cause emulation problems with emu387'#000+
+  '07029_W_Fwait can cause emulation problems with emu','387'#000+
   '07030_W_$1 without operand translated into $1P'#000+
-  '07031_W_ENTER instruction is no','t supported by Linux kernel'#000+
+  '07031_W_ENTER instruction is not supported by Linux kernel'#000+
   '07032_W_Calling an overload function in assembler'#000+
   '07033_E_Unsupported symbol type for operand'#000+
-  '07034_E_Constant value out of bounds'#000+
+  '07034_E_Constant value out of bounds',#000+
   '07035_E_Error converting decimal $1'#000+
   '07036_E_Error converting octal $1'#000+
-  '07037_E_Err','or converting binary $1'#000+
+  '07037_E_Error converting binary $1'#000+
   '07038_E_Error converting hexadecimal $1'#000+
   '07039_H_$1 translated to $2'#000+
   '07040_W_$1 is associated to an overloaded function'#000+
-  '07041_E_Cannot use SELF outside a method'#000+
+  '07041_E_Cannot ','use SELF outside a method'#000+
   '07042_E_Cannot use OLDEBP outside a nested procedure'#000+
-  '070','43_W_Procedures can'#039't return any value in asm code'#000+
+  '07043_W_Procedures can'#039't return any value in asm code'#000+
   '07044_E_SEG not supported'#000+
   '07045_E_Size suffix and destination or source size do not match'#000+
-  '07046_W_Size suffix and destination or source size do not match'#000+
+  '07046_W_Size suff','ix and destination or source size do not match'#000+
   '07047_E_Assembler syntax error'#000+
-  '0704','8_E_Invalid combination of opcode and operands'#000+
+  '07048_E_Invalid combination of opcode and operands'#000+
   '07049_E_Assembler syntax error in operand'#000+
   '07050_E_Assembler syntax error in constant'#000+
-  '07051_E_Invalid String expression'#000+
+  '07051_E_Invalid String exp','ression'#000+
   '07052_W_constant with symbol $1 for address which is not on a pointer'#000+
-  '0705','3_E_Unrecognized opcode $1'#000+
+  '07053_E_Unrecognized opcode $1'#000+
   '07054_E_Invalid or missing opcode'#000+
   '07055_E_Invalid combination of prefix and opcode: $1'#000+
-  '07056_E_Invalid combination of override and opcode: $1'#000+
+  '07056_E_Invalid combination of override and ','opcode: $1'#000+
   '07057_E_Too many operands on line'#000+
   '07058_W_NEAR ignored'#000+
-  '07059_W_FAR igno','red'#000+
+  '07059_W_FAR ignored'#000+
   '07060_E_Duplicate local symbol $1'#000+
   '07061_E_Undefined local symbol $1'#000+
   '07062_E_Unknown label identifier $1'#000+
   '07063_E_Invalid register name'#000+
-  '07064_E_Invalid floating point register name'#000+
+  '07064_E_Invalid floa','ting point register name'#000+
   '07066_W_Modulo not supported'#000+
-  '07067_E_Invalid floating poi','nt constant $1'#000+
+  '07067_E_Invalid floating point constant $1'#000+
   '07068_E_Invalid floating point expression'#000+
   '07069_E_Wrong symbol type'#000+
   '07070_E_Cannot index a local var or parameter with a register'#000+
-  '07071_E_Invalid segment override expression'#000+
+  '07071_E_Inval','id segment override expression'#000+
   '07072_W_Identifier $1 supposed external'#000+
-  '07073_E_Str','ings not allowed as constants'#000+
+  '07073_E_Strings not allowed as constants'#000+
   '07074_No type of variable specified'#000+
   '07075_E_assembler code not returned to text section'#000+
-  '07076_E_Not a directive or local symbol $1'#000+
+  '07076_E_Not a directive or local symbol ','$1'#000+
   '07077_E_Using a defined name as a local label'#000+
-  '07078_E_Dollar token is used with','out an identifier'#000+
+  '07078_E_Dollar token is used without an identifier'#000+
   '07079_W_32bit constant created for address'#000+
   '07080_N_.align is target specific, use .balign or .p2align'#000+
-  '07081_E_Can'#039't access fields directly for parameters'#000+
+  '07081_E_Can'#039't access fields directly f','or parameters'#000+
   '07082_E_Can'#039't access fields of objects/classes directly'#000+
-  '07083_E_No s','ize specified and unable to determine the size of the op'+
-  'erands'#000+
+  '07083_E_No size specified and unable to determine the size of the oper'+
+  'ands'#000+
   '07084_E_Cannot use RESULT in this function'#000+
-  '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
+  '07086_W_"$1" without operand translated into "$1 %st',',%st(1)"'#000+
   '07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
-  '07088_W_"$1 %st(n)" t','ranslated into "$1 %st(n),%st"'#000+
+  '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
   '07089_E_Char < not allowed here'#000+
   '07090_E_Char > not allowed here'#000+
   '07093_W_ALIGN not supported'#000+
-  '07094_E_Inc and Dec cannot be together'#000+
+  '07094_E_Inc and Dec cannot be toget','her'#000+
   '07095_E_Invalid reglist for movem'#000+
   '07096_E_Reglist invalid for opcode'#000+
-  '07097_E_H','igher cpu mode required ($1)'#000+
+  '07097_E_Higher cpu mode required ($1)'#000+
   '07098_W_No size specified and unable to determine the size of the oper'+
   'ands, using DWORD as default'#000+
-  '07099_E_Syntax error while trying to parse a shifter operand'#000+
-  '07100_E_Address of packed component is not at a byt','e boundary'#000+
+  '07099_E_Syntax error while try','ing to parse a shifter operand'#000+
+  '07100_E_Address of packed component is not at a byte boundary'#000+
   '07101_W_No size specified and unable to determine the size of the oper'+
   'ands, using BYTE as default'#000+
-  '07102_W_Use of +offset(%ebp) for parameters invalid here'#000+
+  '07102_W_Use of +offset(%ebp) for parameters inval','id here'#000+
   '07103_W_Use of +offset(%ebp) is not compatible with regcall convention'+
   #000+
-  '071','04_W_Use of -offset(%ebp) is not recommended for local variable a'+
-  'ccess'#000+
+  '07104_W_Use of -offset(%ebp) is not recommended for local variable acc'+
+  'ess'#000+
   '07105_W_Use of -offset(%esp), access may cause a crash or value may be'+
   ' lost'#000+
-  '07106_E_VMTOffset must be used in combination with a virtual method, a'+
-  'nd "$1" is not virtual'#000,
+  '07106_E_VMT','Offset must be used in combination with a virtual method,'+
+  ' and "$1" is not virtual'#000+
   '07107_E_Generating PIC, but reference is not PIC-safe'#000+
   '08000_F_Too many assembler files'#000+
   '08001_F_Selected assembler output not supported'#000+
-  '08002_F_Comp not supported'#000+
+  '08002_F_Comp not suppor','ted'#000+
   '08003_F_Direct not support for binary writers'#000+
-  '08004_E_Allocating of data is on','ly allowed in bss section'#000+
+  '08004_E_Allocating of data is only allowed in bss section'#000+
   '08005_F_No binary writer selected'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
   '08007_E_Asm: $1 invalid combination of opcode and operands'#000+
-  '08008_E_Asm: 16 Bit references not supported'#000+
+  '080','08_E_Asm: 16 Bit references not supported'#000+
   '08009_E_Asm: Invalid effective address'#000+
-  '0','8010_E_Asm: Immediate or reference expected'#000+
+  '08010_E_Asm: Immediate or reference expected'#000+
   '08011_E_Asm: $1 value exceeds bounds $2'#000+
   '08012_E_Asm: Short jump is out of range $1'#000+
-  '08013_E_Asm: Undefined label $1'#000+
+  '08013_E_Asm: Undefined label $1',#000+
   '08014_E_Asm: Comp type not supported for this target'#000+
-  '08015_E_Asm: Extended type n','ot supported for this target'#000+
+  '08015_E_Asm: Extended type not supported for this target'#000+
   '08016_E_Asm: Duplicate label $1'#000+
   '08017_E_Asm: Redefined label $1'#000+
   '08018_E_Asm: First defined here'#000+
-  '08019_E_Asm: Invalid register $1'#000+
+  '08019_E_Asm: Invalid register $1'#000,
   '08020_E_Asm: 16 or 32 Bit references not supported'#000+
-  '08021_E_Asm: 64 Bit operands no','t supported'#000+
+  '08021_E_Asm: 64 Bit operands not supported'#000+
   '09000_W_Source operating system redefined'#000+
   '09001_I_Assembling (pipe) $1'#000+
   '09002_E_Can'#039't create assembler file: $1'#000+
-  '09003_E_Can'#039't create object file: $1'#000+
+  '09003_E_Can'#039't create object file: $','1'#000+
   '09004_E_Can'#039't create archive file: $1'#000+
-  '09005_E_Assembler $1 not found, switching ','to external assembling'#000+
+  '09005_E_Assembler $1 not found, switching to external assembling'#000+
   '09006_T_Using assembler: $1'#000+
   '09007_E_Error while assembling exitcode $1'#000+
-  '09008_E_Can'#039't call the assembler, error $1 switching to external a'+
-  'ssembling'#000+
+  '09008_E_Can'#039't call the assembler, error $1 switching to external',' '+
+  'assembling'#000+
   '09009_I_Assembling $1'#000+
   '09010_I_Assembling with smartlinking $1'#000+
-  '09011_W_','Object $1 not found, Linking may fail !'#000+
+  '09011_W_Object $1 not found, Linking may fail !'#000+
   '09012_W_Library $1 not found, Linking may fail !'#000+
   '09013_E_Error while linking'#000+
-  '09014_E_Can'#039't call the linker, switching to external linking'#000+
+  '09014_E_Can'#039't call the linker, switching ','to external linking'#000+
   '09015_I_Linking $1'#000+
-  '09016_E_Util $1 not found, switching to ext','ernal linking'#000+
+  '09016_E_Util $1 not found, switching to external linking'#000+
   '09017_T_Using util $1'#000+
   '09018_E_Creation of Executables not supported'#000+
   '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
-  '09020_I_Closing script $1'#000+
+  '09020_I_Closing s','cript $1'#000+
   '09021_E_resource compiler "$1" not found, switching to external mode'#000+
-  '0902','2_I_Compiling resource $1'#000+
+  '09022_I_Compiling resource $1'#000+
   '09023_T_unit $1 can'#039't be statically linked, switching to smart lin'+
   'king'#000+
-  '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
-  #000+
+  '09024_T_unit $1 can'#039't be smart linked, switching to static li','nki'+
+  'ng'#000+
   '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
   'g'#000+
-  '09026_E_','unit $1 can'#039't be smart or static linked'#000+
+  '09026_E_unit $1 can'#039't be smart or static linked'#000+
   '09027_E_unit $1 can'#039't be shared or static linked'#000+
   '09028_D_Calling resource compiler "$1" with "$2" as command line'#000+
-  '09029_E_Error while compiling resources'#000+
-  '09030_E_Can'#039't call the resource compiler "$1",',' switching to exte'+
-  'rnal mode'#000+
+  '0902','9_E_Error while compiling resources'#000+
+  '09030_E_Can'#039't call the resource compiler "$1", switching to extern'+
+  'al mode'#000+
   '09031_E_Can'#039't open resource file "$1"'#000+
   '09032_E_Can'#039't write resource file "$1"'#000+
   '09128_F_Can'#039't post process executable $1'#000+
-  '09129_F_Can'#039't open executable $1'#000+
+  '09129_F_Can'#039,'t open executable $1'#000+
   '09130_X_Size of Code: $1 bytes'#000+
-  '09131_X_Size of initialized da','ta: $1 bytes'#000+
+  '09131_X_Size of initialized data: $1 bytes'#000+
   '09132_X_Size of uninitialized data: $1 bytes'#000+
   '09133_X_Stack space reserved: $1 bytes'#000+
   '09134_X_Stack space committed: $1 bytes'#000+
-  '09200_F_Executable image size is too big for $1 target.'#000+
+  '09200_F_Executable im','age size is too big for $1 target.'#000+
   '10000_T_Unitsearch: $1'#000+
   '10001_T_PPU Loading $1'#000+
-  '1','0002_U_PPU Name: $1'#000+
+  '10002_U_PPU Name: $1'#000+
   '10003_U_PPU Flags: $1'#000+
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
   '10006_U_PPU File too short'#000+
-  '10007_U_PPU Invalid Header (no PPU at the begin)'#000+
+  '10007_U_PPU Invalid Header (no PPU at the begin)',#000+
   '10008_U_PPU Invalid Version $1'#000+
   '10009_U_PPU is compiled for another processor'#000+
-  '1001','0_U_PPU is compiled for an other target'#000+
+  '10010_U_PPU is compiled for an other target'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
   '10013_F_Can'#039't Write PPU-File'#000+
   '10014_F_Error reading PPU-File'#000+
-  '10015_F_unexpected end of PPU-File'#000+
+  '10015_F_unexpect','ed end of PPU-File'#000+
   '10016_F_Invalid PPU-File entry: $1'#000+
-  '10017_F_PPU Dbx count proble','m'#000+
+  '10017_F_PPU Dbx count problem'#000+
   '10018_E_Illegal unit name: $1'#000+
   '10019_F_Too much units'#000+
   '10020_F_Circular unit reference between $1 and $2'#000+
   '10021_F_Can'#039't compile unit $1, no sources available'#000+
-  '10022_F_Can'#039't find unit $1 used by $2'#000+
+  '1','0022_F_Can'#039't find unit $1 used by $2'#000+
   '10023_W_Unit $1 was not found but $2 exists'#000+
-  '1','0024_F_Unit $1 searched but $2 found'#000+
+  '10024_F_Unit $1 searched but $2 found'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
   '10026_F_There were $1 errors compiling module, stopping'#000+
-  '10027_U_Load from $1 ($2) unit $3'#000+
+  '10027_U','_Load from $1 ($2) unit $3'#000+
   '10028_U_Recompiling $1, checksum changed for $2'#000+
-  '10029_U','_Recompiling $1, source found only'#000+
+  '10029_U_Recompiling $1, source found only'#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
   '10031_U_Recompiling unit, shared lib is older than ppufile'#000+
-  '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+
-  '10033_U_Recompiling unit, ','obj is older than asm'#000+
+  '10032','_U_Recompiling unit, obj and asm are older than ppufile'#000+
+  '10033_U_Recompiling unit, obj is older than asm'#000+
   '10034_U_Parsing interface of $1'#000+
   '10035_U_Parsing implementation of $1'#000+
   '10036_U_Second load for unit $1'#000+
   '10037_U_PPU Check file $1 time $2'#000+
-  '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
-  '10041_U_File $1 is',' newer than PPU file $2'#000+
+  '1','0040_W_Can'#039't recompile unit $1, but found modifed include files'+
+  #000+
+  '10041_U_File $1 is newer than PPU file $2'#000+
   '10042_U_Trying to use a unit which was compiled with a different FPU m'+
   'ode'#000+
   '10043_U_Loading interface units from $1'#000+
-  '10044_U_Loading implementation units from $1'#000+
+  '10044_U_Loading impl','ementation units from $1'#000+
   '10045_U_Interface CRC changed for unit $1'#000+
-  '10046_U_Impleme','ntation CRC changed for unit $1'#000+
+  '10046_U_Implementation CRC changed for unit $1'#000+
   '10047_U_Finished compiling unit $1'#000+
   '10048_U_Add dependency of $1 to $2'#000+
   '10049_U_No reload, is caller: $1'#000+
-  '10050_U_No reload, already in second compile: $1'#000+
+  '10050_U_No reload, alre','ady in second compile: $1'#000+
   '10051_U_Flag for reload: $1'#000+
   '10052_U_Forced reloading'#000+
-  '100','53_U_Previous state of $1: $2'#000+
+  '10053_U_Previous state of $1: $2'#000+
   '10054_U_Already compiling $1, setting second compile'#000+
   '10055_U_Loading unit $1'#000+
   '10056_U_Finished loading unit $1'#000+
-  '10057_U_Registering new unit $1'#000+
+  '10057_U_Registerin','g new unit $1'#000+
   '10058_U_Re-resolving unit $1'#000+
-  '10059_U_Skipping re-resolving unit $1, ','still loading used units'#000+
+  '10059_U_Skipping re-resolving unit $1, still loading used units'#000+
   '10060_U_Unloading resource unit $1 (not needed)'#000+
   '11000_O_$1 [options] <inputfile> [options]'#000+
   '11001_W_Only one source file supported'#000+
-  '11002_W_DEF file can be created only for OS/2'#000+
-  '11003_E_nested response files are not s','upported'#000+
+  '110','02_W_DEF file can be created only for OS/2'#000+
+  '11003_E_nested response files are not supported'#000+
   '11004_F_No source file name in command line'#000+
   '11005_N_No option inside $1 config file'#000+
   '11006_E_Illegal parameter: $1'#000+
   '11007_H_-? writes help pages'#000+
-  '11008_F_Too many config files nested'#000+
+  '11008_','F_Too many config files nested'#000+
   '11009_F_Unable to open file $1'#000+
-  '11010_D_Reading furt','her options from $1'#000+
+  '11010_D_Reading further options from $1'#000+
   '11011_W_Target is already set to: $1'#000+
   '11012_W_Shared libs not supported on DOS platform, reverting to static'+
   #000+
-  '11013_F_In options file $1 at line $2 too many \var{\#IF(N)DEFs} encou'+
-  'ntered'#000+
-  '11014_F_In options file $1 at line ','$2 unexpected \var{\#ENDIFs} enco'+
-  'untered'#000+
+  '11013_F_In options file $1 at ','line $2 too many \var{\#IF(N)DEFs} enc'+
+  'ountered'#000+
+  '11014_F_In options file $1 at line $2 unexpected \var{\#ENDIFs} encoun'+
+  'tered'#000+
   '11015_F_Open conditional at the end of the options file'#000+
-  '11016_W_Debug information generation is not supported by this executab'+
-  'le'#000+
+  '11016_W_Debug information generation is not supported by this',' execut'+
+  'able'#000+
   '11017_H_Try recompiling with -dGDB'#000+
-  '11018_W_You are using the obsolete ','switch $1'#000+
+  '11018_W_You are using the obsolete switch $1'#000+
   '11019_W_You are using the obsolete switch $1, please use $2'#000+
   '11020_N_Switching assembler to default source writing assembler'#000+
-  '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
+  '11021_W_Assembler output',' selected "$1" is not compatible with "$2"'#000+
   '11022_W_"$1" assembler use forced'#000+
-  '11026','_T_Reading options from file $1'#000+
+  '11026_T_Reading options from file $1'#000+
   '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11029_O_*** press enter ***'#000+
-  '11030_H_Start of reading config file $1'#000+
+  '11030_H_Start of reading ','config file $1'#000+
   '11031_H_End of reading config file $1'#000+
-  '11032_D_interpreting option "','$1"'#000+
+  '11032_D_interpreting option "$1"'#000+
   '11036_D_interpreting firstpass option "$1"'#000+
   '11033_D_interpreting file option "$1"'#000+
   '11034_D_Reading config file "$1"'#000+
   '11035_D_found source file name "$1"'#000+
-  '11039_E_Unknown code page'#000+
+  '1103','9_E_Unknown code page'#000+
   '11040_F_Config file $1 is a directory'#000+
-  '11041_W_Assembler outp','ut selected "$1" cannot generate debug info, d'+
-  'ebugging disabled'#000+
+  '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
+  'ugging disabled'#000+
   '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+
-  '11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \'+
-  'var{\#IF(N)DEF} found'#000+
-  '11023_Free Pasca','l Compiler version $FPCFULLVERSION [$FPCDATE] for $F'+
-  'PCCPU'#010+
+  '11043_F_In options file $1',' at line $2 \var{\#ELSE} directive without'+
+  ' \var{\#IF(N)DEF} found'#000+
+  '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
+  'CPU'#010+
   'Copyright (c) 1993-2008 by Florian Klaempfl'#000+
   '11024_Free Pascal Compiler version $FPCVERSION'#010+
   #010+
-  'Compiler Date      : $FPCDATE'#010+
+  'Compiler',' Date      : $FPCDATE'#010+
   'Compiler CPU Target: $FPCCPU'#010+
   #010+
   'Supported targets:'#010+
-  '  $OSTARGET','S'#010+
+  '  $OSTARGETS'#010+
   #010+
   'Supported CPU instruction sets:'#010+
   '  $INSTRUCTIONSETS'#010+
@@ -861,275 +866,275 @@ const msgtxt : array[0..000198,1..240] of char=(
   'Supported ABI targets:'#010+
   '  $ABITARGETS'#010+
   #010+
-  'Supported Optimizations:'#010+
+  'Supported ','Optimizations:'#010+
   '  $OPTIMIZATIONS'#010+
   #010+
-  'This program comes under the GNU General Public L','icence'#010+
+  'This program comes under the GNU General Public Licence'#010+
   'For more information read COPYING.FPC'#010+
   #010+
   'Report bugs,suggestions etc to:'#010+
   '                 [email protected]'#000+
-  '11025_**0*_Put + after a boolean switch option to enable it, - to disa'+
-  'ble it'#010+
-  '**1a_The compiler doesn'#039't delete the generated a','ssembler file'#010+
+  '11025_**0*_Put + after a boolean switch opt','ion to enable it, - to di'+
+  'sable it'#010+
+  '**1a_The compiler doesn'#039't delete the generated assembler file'#010+
   '**2al_List sourcecode lines in assembler file'#010+
   '**2an_List node info in assembler file'#010+
-  '*L2ap_Use pipes instead of creating temporary assembler files'#010+
+  '*L2ap_Use pipes instead of creating temporary assembler fil','es'#010+
   '**2ar_List register allocation/release info in assembler file'#010+
-  '**2at_List temp a','llocation/release info in assembler file'#010+
+  '**2at_List temp allocation/release info in assembler file'#010+
   '**1A<x>_Output format:'#010+
   '**2Adefault_Use default assembler'#010+
   '3*2Aas_Assemble using GNU AS'#010+
-  '3*2Anasmcoff_COFF (Go32v2) file using Nasm'#010+
+  '3*2Anasmcoff_COFF (Go32v2) file',' using Nasm'#010+
   '3*2Anasmelf_ELF32 (Linux) file using Nasm'#010+
-  '3*2Anasmwin32_Win32 object f','ile using Nasm'#010+
+  '3*2Anasmwin32_Win32 object file using Nasm'#010+
   '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+
   '3*2Awasm_Obj file using Wasm (Watcom)'#010+
   '3*2Anasmobj_Obj file using Nasm'#010+
-  '3*2Amasm_Obj file using Masm (Microsoft)'#010+
+  '3*2Amasm_Obj file using ','Masm (Microsoft)'#010+
   '3*2Atasm_Obj file using Tasm (Borland)'#010+
-  '3*2Aelf_ELF (Linux) using ','internal writer'#010+
+  '3*2Aelf_ELF (Linux) using internal writer'#010+
   '3*2Acoff_COFF (Go32v2) using internal writer'#010+
   '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
   '4*2Aas_Assemble using GNU AS'#010+
-  '6*2Aas_Unix o-file using GNU AS'#010+
+  '6*2Aas_Unix o-file ','using GNU AS'#010+
   '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
-  '6*2Amot_S','tandard Motorola assembler'#010+
+  '6*2Amot_Standard Motorola assembler'#010+
   'A*2Aas_Assemble using GNU AS'#010+
   'P*2Aas_Assemble using GNU AS'#010+
   'S*2Aas_Assemble using GNU AS'#010+
   '**1b_Generate browser info'#010+
-  '**2bl_Generate local symbol info'#010+
+  '**2bl_Generate lo','cal symbol info'#010+
   '**1B_Build all modules'#010+
   '**1C<x>_Code generation options:'#010+
-  '**2Ca<x>_S','elect ABI, see fpc -i for possible values'#010+
+  '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+
   '**2Cb_Generate big-endian code'#010+
   '**2Cc<x>_Set default calling convention to <x>'#010+
-  '**2CD_Create also dynamic library (not supported)'#010+
+  '**2CD_Create also dynamic library (not',' supported)'#010+
   '**2Ce_Compilation with emulated floating point opcodes'#010+
-  '**2Cf<x>_Select',' fpu instruction set to use, see fpc -i for possible '+
-  'values'#010+
+  '**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible va'+
+  'lues'#010+
   '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
   '**2Cg_Generate PIC code'#010+
-  '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
+  '**2Ch','<n>_<n> bytes heap (between 1023 and 67107840)'#010+
   '**2Ci_IO-checking'#010+
-  '**2Cn_Omit linkin','g stage'#010+
+  '**2Cn_Omit linking stage'#010+
   '**2Co_Check overflow of integer operations'#010+
   '**2CO_Check for possible overflow of integer operations'#010+
-  '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+
+  '**2Cp<x>_Select instruction set, see fpc -i for pos','sible values'#010+
   '**2CP<x>=<y>_ packing settings'#010+
-  '**3CPPACKSET=<y>_ <y> set allocation: ','0, 1 or DEFAULT or NORMAL, 2, '+
-  '4 and 8'#010+
+  '**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 '+
+  'and 8'#010+
   '**2Cr_Range checking'#010+
   '**2CR_Verify object method call validity'#010+
   '**2Cs<n>_Set stack size to <n>'#010+
   '**2Ct_Stack checking'#010+
-  '**2CX_Create also smartlinked library'#010+
+  '**2CX_','Create also smartlinked library'#010+
   '**1d<x>_Defines the symbol <x>'#010+
-  '**1D_Generate a DEF',' file'#010+
+  '**1D_Generate a DEF file'#010+
   '**2Dd<x>_Set description to <x>'#010+
   '**2Dv<x>_Set DLL version to <x>'#010+
   '*O2Dw_PM application'#010+
   '**1e<x>_Set path to executable'#010+
   '**1E_Same as -Cn'#010+
-  '**1fPIC_Same as -Cg'#010+
+  '**1fPIC_Same as -Cg',#010+
   '**1F<x>_Set file names and paths:'#010+
-  '**2Fa<x>[,y]_(for a program) load units <x> and',' [y] before uses is p'+
-  'arsed'#010+
+  '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+
+  'sed'#010+
   '**2Fc<x>_Set input codepage to <x>'#010+
   '**2FC<x>_Set RC compiler binary name to <x>'#010+
-  '**2FD<x>_Set the directory where to search for compiler utilities'#010+
+  '**2FD<x>_Set the directory where to search for compi','ler utilities'#010+
   '**2Fe<x>_Redirect error output to <x>'#010+
-  '**2Ff<x>_Add <x> to framework ','path (Darwin only)'#010+
+  '**2Ff<x>_Add <x> to framework path (Darwin only)'#010+
   '**2FE<x>_Set exe/unit output path to <x>'#010+
   '**2Fi<x>_Add <x> to include path'#010+
   '**2Fl<x>_Add <x> to library path'#010+
-  '**2FL<x>_Use <x> as dynamic linker'#010+
+  '**2FL<x>_Use <x> as dynamic link','er'#010+
   '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
   'r'#010+
-  '**2Fo<x','>_Add <x> to object path'#010+
+  '**2Fo<x>_Add <x> to object path'#010+
   '**2Fr<x>_Load error message file <x>'#010+
   '**2FR<x>_Set resource (.res) linker to <x>'#010+
   '**2Fu<x>_Add <x> to unit path'#010+
-  '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+
-  '*g1g_Generate debug information (default format for t','arget)'#010+
+  '**2FU<x>_Set unit outpu','t path to <x>, overrides -FE'#010+
+  '*g1g_Generate debug information (default format for target)'#010+
   '*g2gc_Generate checks for pointers'#010+
   '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+
-  '*g2gl_Use line info unit (show more info with backtraces)'#010+
+  '*g2gl_Use line info unit (show more info with backtr','aces)'#010+
   '*g2go<x>_Set debug information options'#010+
-  '*g3godwarfsets_ Enable Dwarf set debu','g information (breaks gdb < 6.5'+
-  ')'#010+
+  '*g3godwarfsets_ Enable Dwarf set debug information (breaks gdb < 6.5)'#010+
   '*g2gp_Preserve case in stabs symbol names'#010+
   '*g2gs_Generate stabs debug information'#010+
-  '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
+  '*g2gt_Trash local variables (to detect unini','tialized uses)'#010+
   '*g2gv_Generates programs traceable with valgrind'#010+
-  '*g2gw_Generate dwa','rf-2 debug information (same as -gw2)'#010+
+  '*g2gw_Generate dwarf-2 debug information (same as -gw2)'#010+
   '*g2gw2_Generate dwarf-2 debug information'#010+
   '*g2gw3_Generate dwarf-3 debug information'#010+
   '**1i_Information'#010+
-  '**2iD_Return compiler date'#010+
+  '**2iD_Return compil','er date'#010+
   '**2iV_Return short compiler version'#010+
   '**2iW_Return full compiler version'#010+
-  '**2','iSO_Return compiler OS'#010+
+  '**2iSO_Return compiler OS'#010+
   '**2iSP_Return compiler host processor'#010+
   '**2iTO_Return target OS'#010+
   '**2iTP_Return target processor'#010+
   '**1I<x>_Add <x> to include path'#010+
-  '**1k<x>_Pass <x> to the linker'#010+
+  '**1k<x>_Pa','ss <x> to the linker'#010+
   '**1l_Write logo'#010+
   '**1M<x>_Set language mode to <x>'#010+
-  '**2Mfpc_Free',' Pascal dialect (default)'#010+
+  '**2Mfpc_Free Pascal dialect (default)'#010+
   '**2Mobjfpc_FPC mode with Object Pascal support'#010+
   '**2Mdelphi_Delphi 7 compatibility mode'#010+
   '**2Mtp_TP/BP 7.0 compatibility mode'#010+
-  '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
-  '**1n_Do not read the default config ','files'#010+
+  '**2Mmacpas','_Macintosh Pascal dialects compatibility mode'#010+
+  '**1n_Do not read the default config files'#010+
   '**1N<x>_Node tree optimizations'#010+
   '**2Nu_Unroll loops'#010+
   '**1o<x>_Change the name of the executable produced to <x>'#010+
   '**1O<x>_Optimizations:'#010+
-  '**2O-_Disable optimizations'#010+
+  '**2O-_Disable optimi','zations'#010+
   '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
-  '**2O2_Level 2 op','timizations (-O1 + quick optimizations)'#010+
+  '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
   '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
   '**2Oa<x>=<y>_Set alignment'#010+
-  '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
-  'values'#010+
-  '**2Op<x>_Set target cpu for optimizing, s','ee fpc -i for possible valu'+
-  'es'#010+
+  '**2Oo[NO]<x>_Enable or disable optim','izations, see fpc -i for possibl'+
+  'e values'#010+
+  '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
+  #010+
   '**2Os_Optimize for size rather than speed'#010+
   '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
-  '**1R<x>_Assembler reading style:'#010+
+  '**1R<x>_Assembler reading ','style:'#010+
   '**2Rdefault_Use default assembler for target'#010+
-  '3*2Ratt_Read AT&T style assemb','ler'#010+
+  '3*2Ratt_Read AT&T style assembler'#010+
   '3*2Rintel_Read Intel style assembler'#010+
   '6*2RMOT_Read motorola style assembler'#010+
   '**1S<x>_Syntax options:'#010+
   '**2S2_Same as -Mobjfpc'#010+
-  '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+
+  '**2Sc_Support operators like C (','*=,+=,/= and -=)'#010+
   '**2Sa_Turn on assertions'#010+
   '**2Sd_Same as -Mdelphi'#010+
-  '**2Se<x>_Error op','tions. <x> is a combination of the following:'#010+
+  '**2Se<x>_Error options. <x> is a combination of the following:'#010+
   '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+
   '**3*_w : Compiler also halts after warnings'#010+
-  '**3*_n : Compiler also halts after notes'#010+
+  '**3*_n',' : Compiler also halts after notes'#010+
   '**3*_h : Compiler also halts after hints'#010+
-  '**2Sg_','Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
+  '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
   '**2Sh_Use ansistrings by default instead of shortstrings'#010+
-  '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
+  '**2Si_Turn on inlining of procedures/functions d','eclared as "inline"'#010+
   '**2Sk_Load fpcylix unit'#010+
   '**2SI<x>_Set interface style to <x>'#010+
-  '**','3SIcom_COM compatible interface (default)'#010+
+  '**3SIcom_COM compatible interface (default)'#010+
   '**3SIcorba_CORBA compatible interface'#010+
   '**2Sm_Support macros like C (global)'#010+
   '**2So_Same as -Mtp'#010+
-  '**2Ss_Constructor name must be init (destructor must be done)'#010+
+  '**2Ss_Constructor name',' must be init (destructor must be done)'#010+
   '**2St_Allow static keyword in objects'#010+
-  '**2S','x_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
+  '**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
   '**1s_Do not call assembler and linker'#010+
   '**2sh_Generate script to link on host'#010+
-  '**2st_Generate script to link on target'#010+
+  '**2st_Generate script',' to link on target'#010+
   '**2sr_Skip register allocation phase (use with -alr)'#010+
-  '**1T<x>_Ta','rget operating system:'#010+
+  '**1T<x>_Target operating system:'#010+
   '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
   '3*2Tfreebsd_FreeBSD'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
   '3*2Tlinux_Linux'#010+
-  '3*2Tnetbsd_NetBSD'#010+
+  '3','*2Tnetbsd_NetBSD'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
-  '3*2Tnetwlibc_Novell Netw','are Module (libc)'#010+
+  '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
   '3*2Topenbsd_OpenBSD'#010+
   '3*2Tos2_OS/2 / eComStation'#010+
   '3*2Tsunos_SunOS/Solaris'#010+
   '3*2Tsymbian_Symbian OS'#010+
   '3*2Twatcom_Watcom compatible DOS extender'#010+
-  '3*2Twdosx_WDOSX DOS extender'#010+
+  '3*2T','wdosx_WDOSX DOS extender'#010+
   '3*2Twin32_Windows 32 Bit'#010+
   '3*2Twince_Windows CE'#010+
-  '4*2Tlinux_L','inux'#010+
+  '4*2Tlinux_Linux'#010+
   '6*2Tamiga_Commodore Amiga'#010+
   '6*2Tatari_Atari ST/STe/TT'#010+
   '6*2Tlinux_Linux/m68k'#010+
   '6*2Tmacos_Macintosh m68k (not supported)'#010+
   '6*2Tpalmos_PalmOS'#010+
   'A*2Tlinux_Linux'#010+
-  'A*2Twince_Windows CE'#010+
+  'A*2Tw','ince_Windows CE'#010+
   'P*2Tamiga_AmigaOS on PowerPC'#010+
-  'P*2Tdarwin_Darwin and Mac OS X on Pow','erPC'#010+
+  'P*2Tdarwin_Darwin and Mac OS X on PowerPC'#010+
   'P*2Tlinux_Linux on PowerPC'#010+
   'P*2Tmacos_Mac OS (classic) on PowerPC'#010+
   'P*2Tmorphos_MorphOS'#010+
   'S*2Tlinux_Linux'#010+
   '**1u<x>_Undefines the symbol <x>'#010+
-  '**1U_Unit options:'#010+
+  '**1U_Unit options:'#010,
   '**2Un_Do not check where the unit name matches the file name'#010+
-  '**2Ur_Generate releas','e unit files (never automatically recompiled)'#010+
+  '**2Ur_Generate release unit files (never automatically recompiled)'#010+
   '**2Us_Compile a system unit'#010+
   '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
-  '**2*_e : Show errors (default)       0 : Show nothing (except errors)'#010+
-  '**2*_w : Show warnings       ','        u : Show unit info'#010+
+  '**2*_e : Show err','ors (default)       0 : Show nothing (except errors'+
+  ')'#010+
+  '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
   '**2*_h : Show hints                  c : Show conditionals'#010+
-  '**2*_i : Show general info           d : Show debug info'#010+
-  '**2*_l : Show linenumbers         ','   r : Rhide/GCC compatibility mod'+
-  'e'#010+
+  '**2*_i : ','Show general info           d : Show debug info'#010+
+  '**2*_l : Show linenumbers            r : Rhide/GCC compatibility mode'#010+
   '**2*_a : Show everything             x : Executable info (Win32 only)'#010+
   '**2*_b : Write file names messages with full path'#010+
-  '**2*_v : Write fpcdebug.txt with     p : Write tree.log with parse tre'+
-  'e'#010+
-  '**2*_    lot','s of debugging info      q : Show message numbers'#010+
+  '**','2*_v : Write fpcdebug.txt with     p : Write tree.log with parse t'+
+  'ree'#010+
+  '**2*_    lots of debugging info      q : Show message numbers'#010+
   '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
   '3*1W<x>_Target-specific options (targets)'#010+
-  'A*1W<x>_Target-specific options (targets)'#010+
+  'A*1W<x>_T','arget-specific options (targets)'#010+
   'P*1W<x>_Target-specific options (targets)'#010+
-  '3*2Wb_C','reate a bundle instead of a library (Darwin)'#010+
+  '3*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'P*2Wb_Create a bundle instead of a library (Darwin)'#010+
   'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
-  '3*2WB_Create a relocatable image (Windows)'#010+
-  'A*2WB_Create a relocatable image (Windows, Symbi','an)'#010+
+  '3*2WB_Cre','ate a relocatable image (Windows)'#010+
+  'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
   '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
   'A*2WC_Specify console type application (Windows)'#010+
-  'P*2WC_Specify console type application (Classic Mac OS)'#010+
+  'P*2WC_Specify console type application (Class','ic Mac OS)'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
-  'A*2WD_Use',' DEFFILE to export functions of DLL or EXE (Windows)'#010+
+  'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
   '3*2We_Use external resources (Darwin)'#010+
   'P*2We_Use external resources (Darwin)'#010+
-  'p*2We_Use external resources (Darwin)'#010+
+  'p*2We_Use external resources ','(Darwin)'#010+
   '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+
-  '3*2WG_Specify grap','hic type application (EMX, OS/2, Windows)'#010+
+  '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
   'A*2WG_Specify graphic type application (Windows)'#010+
   'P*2WG_Specify graphic type application (Classic Mac OS)'#010+
-  '3*2Wi_Use internal resources (Darwin)'#010+
+  '3*2Wi_Use i','nternal resources (Darwin)'#010+
   'P*2Wi_Use internal resources (Darwin)'#010+
-  'p*2Wi_Use interna','l resources (Darwin)'#010+
+  'p*2Wi_Use internal resources (Darwin)'#010+
   '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
-  'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
+  'A*2WN_Do not generate relocation code, needed for debugging (Window','s'+
+  ')'#010+
   '3*2WR_Generate relocation code (Windows)'#010+
-  'A*2WR_Generate relocation code (Window','s)'#010+
+  'A*2WR_Generate relocation code (Windows)'#010+
   'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
   '**1X_Executable options:'#010+
   '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
-  'ux)'#010+
+  'ux)',#010+
   '**2Xd_Do not use standard library search path (needed for cross compil'+
   'e)'#010+
-  '**2Xe_Us','e external linker'#010+
+  '**2Xe_Use external linker'#010+
   '**2Xg_Create debuginfo in a separate file and add a debuglink section '+
   'to executable'#010+
-  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
+  '**2XD_Try to link units dynamically      (defines FPC_LI','NK_DYNAMIC)'#010+
   '**2Xi_Use internal linker'#010+
   '**2Xm_Generate link map'#010+
-  '**2XM<x>_Set the nam','e of the '#039'main'#039' program routine (default'+
-  ' is '#039'main'#039')'#010+
+  '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
+  's '#039'main'#039')'#010+
   '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
-  '**2Xr<x>_Set library search path to <x> (needed for cross compile) (Be'+
-  'OS, Linux)'#010+
-  '**2XR<x>_Prepend <x> to all linker search paths (Be','OS, Darwin, FreeB'+
-  'SD, Linux, Mac OS, Solaris)'#010+
+  '**2Xr<x>_Set library search path to <x> (needed fo','r cross compile) ('+
+  'BeOS, Linux)'#010+
+  '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
+  ', Linux, Mac OS, Solaris)'#010+
   '**2Xs_Strip all symbols from executable'#010+
   '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
-  '**2Xt_Link with static libraries (-static is passed to linker)'#010+
-  '**2XX_Try to smartlink',' units             (defines FPC_LINK_SMART)'#010+
+  '**2','Xt_Link with static libraries (-static is passed to linker)'#010+
+  '**2XX_Try to smartlink units             (defines FPC_LINK_SMART)'#010+
   '**1*_'#010+
   '**1?_Show this help'#010+
   '**1h_Shows this help without waiting'#000

compiler/nadd.pas

@@ -1123,7 +1123,7 @@ implementation
                     (nodetype=subn) then
                    begin
                      if nodetype<>subn then
-                       CGMessage(type_w_mixed_signed_unsigned);
+                       CGMessage(type_h_mixed_signed_unsigned);
                      { mark as internal in case added for a subn, so }
                      { ttypeconvnode.simplify can remove the 64 bit  }
                      { typecast again if semantically correct. Even  }

compiler/ncal.pas

@@ -2116,6 +2116,7 @@ implementation
         paraidx,
         cand_cnt : integer;
         i : longint;
+        ignorevisibility,
         is_const : boolean;
         statements : tstatementnode;
         converted_result_data : ttempcreatenode;
@@ -2211,9 +2212,10 @@ implementation
               { do we know the procedure to call ? }
               if not(assigned(procdefinition)) then
                 begin
-                   candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,(nf_isproperty in flags),
-                     { ignore possible private in delphi mode for anon. inherited (FK) }
-                     (m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
+                  { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
+                  ignorevisibility:=(nf_isproperty in flags) or
+                                    ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
+                  candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility);
 
                    { no procedures found? then there is something wrong
                      with the parameter size or the procedures are

compiler/ncgrtti.pas

@@ -165,7 +165,7 @@ implementation
         for i:=0 to st.SymList.Count-1 do
           begin
             sym:=tsym(st.SymList[i]);
-            if (sp_published in tsym(sym).symoptions) then
+            if (sym.visibility=vis_published) then
               begin
                 case tsym(sym).typ of
                   propertysym:
@@ -188,7 +188,7 @@ implementation
           begin
             sym:=tsym(st.SymList[i]);
             if (tsym(sym).typ=propertysym) and
-               (sp_published in tsym(sym).symoptions) then
+               (sym.visibility=vis_published) then
               inc(result);
           end;
       end;
@@ -206,7 +206,7 @@ implementation
           begin
             sym:=tsym(objdef.symtable.SymList[i]);
             if (tsym(sym).typ=propertysym) and
-               (sp_published in tsym(sym).symoptions) then
+               (sym.visibility=vis_published) then
               begin
                 pn:=TPropNameListItem(propnamelist.Find(tsym(sym).name));
                 if not assigned(pn) then
@@ -312,7 +312,7 @@ implementation
           begin
             sym:=tsym(st.SymList[i]);
             if (sym.typ=propertysym) and
-               (sp_published in sym.symoptions) then
+               (sym.visibility=vis_published) then
               begin
                 if ppo_indexed in tpropertysym(sym).propoptions then
                   proctypesinfo:=$40

compiler/ncnv.pas

@@ -2346,8 +2346,7 @@ implementation
                 if is_signed(left.resultdef) then
                   fname:='int32_to_'
                 else
-                  { we can't do better currently }
-                  fname:='int32_to_';
+                  fname:='int64_to_';
                 firstpass(left);
               end;
             if tfloatdef(resultdef).floattype=s64real then
@@ -2498,14 +2497,13 @@ implementation
             (left.resultdef.size=resultdef.size) and
             (left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
            exit;
-         { when converting 64bit int to C-ctyle boolean, first convert to a 32bit int and then   }
+         { when converting 64bit int to C-ctyle boolean, first convert to an int32 and then }
          { convert to a boolean (only necessary for 32bit processors) }
          if (left.resultdef.size > sizeof(aint)) and (left.resultdef.size<>resultdef.size)
             and is_cbool(resultdef) then
            begin
-             result := ctypeconvnode.create_internal(left,s32inttype);
-             left := nil;
-             firstpass(result);
+             left:=ctypeconvnode.create_internal(left,s32inttype);
+             firstpass(left);
              exit;
            end;
          expectloc:=LOC_REGISTER;

compiler/nmat.pas

@@ -253,7 +253,7 @@ implementation
              ((ld.ordtype = u32bit) and
               is_signed(rd)) then
            begin
-              CGMessage(type_w_mixed_signed_unsigned);
+              CGMessage(type_h_mixed_signed_unsigned);
               if (ld.ordtype<>s64bit) then
                 inserttypeconv(left,s64inttype);
               if (rd.ordtype<>s64bit) then

compiler/nobj.pas

@@ -34,30 +34,11 @@ interface
        ;
 
     type
-      pprocdefentry = ^tprocdefentry;
-      tprocdefentry = record
-         data    : tprocdef;
-         hidden  : boolean;
-         visible : boolean;
-      end;
-
-      { tvmtsymentry }
-
-      tvmtsymentry = class(TFPHashObject)
-        procdeflist : TFPList;
-        constructor Create(AList:TFPHashObjectList;const AName:shortstring);
-        destructor Destroy;override;
-      end;
-
       TVMTBuilder=class
       private
         _Class : tobjectdef;
-        VMTSymEntryList : TFPHashObjectList;
-        has_constructor,
-        has_virtual_method : boolean;
-        function is_new_vmt_entry(VMTSymEntry:TVMTSymEntry;pd:tprocdef):boolean;
-        procedure add_new_vmt_entry(VMTSymEntry:TVMTSymEntry;pd:tprocdef);
-        procedure add_vmt_entries(objdef:tobjectdef);
+        function  is_new_vmt_entry(pd:tprocdef):boolean;
+        procedure add_new_vmt_entry(pd:tprocdef);
         function  intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
         procedure intf_get_procdefs(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
         procedure intf_get_procdefs_recursive(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
@@ -135,28 +116,6 @@ implementation
        ;
 
 
-{*****************************************************************************
-                              TVMTSymEntry
-*****************************************************************************}
-
-    constructor tvmtsymentry.Create(AList:TFPHashObjectList;const AName:shortstring);
-      begin
-        inherited Create(AList,AName);
-        procdeflist:=TFPList.Create;
-      end;
-
-
-    destructor TVMTSymEntry.Destroy;
-      var
-        i : longint;
-      begin
-        for i:=0 to procdeflist.Count-1 do
-          Dispose(pprocdefentry(procdeflist[i]));
-        procdeflist.free;
-        inherited Destroy;
-      end;
-
-
 {*****************************************************************************
                               TVMTBuilder
 *****************************************************************************}
@@ -165,281 +124,199 @@ implementation
       begin
         inherited Create;
         _Class:=c;
-        VMTSymEntryList:=TFPHashObjectList.Create;
       end;
 
 
     destructor TVMTBuilder.destroy;
       begin
-        VMTSymEntryList.free;
       end;
 
 
-    procedure TVMTBuilder.add_new_vmt_entry(VMTSymEntry:TVMTSymEntry;pd:tprocdef);
+    procedure TVMTBuilder.add_new_vmt_entry(pd:tprocdef);
       var
-        procdefcoll : pprocdefentry;
         i : longint;
-        oldpd : tprocdef;
+        vmtentry : pvmtentry;
+        vmtpd : tprocdef;
       begin
-        if (_class=pd._class) then
-          begin
-            { new entry is needed, override was not possible }
-            if (po_overridingmethod in pd.procoptions) then
-              MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
+        { new entry is needed, override was not possible }
+        if (po_overridingmethod in pd.procoptions) then
+          MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
 
-            { check that all methods have overload directive }
-            if not(m_fpc in current_settings.modeswitches) then
+        { check that all methods have overload directive }
+        if not(m_fpc in current_settings.modeswitches) then
+          begin
+            for i:=0 to _class.vmtentries.count-1 do
               begin
-                for i:=0 to VMTSymentry.ProcdefList.Count-1 do
+                vmtentry:=pvmtentry(_class.vmtentries[i]);
+                vmtpd:=tprocdef(vmtentry^.procdef);
+                if (vmtpd.procsym=pd.procsym) and
+                   (not(po_overload in pd.procoptions) or
+                    not(po_overload in vmtpd.procoptions)) then
                   begin
-                    oldpd:=pprocdefentry(VMTSymentry.ProcdefList[i])^.data;
-                    if (oldpd._class=pd._class) and
-                       (not(po_overload in pd.procoptions) or
-                        not(po_overload in oldpd.procoptions)) then
-                      begin
-                        MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,pd.procsym.realname);
-                        { recover }
-                        include(oldpd.procoptions,po_overload);
-                        include(pd.procoptions,po_overload);
-                      end;
+                    MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,pd.procsym.realname);
+                    { recover }
+                    include(vmtpd.procoptions,po_overload);
+                    include(pd.procoptions,po_overload);
                   end;
               end;
           end;
 
-        { generate new entry }
-        new(procdefcoll);
-        procdefcoll^.data:=pd;
-        procdefcoll^.hidden:=false;
-        procdefcoll^.visible:=pd.is_visible_for_object(_class,nil);
-        VMTSymEntry.ProcdefList.Add(procdefcoll);
-
         { Register virtual method and give it a number }
         if (po_virtualmethod in pd.procoptions) then
           begin
-             if not assigned(_class.VMTEntries) then
-               _class.VMTEntries:=TFPObjectList.Create(false);
-             if pd.extnumber=$ffff then
-               pd.extnumber:=_class.VMTEntries.Count
-             else
-               begin
-                 if pd.extnumber<>_class.VMTEntries.Count then
-                   internalerror(200611081);
-               end;
-             _class.VMTEntries.Add(pd);
-             has_virtual_method:=true;
+             { store vmt entry number in procdef }
+             if (pd.extnumber<>$ffff) and
+                (pd.extnumber<>_class.VMTEntries.Count) then
+               internalerror(200810283);
+             pd.extnumber:=_class.VMTEntries.Count;
+             new(vmtentry);
+             vmtentry^.procdef:=pd;
+             vmtentry^.procdefderef.reset;
+             vmtentry^.visibility:=pd.visibility;
+             _class.VMTEntries.Add(vmtentry);
           end;
-
-        if (pd.proctypeoption=potype_constructor) then
-          has_constructor:=true;
       end;
 
 
-    function TVMTBuilder.is_new_vmt_entry(VMTSymEntry:TVMTSymEntry;pd:tprocdef):boolean;
+    function TVMTBuilder.is_new_vmt_entry(pd:tprocdef):boolean;
       const
         po_comp = [po_classmethod,po_virtualmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
                    po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
       var
         i : longint;
-        is_visible,
+        hasequalpara,
         hasoverloads,
         pdoverload : boolean;
-        procdefcoll : pprocdefentry;
+        vmtentry : pvmtentry;
+        vmtpd : tprocdef;
       begin
         result:=false;
-        { is this procdef visible from the class that we are
-          generating. This will be used to hide the other procdefs.
-          When the symbol is not visible we don't hide the other
-          procdefs, because they can be reused in the next class.
-          The check to skip the invisible methods that are in the
-          list is futher down in the code }
-        is_visible:=pd.is_visible_for_object(_class,nil);
         { Load other values for easier readability }
         hasoverloads:=(tprocsym(pd.procsym).ProcdefList.Count>1);
         pdoverload:=(po_overload in pd.procoptions);
 
         { compare with all stored definitions }
-        for i:=0 to VMTSymEntry.ProcdefList.Count-1 do
+        for i:=0 to _class.vmtentries.Count-1 do
           begin
-            procdefcoll:=pprocdefentry(VMTSymEntry.ProcdefList[i]);
-            { skip definitions that are already hidden }
-            if procdefcoll^.hidden then
+            vmtentry:=pvmtentry(_class.vmtentries[i]);
+            vmtpd:=tprocdef(vmtentry^.procdef);
+
+            { ignore hidden entries (e.g. virtual overridden by a static) that are not visible anymore }
+            if vmtentry^.visibility=vis_hidden then
               continue;
 
-            { check if one of the two methods has virtual }
-            if (po_virtualmethod in procdefcoll^.data.procoptions) or
-               (po_virtualmethod in pd.procoptions) then
+            { ignore different names }
+            if vmtpd.procsym.name<>pd.procsym.name then
+              continue;
+
+            { hide private methods that are not visible anymore. For this check we
+              must override the visibility with the highest value in the override chain.
+              This is required for case (see tw3292) with protected-private-protected where the
+              same vmtentry is used (PFV) }
+            if not is_visible_for_object(vmtpd.owner,vmtentry^.visibility,_class) then
+              continue;
+
+            { inherit overload }
+            if (po_overload in vmtpd.procoptions) then
               begin
-                { if the current definition has no virtual then hide the
-                  old virtual if the new definition has the same arguments or
-                  when it has no overload directive and no overloads }
-                if not(po_virtualmethod in pd.procoptions) then
+                include(pd.procoptions,po_overload);
+                pdoverload:=true;
+              end;
+
+            { compare parameter types only, no specifiers yet }
+            hasequalpara:=(compare_paras(vmtpd.paras,pd.paras,cp_none,[])>=te_equal);
+
+            { old definition has virtual
+              new definition has no virtual or override }
+            if (po_virtualmethod in vmtpd.procoptions) and
+               (
+                not(po_virtualmethod in pd.procoptions) or
+                { new one has not override }
+                (is_class_or_interface(_class) and not(po_overridingmethod in pd.procoptions))
+               ) then
+              begin
+                if (
+                    not(pdoverload or hasoverloads) or
+                    hasequalpara
+                   ) then
                   begin
-                    if procdefcoll^.visible and
-                       (
-                        not(pdoverload or hasoverloads) or
-                        (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)
-                       ) then
-                      begin
-                        if is_visible then
-                          procdefcoll^.hidden:=true;
-                        if (pd._class=procdefcoll^.data._class) then
-                           MessagePos(pd.fileinfo,parser_e_overloaded_have_same_parameters)
-                        else if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
-                          MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
-                      end;
-                  end
-                { if both are virtual we check the header }
-                else if (po_virtualmethod in pd.procoptions) and
-                        (po_virtualmethod in procdefcoll^.data.procoptions) then
+                    if not(po_reintroduce in pd.procoptions) then
+                      MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
+                    { disable/hide old VMT entry }
+                    vmtentry^.visibility:=vis_hidden;
+                  end;
+              end
+            { both are virtual? }
+            else if (po_virtualmethod in pd.procoptions) and
+                    (po_virtualmethod in vmtpd.procoptions) then
+              begin
+                { same parameter and return types (parameter specifiers will be checked below) }
+                if hasequalpara and
+                   compatible_childmethod_resultdef(vmtpd.returndef,pd.returndef) then
                   begin
-                    { new one has not override }
-                    if is_class_or_interface(_class) and
-                       not(po_overridingmethod in pd.procoptions) then
-                      begin
-                        { we start a new virtual tree, hide the old }
-                        if (not(pdoverload or hasoverloads) or
-                            (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) and
-                           (procdefcoll^.visible) then
-                          begin
-                            if is_visible then
-                              procdefcoll^.hidden:=true;
-                            if (pd._class=procdefcoll^.data._class) then
-                              MessagePos(pd.fileinfo,parser_e_overloaded_have_same_parameters)
-                            else if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
-                              MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
-                          end;
-                      end
-                    { same parameter and return types (parameter specifiers will be checked below) }
-                    else if (compare_paras(procdefcoll^.data.paras,pd.paras,cp_none,[])>=te_equal) and
-                            compatible_childmethod_resultdef(procdefcoll^.data.returndef,pd.returndef) then
+                    { inherite calling convention when it was explicit and the
+                      current definition has none explicit set }
+                    if (po_hascallingconvention in vmtpd.procoptions) and
+                       not(po_hascallingconvention in pd.procoptions) then
                       begin
-                        { overload is inherited }
-                        if (po_overload in procdefcoll^.data.procoptions) then
-                         include(pd.procoptions,po_overload);
-
-                        { inherite calling convention when it was force and the
-                          current definition has none force }
-                        if (po_hascallingconvention in procdefcoll^.data.procoptions) and
-                           not(po_hascallingconvention in pd.procoptions) then
-                          begin
-                            pd.proccalloption:=procdefcoll^.data.proccalloption;
-                            include(pd.procoptions,po_hascallingconvention);
-                          end;
-
-                        { All parameter specifiers and some procedure the flags have to match
-                          except abstract and override }
-                        if (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])<te_equal) or
-                           (procdefcoll^.data.proccalloption<>pd.proccalloption) or
-                           (procdefcoll^.data.proctypeoption<>pd.proctypeoption) or
-                           ((procdefcoll^.data.procoptions*po_comp)<>(pd.procoptions*po_comp)) then
-                           begin
-                             MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false));
-                             tprocsym(procdefcoll^.data.procsym).write_parameter_lists(pd);
-                           end;
-
-                        { check if the method to override is visible, check is only needed
-                          for the current parsed class. Parent classes are already validated and
-                          need to include all virtual methods including the ones not visible in the
-                          current class }
-                        if (_class=pd._class) and
-                           (po_overridingmethod in pd.procoptions) and
-                           (not procdefcoll^.visible) then
-                          MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
-
-                        { override old virtual method in VMT }
-                        if (procdefcoll^.data.extnumber>=_class.VMTEntries.Count) or
-                           (_class.VMTEntries[procdefcoll^.data.extnumber]<>procdefcoll^.data) then
-                          internalerror(200611084);
-                        _class.VMTEntries[procdefcoll^.data.extnumber]:=pd;
-                        pd.extnumber:=procdefcoll^.data.extnumber;
-                        procdefcoll^.data:=pd;
-                        if is_visible then
-                          procdefcoll^.visible:=true;
+                        pd.proccalloption:=vmtpd.proccalloption;
+                        include(pd.procoptions,po_hascallingconvention);
+                      end;
 
-                        exit;
-                      end
-                    { different parameters }
-                    else
-                     begin
-                       { when we got an override directive then can search futher for
-                         the procedure to override.
-                         If we are starting a new virtual tree then hide the old tree }
-                       if not(po_overridingmethod in pd.procoptions) and
-                          not (pdoverload or hasoverloads) then
-                        begin
-                          if is_visible then
-                            procdefcoll^.hidden:=true;
-                          if (pd._class=procdefcoll^.data._class) then
-                            MessagePos(pd.fileinfo,parser_e_overloaded_have_same_parameters)
-                          else if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
-                            if not is_object(_class) then
-                              MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
-                            else
-                              { objects don't allow starting a new virtual tree }
-                              MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,procdefcoll^.data.fullprocname(false));
-                        end;
-                     end;
+                    { All parameter specifiers and some procedure the flags have to match
+                      except abstract and override }
+                    if (compare_paras(vmtpd.paras,pd.paras,cp_all,[])<te_equal) or
+                       (vmtpd.proccalloption<>pd.proccalloption) or
+                       (vmtpd.proctypeoption<>pd.proctypeoption) or
+                       ((vmtpd.procoptions*po_comp)<>(pd.procoptions*po_comp)) then
+                       begin
+                         MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false));
+                         tprocsym(vmtpd.procsym).write_parameter_lists(pd);
+                       end;
+
+                    { Give a note if the new visibility is lower. For a higher
+                      visibility update the vmt info }
+                    if vmtentry^.visibility>pd.visibility then
+                      MessagePos4(pd.fileinfo,parser_n_ignore_lower_visibility,pd.fullprocname(false),
+                           visibilityname[pd.visibility],tobjectdef(vmtpd.owner.defowner).objrealname^,visibilityname[vmtentry^.visibility])
+                    else if pd.visibility>vmtentry^.visibility then
+                      vmtentry^.visibility:=pd.visibility;
+
+                    { override old virtual method in VMT }
+                    if (vmtpd.extnumber<>i) then
+                      internalerror(200611084);
+                    pd.extnumber:=vmtpd.extnumber;
+                    vmtentry^.procdef:=pd;
+                    exit;
                   end
+                { different parameters }
                 else
-                  begin
-                    { the new definition is virtual and the old static, we hide the old one
-                      if the new defintion has not the overload directive }
-                    if is_visible and
-                       (
-                        (not(pdoverload or hasoverloads)) or
-                        (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)
-                       ) then
-                      procdefcoll^.hidden:=true;
-                  end;
-              end
-            else
-              begin
-                { both are static, we hide the old one if the new defintion
-                  has not the overload directive }
-                if is_visible and
-                   (
-                    not(pdoverload or hasoverloads) or
-                    (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)
-                   ) then
-                  procdefcoll^.hidden:=true;
-               end;
+                 begin
+                   { when we got an override directive then can search futher for
+                     the procedure to override.
+                     If we are starting a new virtual tree then hide the old tree }
+                   if not(po_overridingmethod in pd.procoptions) and
+                      not(pdoverload or hasoverloads) then
+                     begin
+                       if not(po_reintroduce in pd.procoptions) then
+                         begin
+                           if not is_object(_class) then
+                             MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
+                           else
+                             { objects don't allow starting a new virtual tree }
+                             MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,vmtpd.fullprocname(false));
+                         end;
+                       { disable/hide old VMT entry }
+                       vmtentry^.visibility:=vis_hidden;
+                     end;
+                 end;
+              end;
           end;
         { No entry found, we need to create a new entry }
         result:=true;
       end;
 
 
-    procedure TVMTBuilder.add_vmt_entries(objdef:tobjectdef);
-      var
-         def : tdef;
-         pd  : tprocdef;
-         i   : longint;
-         VMTSymEntry : TVMTSymEntry;
-      begin
-        { start with the base class }
-        if assigned(objdef.childof) then
-          add_vmt_entries(objdef.childof);
-        { process all procdefs, we must process the defs to
-          keep the same order as that is written in the source
-          to be compatible with the indexes in the interface vtable (PFV) }
-        for i:=0 to objdef.symtable.DefList.Count-1 do
-          begin
-            def:=tdef(objdef.symtable.DefList[i]);
-            if def.typ=procdef then
-              begin
-                pd:=tprocdef(def);
-                { Find VMT procsym }
-                VMTSymEntry:=TVMTSymEntry(VMTSymEntryList.Find(pd.procsym.name));
-                if not assigned(VMTSymEntry) then
-                  VMTSymEntry:=TVMTSymEntry.Create(VMTSymEntryList,pd.procsym.name);
-                { VMT entry }
-                if is_new_vmt_entry(VMTSymEntry,pd) then
-                  add_new_vmt_entry(VMTSymEntry,pd);
-              end;
-          end;
-      end;
-
-
     function TVMTBuilder.intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
       const
         po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
@@ -666,16 +543,36 @@ implementation
     procedure TVMTBuilder.generate_vmt;
       var
         i : longint;
+        def : tdef;
         ImplIntf : TImplementedInterface;
+        old_current_objectdef : tobjectdef;
       begin
-        { Find VMT entries }
-        has_constructor:=false;
-        has_virtual_method:=false;
-        add_vmt_entries(_class);
-        if not(is_interface(_class)) and
-           has_virtual_method and
-           not(has_constructor) then
-          Message1(parser_w_virtual_without_constructor,_class.objrealname^);
+        old_current_objectdef:=current_objectdef;
+        current_objectdef:=_class;
+
+        _class.resetvmtentries;
+
+        { inherit (copy) VMT from parent object }
+        if assigned(_class.childof) then
+          begin
+            if not assigned(_class.childof.vmtentries) then
+              internalerror(200810281);
+            _class.copyvmtentries(_class.childof);
+          end;
+
+        { process all procdefs, we must process the defs to
+          keep the same order as that is written in the source
+          to be compatible with the indexes in the interface vtable (PFV) }
+        for i:=0 to _class.symtable.DefList.Count-1 do
+          begin
+            def:=tdef(_class.symtable.DefList[i]);
+            if def.typ=procdef then
+              begin
+                { VMT entry }
+                if is_new_vmt_entry(tprocdef(def)) then
+                  add_new_vmt_entry(tprocdef(def));
+              end;
+          end;
 
         { Find Procdefs implementing the interfaces }
         if assigned(_class.ImplementedInterfaces) then
@@ -691,6 +588,8 @@ implementation
             { Allocate interface tables }
             intf_allocate_vtbls;
           end;
+
+        current_objectdef:=old_current_objectdef;
       end;
 
 
@@ -1011,7 +910,7 @@ implementation
           begin
             pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
             if (pd.procsym=tsym(p)) and
-               (sp_published in pd.symoptions) then
+               (pd.visibility=vis_published) then
               inc(plongint(arg)^);
           end;
       end;
@@ -1029,7 +928,7 @@ implementation
           begin
             pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
             if (pd.procsym=tsym(p)) and
-               (sp_published in pd.symoptions) then
+               (pd.visibility=vis_published) then
               begin
                 current_asmdata.getdatalabel(l);
 
@@ -1092,8 +991,8 @@ implementation
         for i:=0 to _class.symtable.SymList.Count-1 do
           begin
             sym:=tsym(_class.symtable.SymList[i]);
-            if (tsym(sym).typ=fieldvarsym) and
-               (sp_published in tsym(sym).symoptions) then
+            if (sym.typ=fieldvarsym) and
+               (sym.visibility=vis_published) then
              begin
                 if tfieldvarsym(sym).vardef.typ<>objectdef then
                   internalerror(200611032);
@@ -1113,8 +1012,8 @@ implementation
         for i:=0 to _class.symtable.SymList.Count-1 do
           begin
             sym:=tsym(_class.symtable.SymList[i]);
-            if (tsym(sym).typ=fieldvarsym) and
-               (sp_published in tsym(sym).symoptions) then
+            if (sym.typ=fieldvarsym) and
+               (sym.visibility=vis_published) then
               begin
                 if (tf_requires_proper_alignment in target_info.flags) then
                   current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(pint)));
@@ -1294,7 +1193,8 @@ implementation
 
     procedure TVMTWriter.writevirtualmethods(List:TAsmList);
       var
-         pd : tprocdef;
+         vmtpd : tprocdef;
+         vmtentry : pvmtentry;
          i  : longint;
          procname : string;
 {$ifdef vtentry}
@@ -1305,24 +1205,23 @@ implementation
           exit;
         for i:=0 to _class.VMTEntries.Count-1 do
          begin
-           pd:=tprocdef(_class.VMTEntries[i]);
-           if not(po_virtualmethod in pd.procoptions) then
+           vmtentry:=pvmtentry(_class.vmtentries[i]);
+           vmtpd:=vmtentry^.procdef;
+           { safety checks }
+           if not(po_virtualmethod in vmtpd.procoptions) then
              internalerror(200611082);
-           if pd.extnumber<>i then
+           if vmtpd.extnumber<>i then
              internalerror(200611083);
-           if (po_abstractmethod in pd.procoptions) then
+           if (po_abstractmethod in vmtpd.procoptions) then
              procname:='FPC_ABSTRACTERROR'
            else
-             procname:=pd.mangledname;
+             procname:=vmtpd.mangledname;
            List.concat(Tai_const.createname(procname,0));
 {$ifdef vtentry}
            hs:='VTENTRY'+'_'+_class.vmt_mangledname+'$$'+tostr(_class.vmtmethodoffset(i) div sizeof(pint));
            current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0));
 {$endif vtentry}
          end;
-        { release VMTEntries, we don't need them anymore }
-        _class.VMTEntries.free;
-        _class.VMTEntries:=nil;
       end;
 
 

compiler/nutils.pas

@@ -474,9 +474,9 @@ implementation
         result:=internalstatements(newstatement);
 
         { call fail helper and exit normal }
-        if is_class(current_procinfo.procdef._class) then
+        if is_class(current_objectdef) then
           begin
-            srsym:=search_class_member(current_procinfo.procdef._class,'FREEINSTANCE');
+            srsym:=search_class_member(current_objectdef,'FREEINSTANCE');
             if assigned(srsym) and
                (srsym.typ=procsym) then
               begin
@@ -496,13 +496,13 @@ implementation
               internalerror(200305108);
           end
         else
-          if is_object(current_procinfo.procdef._class) then
+          if is_object(current_objectdef) then
             begin
               { parameter 3 : vmt_offset }
               { parameter 2 : pointer to vmt }
               { parameter 1 : self pointer }
               para:=ccallparanode.create(
-                        cordconstnode.create(current_procinfo.procdef._class.vmt_offset,s32inttype,false),
+                        cordconstnode.create(current_objectdef.vmt_offset,s32inttype,false),
                     ccallparanode.create(
                         ctypeconvnode.create_internal(
                             load_vmt_pointer_node,

compiler/optloop.pas

@@ -393,8 +393,7 @@ unit optloop;
 
     function OptimizeInductionVariablesSingleForLoop(node : tnode) : tnode;
       var
-        loopcode,
-        newcode : tblocknode;
+        loopcode : tblocknode;
         loopcodestatements,
         newcodestatements : tstatementnode;
         fornode : tfornode;

compiler/parser.pas

@@ -42,7 +42,7 @@ implementation
 {$ENDIF}
       cutils,cclasses,
       globtype,version,tokens,systems,globals,verbose,switches,
-      symbase,symtable,symsym,
+      symbase,symtable,symdef,symsym,
       finput,fmodule,fppu,
       aasmbase,aasmtai,aasmdata,
       cgbase,
@@ -64,6 +64,7 @@ implementation
          current_module:=nil;
          current_asmdata:=nil;
          current_procinfo:=nil;
+         current_objectdef:=nil;
 
          loaded_units:=TLinkedList.Create;
 
@@ -133,6 +134,7 @@ implementation
          current_module:=nil;
          current_procinfo:=nil;
          current_asmdata:=nil;
+         current_objectdef:=nil;
 
          { unload units }
          if assigned(loaded_units) then
@@ -284,6 +286,11 @@ implementation
          olddata : polddata;
          hp,hp2 : tmodule;
        begin
+         { parsing a procedure or declaration should be finished }
+         if assigned(current_procinfo) then
+           internalerror(200811121);
+         if assigned(current_objectdef) then
+           internalerror(200811122);
          inc(compile_level);
          parser_current_file:=filename;
          { Uses heap memory instead of placing everything on the

compiler/pdecobj.pas

@@ -30,7 +30,7 @@ interface
       globtype,symconst,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
 
 implementation
 
@@ -400,9 +400,9 @@ implementation
         parse_generic:=(df_generic in current_objectdef.defoptions);
         { in "publishable" classes the default access type is published }
         if (oo_can_have_published in current_objectdef.objectoptions) then
-          current_object_option:=[sp_published]
+          current_objectdef.symtable.currentvisibility:=vis_published
         else
-          current_object_option:=[sp_public];
+          current_objectdef.symtable.currentvisibility:=vis_public;
         testcurobject:=1;
         has_destructor:=false;
         object_member_blocktype:=bt_general;
@@ -430,7 +430,7 @@ implementation
                       if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PRIVATE);
-                       current_object_option:=[sp_private];
+                       current_objectdef.symtable.currentvisibility:=vis_private;
                        include(current_objectdef.objectoptions,oo_has_private);
                      end;
                    _PROTECTED :
@@ -438,7 +438,7 @@ implementation
                        if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PROTECTED);
-                       current_object_option:=[sp_protected];
+                       current_objectdef.symtable.currentvisibility:=vis_protected;
                        include(current_objectdef.objectoptions,oo_has_protected);
                      end;
                    _PUBLIC :
@@ -446,7 +446,7 @@ implementation
                        if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PUBLIC);
-                       current_object_option:=[sp_public];
+                       current_objectdef.symtable.currentvisibility:=vis_public;
                      end;
                    _PUBLISHED :
                      begin
@@ -456,7 +456,7 @@ implementation
                        if is_interface(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PUBLISHED);
-                       current_object_option:=[sp_published];
+                       current_objectdef.symtable.currentvisibility:=vis_published;
                      end;
                    _STRICT :
                      begin
@@ -469,13 +469,13 @@ implementation
                               _PRIVATE:
                                 begin
                                   consume(_PRIVATE);
-                                  current_object_option:=[sp_strictprivate];
+                                  current_objectdef.symtable.currentvisibility:=vis_strictprivate;
                                   include(current_objectdef.objectoptions,oo_has_strictprivate);
                                 end;
                               _PROTECTED:
                                 begin
                                   consume(_PROTECTED);
-                                  current_object_option:=[sp_strictprotected];
+                                  current_objectdef.symtable.currentvisibility:=vis_strictprotected;
                                   include(current_objectdef.objectoptions,oo_has_strictprotected);
                                 end;
                               else
@@ -492,8 +492,8 @@ implementation
                             if is_interface(current_objectdef) then
                               Message(parser_e_no_vars_in_interfaces);
 
-                            if (sp_published in current_object_option) and
-                              not(oo_can_have_published in current_objectdef.objectoptions) then
+                            if (current_objectdef.symtable.currentvisibility=vis_published) and
+                               not(oo_can_have_published in current_objectdef.objectoptions) then
                               Message(parser_e_cant_have_published);
 
                             read_record_fields([vd_object])
@@ -511,7 +511,7 @@ implementation
             _FUNCTION,
             _CLASS :
               begin
-                if (sp_published in current_object_option) and
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
                    not(oo_can_have_published in current_objectdef.objectoptions) then
                   Message(parser_e_cant_have_published);
 
@@ -554,12 +554,11 @@ implementation
               end;
             _CONSTRUCTOR :
               begin
-                if (sp_published in current_object_option) and
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
                   not(oo_can_have_published in current_objectdef.objectoptions) then
                   Message(parser_e_cant_have_published);
 
-                if not(sp_public in current_object_option) and
-                   not(sp_published in current_object_option) then
+                if not(current_objectdef.symtable.currentvisibility in [vis_public,vis_published]) then
                   Message(parser_w_constructor_should_be_public);
 
                 if is_interface(current_objectdef) then
@@ -584,7 +583,7 @@ implementation
               end;
             _DESTRUCTOR :
               begin
-                if (sp_published in current_object_option) and
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
                    not(oo_can_have_published in current_objectdef.objectoptions) then
                   Message(parser_e_cant_have_published);
 
@@ -595,7 +594,7 @@ implementation
                 if is_interface(current_objectdef) then
                   Message(parser_e_no_con_des_in_interfaces);
 
-                if not(sp_public in current_object_option) then
+                if (current_objectdef.symtable.currentvisibility<>vis_public) then
                   Message(parser_w_destructor_should_be_public);
 
                 oldparse_only:=parse_only;
@@ -632,14 +631,10 @@ implementation
       end;
 
 
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
-      label
-        myexit;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
       var
-        old_object_option : tsymoptions;
         old_current_objectdef : tobjectdef;
       begin
-        old_object_option:=current_object_option;
         old_current_objectdef:=current_objectdef;
 
         current_objectdef:=nil;
@@ -725,16 +720,18 @@ implementation
            ) then
           current_objectdef.insertvmt;
 
+        if (oo_has_vmt in current_objectdef.objectoptions) and
+           not(oo_has_constructor in current_objectdef.objectoptions) then
+          Message1(parser_w_virtual_without_constructor,current_objectdef.objrealname^);
+
         if is_interface(current_objectdef) then
           setinterfacemethodoptions;
 
         { return defined objectdef }
         result:=current_objectdef;
 
-      myexit:
         { restore old state }
         current_objectdef:=old_current_objectdef;
-        current_object_option:=old_object_option;
       end;
 
 end.

compiler/pdecsub.pas

@@ -108,7 +108,6 @@ implementation
              paranr:=paranr_result;
            { Generate result variable accessing function result }
            vs:=tparavarsym.create('$result',paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
-           vs.symoptions:=[sp_public];
            pd.parast.insert(vs);
            { Store the this symbol as funcretsym for procedures }
            if pd.typ=procdef then
@@ -136,7 +135,6 @@ implementation
             vs:=tparavarsym.create('$parentfp',paranr_parentfp,vs_value
                   ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
             vs.varregable:=vr_none;
-            vs.symoptions:=[sp_public];
             pd.parast.insert(vs);
 
             current_tokenpos:=storepos;
@@ -156,7 +154,6 @@ implementation
           begin
             { Generate self variable }
             vs:=tparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
-            vs.symoptions:=[sp_public];
             pd.parast.insert(vs);
           end
         else
@@ -179,7 +176,6 @@ implementation
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
                    vs:=tparavarsym.create('$vmt',paranr_vmt,vs_value,voidpointertype,[vo_is_vmt,vo_is_hidden_para]);
-                   vs.symoptions:=[sp_public];
                    pd.parast.insert(vs);
                  end;
 
@@ -197,7 +193,6 @@ implementation
                     hdef:=tprocdef(pd)._class;
                   end;
                 vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
-                vs.symoptions:=[sp_public];
                 pd.parast.insert(vs);
 
                 current_tokenpos:=storepos;
@@ -282,7 +277,7 @@ implementation
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
              begin
                hvs:=tparavarsym.create('$high'+name,paranr+1,vs_const,sinttype,[vo_is_high_para,vo_is_hidden_para]);
-               hvs.symoptions:=[sp_public];
+               hvs.symoptions:=[];
                owner.insert(hvs);
              end
            else
@@ -382,7 +377,6 @@ implementation
         varspez : Tvarspez;
         defaultvalue : tconstsym;
         defaultrequired : boolean;
-        old_object_option : tsymoptions;
         old_block_type : tblock_type;
         currparast : tparasymtable;
         parseprocvar : tppv;
@@ -391,7 +385,6 @@ implementation
         paranr : integer;
         dummytype : ttypesym;
       begin
-        old_object_option:=current_object_option;
         old_block_type:=block_type;
         explicit_paraloc:=false;
         consume(_LKLAMMER);
@@ -406,8 +399,6 @@ implementation
         sc:=TFPObjectList.create(false);
         defaultrequired:=false;
         paranr:=0;
-        { the variables are always public }
-        current_object_option:=[sp_public];
         inc(testcurobject);
         block_type:=bt_var;
         repeat
@@ -618,7 +609,6 @@ implementation
         sc.free;
         { reset object options }
         dec(testcurobject);
-        current_object_option:=old_object_option;
         block_type:=old_block_type;
         consume(_RKLAMMER);
       end;
@@ -873,7 +863,7 @@ implementation
 
         { symbol options that need to be kept per procdef }
         pd.fileinfo:=procstartfilepos;
-        pd.symoptions:=current_object_option;
+        pd.visibility:=symtablestack.top.currentvisibility;
 
         { parse parameters }
         if token=_LKLAMMER then
@@ -1070,6 +1060,8 @@ implementation
               parse_proc_head(aclass,potype_operator,pd);
               if assigned(pd) then
                 begin
+                  { operators always need to be searched in all units }
+                  include(pd.procoptions,po_overload);
                   if pd.parast.symtablelevel>normal_function_level then
                     Message(parser_e_no_local_operator);
                   if token<>_ID then

compiler/pdecvar.pas

@@ -91,14 +91,14 @@ implementation
                   case sym.typ of
                     fieldvarsym :
                       begin
-                        if not(sp_private in current_object_option) then
+                        if (symtablestack.top.currentvisibility<>vis_private) then
                           addsymref(sym);
                         pl.addsym(sl_load,sym);
                         def:=tfieldvarsym(sym).vardef;
                       end;
                     procsym :
                       begin
-                        if not(sp_private in current_object_option) then
+                        if (symtablestack.top.currentvisibility<>vis_private) then
                           addsymref(sym);
                         pl.addsym(sl_call,sym);
                       end;
@@ -284,12 +284,14 @@ implementation
            end;
          { Generate propertysym and insert in symtablestack }
          p:=tpropertysym.create(orgpattern);
+         p.visibility:=symtablestack.top.currentvisibility;
+         p.default:=longint($80000000);
          symtablestack.top.insert(p);
          consume(_ID);
          { property parameters ? }
          if try_to_consume(_LECKKLAMMER) then
            begin
-              if (sp_published in current_object_option) and
+              if (p.visibility=vis_published) and
                 not (m_delphi in current_settings.modeswitches) then
                 Message(parser_e_cant_publish_that_property);
               { create a list of the parameters }
@@ -414,9 +416,12 @@ implementation
                   message(parser_e_no_property_found_to_override);
                 end;
            end;
-         if ((sp_published in current_object_option) or is_dispinterface(aclass)) and
+         if ((p.visibility=vis_published) or is_dispinterface(aclass)) and
             not(p.propdef.is_publishable) then
-           Message(parser_e_cant_publish_that_property);
+           begin
+             Message(parser_e_cant_publish_that_property);
+             p.visibility:=vis_public;
+           end;
 
          if not(is_dispinterface(aclass)) then
            begin
@@ -628,12 +633,13 @@ implementation
          else if try_to_consume(_NODEFAULT) then
            begin
               p.default:=longint($80000000);
-           end
-         else if allow_default_property(p) then
+           end;
+(*
+         else {if allow_default_property(p) then
            begin
               p.default:=longint($80000000);
            end;
-
+*)
          { Parse possible "implements" keyword }
          if try_to_consume(_IMPLEMENTS) then
            begin
@@ -1057,13 +1063,9 @@ implementation
          semicoloneaten,
          allowdefaultvalue,
          hasdefaultvalue : boolean;
-         old_current_object_option : tsymoptions;
          hintsymoptions  : tsymoptions;
          old_block_type  : tblock_type;
       begin
-         old_current_object_option:=current_object_option;
-         { all variables are public if not in a object declaration }
-         current_object_option:=[sp_public];
          old_block_type:=block_type;
          block_type:=bt_var;
          { Force an expected ID error message }
@@ -1211,7 +1213,6 @@ implementation
                end;
            end;
          block_type:=old_block_type;
-         current_object_option:=old_current_object_option;
          { free the list }
          sc.free;
       end;
@@ -1221,7 +1222,6 @@ implementation
       var
          sc : TFPObjectList;
          i  : longint;
-         old_current_object_option : tsymoptions;
          hs,sorg : string;
          hdef,casetype : tdef;
          { maxsize contains the max. size of a variant }
@@ -1236,6 +1236,7 @@ implementation
          vs    : tabstractvarsym;
          srsym : tsym;
          srsymtable : TSymtable;
+         visibility : tvisibility;
          recst : tabstractrecordsymtable;
          unionsymtable : trecordsymtable;
          offset : longint;
@@ -1257,10 +1258,6 @@ implementation
 {$if defined(powerpc) or defined(powerpc64)}
          is_first_type:=true;
 {$endif powerpc or powerpc64}
-         old_current_object_option:=current_object_option;
-         { all variables are public if not in a object declaration }
-         if not(vd_object in options) then
-          current_object_option:=[sp_public];
          { Force an expected ID error message }
          if not (token in [_ID,_CASE,_END]) then
           consume(_ID);
@@ -1270,6 +1267,7 @@ implementation
             not((vd_object in options) and
                 (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do
            begin
+             visibility:=symtablestack.top.currentvisibility;
              semicoloneaten:=false;
              sc.clear;
              repeat
@@ -1385,26 +1383,19 @@ implementation
                  consume(_SEMICOLON);
                end;
 
-             if (sp_published in current_object_option) and
+             if (visibility=vis_published) and
                 not(is_class(hdef)) then
                begin
                  Message(parser_e_cant_publish_that);
-                 exclude(current_object_option,sp_published);
-                 { recover by changing access type to public }
-                 for i:=0 to sc.count-1 do
-                   begin
-                     fieldvs:=tfieldvarsym(sc[i]);
-                     exclude(fieldvs.symoptions,sp_published);
-                     include(fieldvs.symoptions,sp_public);
-                   end;
-               end
-             else
-              if (sp_published in current_object_option) and
-                 not(oo_can_have_published in tobjectdef(hdef).objectoptions) and
-                 not(m_delphi in current_settings.modeswitches) then
+                 visibility:=vis_public;
+               end;
+
+             if (visibility=vis_published) and
+                not(oo_can_have_published in tobjectdef(hdef).objectoptions) and
+                not(m_delphi in current_settings.modeswitches) then
                begin
                  Message(parser_e_only_publishable_classes_can_be_published);
-                 exclude(current_object_option,sp_published);
+                 visibility:=vis_public;
                end;
 
              { Generate field in the recordsymtable }
@@ -1412,13 +1403,9 @@ implementation
                begin
                  fieldvs:=tfieldvarsym(sc[i]);
                  { static data fields are already inserted in the globalsymtable }
-                 if not(sp_static in current_object_option) then
-                   recst.addfield(fieldvs);
+                 if not(sp_static in fieldvs.symoptions) then
+                   recst.addfield(fieldvs,visibility);
                end;
-
-             { restore current_object_option, it can be changed for
-               publishing or static }
-             current_object_option:=old_current_object_option;
            end;
 
          { Check for Case }
@@ -1452,7 +1439,7 @@ implementation
                    end;
 {$endif support_llvm}
                   fieldvs.vardef:=casetype;
-                  recst.addfield(fieldvs);
+                  recst.addfield(fieldvs,recst.currentvisibility);
                 end;
               if not(is_ordinal(casetype))
 {$ifndef cpu64bitaddr}
@@ -1542,7 +1529,6 @@ implementation
               trecordsymtable(recst).insertunionst(Unionsymtable,offset);
               uniondef.owner.deletedef(uniondef);
            end;
-         current_object_option:=old_current_object_option;
          { free the list }
          sc.free;
 {$ifdef powerpc}

compiler/pexpr.pas

@@ -1410,15 +1410,14 @@ implementation
                            is_object(hdef) then
                          begin
                            consume(_POINT);
-                           if assigned(current_procinfo) and
-                              assigned(current_procinfo.procdef._class) and
+                           if assigned(current_objectdef) and
                               not(getaddr) then
                             begin
-                              if current_procinfo.procdef._class.is_related(tobjectdef(hdef)) then
+                              if current_objectdef.is_related(tobjectdef(hdef)) then
                                begin
                                  p1:=ctypenode.create(hdef);
                                  { search also in inherited methods }
-                                 searchsym_in_class(tobjectdef(hdef),current_procinfo.procdef._class,pattern,srsym,srsymtable);
+                                 searchsym_in_class(tobjectdef(hdef),current_objectdef,pattern,srsym,srsymtable);
                                  if assigned(srsym) then
                                    check_hints(srsym,srsym.symoptions);
                                  consume(_ID);
@@ -2160,8 +2159,7 @@ implementation
            { Handle references to self }
            if (idtoken=_SELF) and
               not(block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) and
-              assigned(current_procinfo) and
-              assigned(current_procinfo.procdef._class) then
+              assigned(current_objectdef) then
              begin
                p1:=load_self_node;
                consume(_ID);
@@ -2198,9 +2196,9 @@ implementation
                again:=true;
                consume(_INHERITED);
                if assigned(current_procinfo) and
-                  assigned(current_procinfo.procdef._class) then
+                  assigned(current_objectdef) then
                 begin
-                  hclassdef:=current_procinfo.procdef._class.childof;
+                  hclassdef:=current_objectdef.childof;
                   { if inherited; only then we need the method with
                     the same name }
                   if token in endtokens then
@@ -2218,7 +2216,7 @@ implementation
                       if (po_msgstr in pd.procoptions) then
                         searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
                      else
-                       searchsym_in_class(hclassdef,current_procinfo.procdef._class,hs,srsym,srsymtable);
+                       searchsym_in_class(hclassdef,current_objectdef,hs,srsym,srsymtable);
                    end
                   else
                    begin
@@ -2226,7 +2224,7 @@ implementation
                      hsorg:=orgpattern;
                      consume(_ID);
                      anon_inherited:=false;
-                     searchsym_in_class(hclassdef,current_procinfo.procdef._class,hs,srsym,srsymtable);
+                     searchsym_in_class(hclassdef,current_objectdef,hs,srsym,srsymtable);
                    end;
                   if assigned(srsym) then
                    begin

compiler/pinline.pas

@@ -430,7 +430,7 @@ implementation
             { search the constructor also in the symbol tables of
               the parents }
             afterassignment:=false;
-            searchsym_in_class(classh,nil,pattern,srsym,srsymtable);
+            searchsym_in_class(classh,classh,pattern,srsym,srsymtable);
             consume(_ID);
             do_member_read(classh,false,srsym,p1,again,[cnf_new_call]);
             { we need to know which procedure is called }

compiler/pmodules.pas

@@ -1153,15 +1153,12 @@ implementation
              tstoredsymtable(current_module.globalsymtable).check_forwards;
              { check if all private fields are used }
              tstoredsymtable(current_module.globalsymtable).allprivatesused;
-             { remove cross unit overloads }
-             tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
 
              { test static symtable }
              tstoredsymtable(current_module.localsymtable).allsymbolsused;
              tstoredsymtable(current_module.localsymtable).allprivatesused;
              tstoredsymtable(current_module.localsymtable).check_forwards;
              tstoredsymtable(current_module.localsymtable).checklabels;
-             tstoredsymtable(current_module.localsymtable).unchain_overloaded;
 
              { used units }
              current_module.allunitsused;
@@ -1248,10 +1245,7 @@ implementation
              Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
 {$endif EXTDEBUG}
 
-         { release all overload references and local symtables that
-           are not needed anymore }
-         tstoredsymtable(current_module.localsymtable).unchain_overloaded;
-         tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
+         { release local symtables that are not needed anymore }
          free_localsymtables(current_module.globalsymtable);
          free_localsymtables(current_module.localsymtable);
 
@@ -1682,7 +1676,6 @@ implementation
              tstoredsymtable(current_module.localsymtable).allsymbolsused;
              tstoredsymtable(current_module.localsymtable).allprivatesused;
              tstoredsymtable(current_module.localsymtable).check_forwards;
-             tstoredsymtable(current_module.localsymtable).unchain_overloaded;
 
              current_module.allunitsused;
            end;
@@ -2059,7 +2052,6 @@ implementation
              tstoredsymtable(current_module.localsymtable).allsymbolsused;
              tstoredsymtable(current_module.localsymtable).allprivatesused;
              tstoredsymtable(current_module.localsymtable).check_forwards;
-             tstoredsymtable(current_module.localsymtable).unchain_overloaded;
 
              current_module.allunitsused;
            end;

compiler/ppcarm.lpi

@@ -2,7 +2,7 @@
 <CONFIG>
   <ProjectOptions>
     <PathDelim Value="\"/>
-    <Version Value="5"/>
+    <Version Value="6"/>
     <General>
       <Flags>
         <MainUnitHasUsesSectionForAllUnits Value="False"/>
@@ -26,7 +26,7 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <Units Count="2">
+    <Units Count="4">
       <Unit0>
         <Filename Value="pp.pas"/>
         <IsPartOfProject Value="True"/>
@@ -37,10 +37,19 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="aasmcpu"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="arm\aoptcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="aoptcpu"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="aopt.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="8"/>
     <PathDelim Value="\"/>
     <Target>
       <Filename Value="arm\pp"/>
@@ -52,7 +61,6 @@
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
-        <D2Extensions Value="False"/>
         <CStyleOperator Value="False"/>
         <AllowLabel Value="False"/>
         <CPPInline Value="False"/>

compiler/ppcgen/agppcgas.pas

@@ -132,14 +132,18 @@ unit agppcgas;
 	       s := s + ')@got';
 {$endif cpu64bitaddr}
 
-           if (index=NR_NO) and (base<>NR_NO) then
+           if (index=NR_NO) then
              begin
                 if offset=0 then
                   begin
                     if not (assigned(symbol)) then
                       s:=s+'0';
                   end;
-                s:=s+'('+gas_regname(base)+')';
+                if (base<>NR_NO) then
+                  s:=s+'('+gas_regname(base)+')'
+                else if not assigned(symbol) and
+                        not(refaddr in verbose_refaddrs) then
+                  s:=s+'(0)';
              end
            else if (index<>NR_NO) and (base<>NR_NO) then
              begin

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 93;
+  CurrentPPUVersion = 94;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/psub.pas

@@ -105,7 +105,7 @@ implementation
        ncgutil,regvars,
        optbase,
        opttail,
-       optcse,
+       optcse,optloop,
        optutils
 {$if defined(arm) or defined(powerpc) or defined(powerpc64)}
        ,aasmcpu
@@ -266,19 +266,18 @@ implementation
         srsym        : tsym;
         para         : tcallparanode;
         newstatement : tstatementnode;
-        hdef         : tdef;
       begin
         result:=internalstatements(newstatement);
 
-        if assigned(current_procinfo.procdef._class) then
+        if assigned(current_objectdef) then
           begin
             { a constructor needs a help procedure }
             if (current_procinfo.procdef.proctypeoption=potype_constructor) then
               begin
-                if is_class(current_procinfo.procdef._class) then
+                if is_class(current_objectdef) then
                   begin
                     include(current_procinfo.flags,pi_needs_implicit_finally);
-                    srsym:=search_class_member(current_procinfo.procdef._class,'NEWINSTANCE');
+                    srsym:=search_class_member(current_objectdef,'NEWINSTANCE');
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
                       begin
@@ -300,17 +299,15 @@ implementation
                       internalerror(200305108);
                   end
                 else
-                  if is_object(current_procinfo.procdef._class) then
+                  if is_object(current_objectdef) then
                     begin
-                      hdef:=current_procinfo.procdef._class;
-                      hdef:=tpointerdef.create(hdef);
                       { parameter 3 : vmt_offset }
                       { parameter 2 : address of pointer to vmt,
                         this is required to allow setting the vmt to -1 to indicate
                         that memory was allocated }
                       { parameter 1 : self pointer }
                       para:=ccallparanode.create(
-                                cordconstnode.create(current_procinfo.procdef._class.vmt_offset,s32inttype,false),
+                                cordconstnode.create(current_objectdef.vmt_offset,s32inttype,false),
                             ccallparanode.create(
                                 ctypeconvnode.create_internal(
                                     load_vmt_pointer_node,
@@ -341,9 +338,9 @@ implementation
 
             { maybe call BeforeDestruction for classes }
             if (current_procinfo.procdef.proctypeoption=potype_destructor) and
-               is_class(current_procinfo.procdef._class) then
+               is_class(current_objectdef) then
               begin
-                srsym:=search_class_member(current_procinfo.procdef._class,'BEFOREDESTRUCTION');
+                srsym:=search_class_member(current_objectdef,'BEFOREDESTRUCTION');
                 if assigned(srsym) and
                    (srsym.typ=procsym) then
                   begin
@@ -373,7 +370,7 @@ implementation
       begin
         result:=internalstatements(newstatement);
 
-        if assigned(current_procinfo.procdef._class) then
+        if assigned(current_objectdef) then
           begin
             { Don't test self and the vmt here. The reason is that  }
             { a constructor already checks whether these are valid  }
@@ -384,9 +381,9 @@ implementation
             current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range];
             { maybe call AfterConstruction for classes }
             if (current_procinfo.procdef.proctypeoption=potype_constructor) and
-               is_class(current_procinfo.procdef._class) then
+               is_class(current_objectdef) then
               begin
-                srsym:=search_class_member(current_procinfo.procdef._class,'AFTERCONSTRUCTION');
+                srsym:=search_class_member(current_objectdef,'AFTERCONSTRUCTION');
                 if assigned(srsym) and
                    (srsym.typ=procsym) then
                   begin
@@ -410,9 +407,9 @@ implementation
             { a destructor needs a help procedure }
             if (current_procinfo.procdef.proctypeoption=potype_destructor) then
               begin
-                if is_class(current_procinfo.procdef._class) then
+                if is_class(current_objectdef) then
                   begin
-                    srsym:=search_class_member(current_procinfo.procdef._class,'FREEINSTANCE');
+                    srsym:=search_class_member(current_objectdef,'FREEINSTANCE');
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
                       begin
@@ -434,16 +431,16 @@ implementation
                       internalerror(200305108);
                   end
                 else
-                  if is_object(current_procinfo.procdef._class) then
+                  if is_object(current_objectdef) then
                     begin
                       { finalize object data }
-                      if current_procinfo.procdef._class.needs_inittable then
+                      if current_objectdef.needs_inittable then
                         addstatement(newstatement,finalize_data_node(load_self_node));
                       { parameter 3 : vmt_offset }
                       { parameter 2 : pointer to vmt }
                       { parameter 1 : self pointer }
                       para:=ccallparanode.create(
-                                cordconstnode.create(current_procinfo.procdef._class.vmt_offset,s32inttype,false),
+                                cordconstnode.create(current_objectdef.vmt_offset,s32inttype,false),
                             ccallparanode.create(
                                 ctypeconvnode.create_internal(
                                     load_vmt_pointer_node,
@@ -474,14 +471,14 @@ implementation
 
         { a constructor needs call destructor (if available) when it
           is not inherited }
-        if assigned(current_procinfo.procdef._class) and
+        if assigned(current_objectdef) and
            (current_procinfo.procdef.proctypeoption=potype_constructor) then
           begin
             { Don't test self and the vmt here. See generate_bodyexit_block }
             { why (JM)                                                      }
             oldlocalswitches:=current_settings.localswitches;
             current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range];
-            pd:=current_procinfo.procdef._class.Finddestructor;
+            pd:=current_objectdef.Finddestructor;
             if assigned(pd) then
               begin
                 { if vmt<>0 then call destructor }
@@ -691,13 +688,15 @@ implementation
 
     procedure tcgprocinfo.generate_code;
       var
-        oldprocinfo : tprocinfo;
+        old_current_procinfo : tprocinfo;
         oldmaxfpuregisters : longint;
         oldfilepos : tfileposinfo;
+        old_current_objectdef : tobjectdef;
         templist : TAsmList;
         headertai : tai;
         i : integer;
         varsym : tabstractnormalvarsym;
+        RedoDFA : boolean;
       begin
         { the initialization procedure can be empty, then we
           don't need to generate anything. When it was an empty
@@ -717,12 +716,14 @@ implementation
         if assigned(tg) then
           internalerror(200309201);
 
-        oldprocinfo:=current_procinfo;
+        old_current_procinfo:=current_procinfo;
         oldfilepos:=current_filepos;
+        old_current_objectdef:=current_objectdef;
         oldmaxfpuregisters:=current_settings.maxfpuregisters;
 
         current_procinfo:=self;
         current_filepos:=entrypos;
+        current_objectdef:=procdef._class;
 
         templist:=TAsmList.create;
 
@@ -767,8 +768,7 @@ implementation
         if (cs_opt_nodedfa in current_settings.optimizerswitches) and
           { creating dfa is not always possible }
           ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler,
-                  pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter,
-                  pi_needs_stackframe])=[]) then
+                  pi_needs_implicit_finally,pi_has_implicit_finally])=[]) then
           begin
             dfabuilder:=TDFABuilder.Create;
             dfabuilder.createdfainfo(code);
@@ -799,6 +799,15 @@ implementation
                       end;
                   end;
               end;
+            include(flags,pi_dfaavailable);
+          end;
+
+        if (cs_opt_loopstrength in current_settings.optimizerswitches)
+          { our induction variable strength reduction doesn't like
+            for loops with more than one entry }
+          and not(pi_has_goto in current_procinfo.flags) then
+          begin
+            RedoDFA:=OptimizeInductionVariables(code);
           end;
 
         if cs_opt_nodecse in current_settings.optimizerswitches then
@@ -1139,7 +1148,8 @@ implementation
         templist.free;
         current_settings.maxfpuregisters:=oldmaxfpuregisters;
         current_filepos:=oldfilepos;
-        current_procinfo:=oldprocinfo;
+        current_objectdef:=old_current_objectdef;
+        current_procinfo:=old_current_procinfo;
       end;
 
 
@@ -1266,21 +1276,22 @@ implementation
 
     procedure tcgprocinfo.parse_body;
       var
-         oldprocinfo : tprocinfo;
-         oldblock_type : tblock_type;
+         old_current_procinfo : tprocinfo;
+         old_block_type : tblock_type;
          st : TSymtable;
+         old_current_objectdef : tobjectdef;
       begin
-         oldprocinfo:=current_procinfo;
-         oldblock_type:=block_type;
-
-         { reset break and continue labels }
-         block_type:=bt_body;
+         old_current_procinfo:=current_procinfo;
+         old_block_type:=block_type;
+         old_current_objectdef:=current_objectdef;
 
          current_procinfo:=self;
+         current_objectdef:=procdef._class;
 
          { calculate the lexical level }
          if procdef.parast.symtablelevel>maxnesting then
            Message(parser_e_too_much_lexlevel);
+         block_type:=bt_body;
 
     {$ifdef state_tracking}
 {    aktstate:=Tstate_storage.create;}
@@ -1347,8 +1358,6 @@ implementation
              tstoredsymtable(procdef.localst).check_forwards;
              { check if all labels are used }
              tstoredsymtable(procdef.localst).checklabels;
-             { remove cross unit overloads }
-             tstoredsymtable(procdef.localst).unchain_overloaded;
              { check for unused symbols, but only if there is no asm block }
              if not(pi_has_assembler_block in flags) then
                begin
@@ -1383,10 +1392,11 @@ implementation
 {    aktstate.destroy;}
     {$endif state_tracking}
 
-         current_procinfo:=oldprocinfo;
+         current_objectdef:=old_current_objectdef;
+         current_procinfo:=old_current_procinfo;
 
          { Restore old state }
-         block_type:=oldblock_type;
+         block_type:=old_block_type;
       end;
 
 
@@ -1526,23 +1536,22 @@ implementation
 
       var
         old_current_procinfo : tprocinfo;
+        old_current_objectdef : tobjectdef;
         pdflags    : tpdflags;
         pd,firstpd : tprocdef;
         s          : string;
       begin
          { save old state }
          old_current_procinfo:=current_procinfo;
+         old_current_objectdef:=current_objectdef;
 
          { reset current_procinfo.procdef to nil to be sure that nothing is writing
            to an other procdef }
          current_procinfo:=nil;
+         current_objectdef:=nil;
 
          { parse procedure declaration }
-         if assigned(old_current_procinfo) and
-            assigned(old_current_procinfo.procdef) then
-          pd:=parse_proc_dec(old_current_procinfo.procdef._class)
-         else
-          pd:=parse_proc_dec(nil);
+         pd:=parse_proc_dec(old_current_objectdef);
 
          { set the default function options }
          if parse_only then
@@ -1586,7 +1595,7 @@ implementation
            begin
              { A method must be forward defined (in the object declaration) }
              if assigned(pd._class) and
-                (not assigned(old_current_procinfo.procdef._class)) then
+                (not assigned(old_current_objectdef)) then
               begin
                 MessagePos1(pd.fileinfo,parser_e_header_dont_match_any_member,pd.fullprocname(false));
                 tprocsym(pd.procsym).write_parameter_lists(pd);
@@ -1667,6 +1676,7 @@ implementation
                current_asmdata.DefineAsmSymbol(pd.mangledname,AB_LOCAL,AT_FUNCTION);
            end;
 
+         current_objectdef:=old_current_objectdef;
          current_procinfo:=old_current_procinfo;
       end;
 

compiler/psystem.pas

@@ -116,6 +116,12 @@ implementation
           systemunit.insert(result);
         end;
 
+        procedure addfield(recst:tabstractrecordsymtable;sym:tfieldvarsym);
+        begin
+          recst.insert(sym);
+          recst.addfield(sym,vis_hidden);
+        end;
+
         procedure create_fpu_types;
         begin
           if init_settings.fputype<>fpu_none then
@@ -338,26 +344,26 @@ implementation
           type is not available. The rtti for pvmt will be written implicitly
           by thev tblarray below }
         systemunit.insert(ttypesym.create('$pvmt',pvmttype));
-        hrecst.insertfield(tfieldvarsym.create('$length',vs_value,ptrsinttype,[]));
-        hrecst.insertfield(tfieldvarsym.create('$mlength',vs_value,ptrsinttype,[]));
-        hrecst.insertfield(tfieldvarsym.create('$parent',vs_value,pvmttype,[]));
+        addfield(hrecst,tfieldvarsym.create('$length',vs_value,ptrsinttype,[]));
+        addfield(hrecst,tfieldvarsym.create('$mlength',vs_value,ptrsinttype,[]));
+        addfield(hrecst,tfieldvarsym.create('$parent',vs_value,pvmttype,[]));
         { it seems vmttype is used both for TP objects and Delphi classes,
           so the next entry could either be the first virtual method (vm1)
           (object) or the class name (class). We can't easily create separate
           vtable formats for both, as gdb is hard coded to search for
           __vtbl_ptr_type in all cases (JM) }
-        hrecst.insertfield(tfieldvarsym.create('$vm1_or_classname',vs_value,tpointerdef.create(cshortstringtype),[]));
+        addfield(hrecst,tfieldvarsym.create('$vm1_or_classname',vs_value,tpointerdef.create(cshortstringtype),[]));
         vmtarraytype:=tarraydef.create(0,0,s32inttype);
         tarraydef(vmtarraytype).elementdef:=voidpointertype;
-        hrecst.insertfield(tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]));
+        addfield(hrecst,tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]));
         addtype('$__vtbl_ptr_type',vmttype);
         vmtarraytype:=tarraydef.create(0,1,s32inttype);
         tarraydef(vmtarraytype).elementdef:=pvmttype;
         addtype('$vtblarray',vmtarraytype);
         { Add a type for methodpointers }
         hrecst:=trecordsymtable.create(1);
-        hrecst.insertfield(tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
-        hrecst.insertfield(tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
+        addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
+        addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
         methodpointertype:=trecorddef.create(hrecst);
         addtype('$methodpointer',methodpointertype);
         symtablestack.pop(systemunit);

compiler/ptype.pas

@@ -492,10 +492,8 @@ implementation
 
     { reads a record declaration }
     function record_dec : tdef;
-
       var
          recst : trecordsymtable;
-         old_object_option : tsymoptions;
       begin
          { create recdef }
          recst:=trecordsymtable.create(current_settings.packrecords);
@@ -504,11 +502,8 @@ implementation
          symtablestack.push(recst);
          { parse record }
          consume(_RECORD);
-         old_object_option:=current_object_option;
-         current_object_option:=[sp_public];
          read_record_fields([vd_record]);
          consume(_END);
-         current_object_option:=old_object_option;
          { make the record size aligned }
          recst.addalignmentpadding;
          { restore symtable stack }

compiler/rautils.pas

@@ -118,7 +118,7 @@ type
     constructor create(optype : tcoperand);virtual;
     destructor  destroy;override;
     { converts the instruction to an instruction how it's used by the assembler writer
-      and concats it to the passed list. The newly created item is returned if the 
+      and concats it to the passed list. The newly created item is returned if the
       instruction was valid, otherwise nil is returned }
     function ConcatInstruction(p:TAsmList) : tai;virtual;
     Procedure Swapoperands;
@@ -693,7 +693,7 @@ end;
 Function TOperand.SetupSelf:boolean;
 Begin
   SetupSelf:=false;
-  if assigned(current_procinfo.procdef._class) then
+  if assigned(current_objectdef) then
     SetupSelf:=setupvar('self',false)
   else
     Message(asmr_e_cannot_use_SELF_outside_a_method);
@@ -1294,7 +1294,7 @@ Begin
   base:=Copy(s,1,i-1);
   delete(s,1,i);
   if base='SELF' then
-   st:=current_procinfo.procdef._class.symtable
+   st:=current_objectdef.symtable
   else
    begin
      asmsearchsym(base,sym,srsymtable);

compiler/symbase.pas

@@ -95,6 +95,7 @@ interface
           defowner  : TDefEntry; { for records and objects }
           moduleid  : longint;
           refcount  : smallint;
+          currentvisibility : tvisibility;
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
           symtabletype  : TSymtabletype;
@@ -220,6 +221,7 @@ implementation
          DefList:=TFPObjectList.Create(true);
          SymList:=TFPHashObjectList.Create(true);
          refcount:=1;
+         currentvisibility:=vis_public;
       end;
 
 

compiler/symconst.pas

@@ -122,12 +122,19 @@ type
     deref_defid
   );
 
+  { symbol visibility }
+  tvisibility=(
+    vis_hidden,
+    vis_strictprivate,
+    vis_private,
+    vis_strictprotected,
+    vis_protected,
+    vis_public,
+    vis_published
+  );
+
   { symbol options }
   tsymoption=(sp_none,
-    sp_public,
-    sp_private,
-    sp_published,
-    sp_protected,
     sp_static,
     sp_hint_deprecated,
     sp_hint_platform,
@@ -135,10 +142,7 @@ type
     sp_hint_unimplemented,
     sp_has_overloaded,
     sp_internal,  { internal symbol, not reported as unused }
-    sp_strictprivate,
-    sp_strictprotected,
     sp_implicitrename,
-    sp_hidden,
     sp_hint_experimental,
     sp_generic_para
   );
@@ -507,6 +511,11 @@ const
        'convert_l1','equal','exact'
      );
 
+     visibilityName : array[tvisibility] of string[16] = (
+       'hidden','strict private','private','strict protected','protected',
+       'public','published'
+     );
+
 implementation
 
 end.

compiler/symdef.pas

@@ -239,6 +239,14 @@ interface
          function  IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean;
        end;
 
+       { tvmtentry }
+       tvmtentry = record
+         procdef      : tprocdef;
+         procdefderef : tderef;
+         visibility   : tvisibility;
+       end;
+       pvmtentry = ^tvmtentry;
+
        { tobjectdef }
 
        tobjectdef = class(tabstractrecorddef)
@@ -260,7 +268,7 @@ interface
           objectoptions  : tobjectoptions;
           { to be able to have a variable vmt position }
           { and no vmt field for objects without virtuals }
-          vmtentries     : TFPObjectList;
+          vmtentries     : TFPList;
           vmt_offset     : longint;
           writing_class_record_dbginfo : boolean;
           objecttype     : tobjecttyp;
@@ -278,6 +286,8 @@ interface
           procedure deref;override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
+          procedure resetvmtentries;
+          procedure copyvmtentries(objdef:tobjectdef);
           function  getparentdef:tdef;override;
           function  size : aint;override;
           function  alignment:shortint;override;
@@ -462,6 +472,7 @@ interface
             EXTDEBUG has fileinfo in tdef (PFV) }
           fileinfo : tfileposinfo;
 {$endif}
+          visibility : tvisibility;
           symoptions : tsymoptions;
           { symbol owning this definition }
           procsym : tsym;
@@ -521,7 +532,6 @@ interface
           function  cplusplusmangledname : string;
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
-          function  is_visible_for_object(currobjdef,contextobjdef:tobjectdef):boolean;
        end;
 
        { single linked list of overloaded procs }
@@ -596,8 +606,6 @@ interface
           function  is_publishable : boolean;override;
        end;
 
-       Tdefmatch=(dm_exact,dm_equal,dm_convertl1);
-
     var
        current_objectdef : tobjectdef;  { used for private functions check !! }
 
@@ -2888,19 +2896,17 @@ implementation
                  s:=s+'<';
                case hp.varspez of
                  vs_var :
-                   s:=s+'var';
+                   s:=s+'var ';
                  vs_const :
-                   s:=s+'const';
+                   s:=s+'const ';
                  vs_out :
-                   s:=s+'out';
+                   s:=s+'out ';
                end;
                if assigned(hp.vardef.typesym) then
                  begin
-                   if s<>'(' then
-                    s:=s+' ';
                    hs:=hp.vardef.typesym.realname;
                    if hs[1]<>'$' then
-                     s:=s+hp.vardef.typesym.realname
+                     s:=s+hs
                    else
                      s:=s+hp.vardef.GetTypeName;
                  end
@@ -3011,6 +3017,7 @@ implementation
          ppufile.getderef(_classderef);
          ppufile.getderef(procsymderef);
          ppufile.getposinfo(fileinfo);
+         visibility:=tvisibility(ppufile.getbyte);
          ppufile.getsmallset(symoptions);
 {$ifdef powerpc}
          { library symbol for AmigaOS/MorphOS }
@@ -3147,6 +3154,7 @@ implementation
          ppufile.putderef(_classderef);
          ppufile.putderef(procsymderef);
          ppufile.putposinfo(fileinfo);
+         ppufile.putbyte(byte(visibility));
          ppufile.putsmallset(symoptions);
 {$ifdef powerpc}
          { library symbol for AmigaOS/MorphOS }
@@ -3287,60 +3295,6 @@ implementation
       end;
 
 
-    function tprocdef.is_visible_for_object(currobjdef,contextobjdef:tobjectdef):boolean;
-      var
-        contextst : TSymtable;
-      begin
-        result:=false;
-
-        { Support passing a context in which module we are to find protected members }
-        if assigned(contextobjdef) then
-          contextst:=contextobjdef.owner
-        else
-          contextst:=nil;
-
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        if (sp_private in symoptions) and
-           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           not(owner.defowner.owner.iscurrentunit or (owner.defowner.owner=contextst)) then
-          exit;
-
-        if (sp_strictprivate in symoptions) then
-          begin
-            result:=currobjdef=tobjectdef(owner.defowner);
-            exit;
-          end;
-
-        if (sp_strictprotected in symoptions) then
-          begin
-             result:=assigned(currobjdef) and
-               currobjdef.is_related(tobjectdef(owner.defowner));
-             exit;
-          end;
-
-        { protected symbols are visible in the module that defines them and
-          also visible to related objects. The related object must be defined
-          in the current module }
-        if (sp_protected in symoptions) and
-           (
-            (
-             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             not((owner.defowner.owner.iscurrentunit) or (owner.defowner.owner=contextst))
-            ) and
-            not(
-                assigned(currobjdef) and
-                (currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                (currobjdef.owner.iscurrentunit) and
-                currobjdef.is_related(tobjectdef(owner.defowner))
-               )
-           ) then
-          exit;
-
-        result:=true;
-      end;
-
-
     function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
       begin
         case t of
@@ -3785,7 +3739,7 @@ implementation
         childof:=nil;
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
         { create space for vmt !! }
-        vmtentries:=nil;
+        vmtentries:=TFPList.Create;
         vmt_offset:=0;
         set_parent(c);
         objname:=stringdup(upper(n));
@@ -3807,6 +3761,7 @@ implementation
          implintfcount : longint;
          d : tderef;
          ImplIntf : TImplementedInterface;
+         vmtentry : pvmtentry;
       begin
          inherited ppuload(objectdef,ppufile);
          objecttype:=tobjecttyp(ppufile.getbyte);
@@ -3817,7 +3772,6 @@ implementation
          tObjectSymtable(symtable).fieldalignment:=ppufile.getbyte;
          tObjectSymtable(symtable).recordalignment:=ppufile.getbyte;
          vmt_offset:=ppufile.getlongint;
-         vmtentries:=nil;
          ppufile.getderef(childofderef);
          ppufile.getsmallset(objectoptions);
 
@@ -3830,6 +3784,18 @@ implementation
               iidstr:=stringdup(ppufile.getstring);
            end;
 
+         vmtentries:=TFPList.Create;
+         vmtentries.count:=ppufile.getlongint;
+         for i:=0 to vmtentries.count-1 do
+           begin
+             ppufile.getderef(d);
+             new(vmtentry);
+             vmtentry^.procdef:=nil;
+             vmtentry^.procdefderef:=d;
+             vmtentry^.visibility:=tvisibility(ppufile.getbyte);
+             vmtentries[i]:=vmtentry;
+           end;
+
          { load implemented interfaces }
          if objecttype in [odt_class,odt_interfacecorba] then
            begin
@@ -3888,6 +3854,7 @@ implementation
            end;
          if assigned(vmtentries) then
            begin
+             resetvmtentries;
              vmtentries.free;
              vmtentries:=nil;
            end;
@@ -3924,8 +3891,8 @@ implementation
           end;
         if assigned(vmtentries) then
           begin
-            tobjectdef(result).vmtentries:=TFPobjectList.Create(false);
-            tobjectdef(result).vmtentries.Assign(vmtentries);
+            tobjectdef(result).vmtentries:=TFPList.Create;
+            tobjectdef(result).copyvmtentries(self);
           end;
       end;
 
@@ -3933,6 +3900,7 @@ implementation
     procedure tobjectdef.ppuwrite(ppufile:tcompilerppufile);
       var
          i : longint;
+         vmtentry : pvmtentry;
          ImplIntf : TImplementedInterface;
       begin
          inherited ppuwrite(ppufile);
@@ -3950,6 +3918,15 @@ implementation
               ppufile.putstring(iidstr^);
            end;
 
+         ppufile.putlongint(vmtentries.count);
+         for i:=0 to vmtentries.count-1 do
+           begin
+             vmtentry:=pvmtentry(vmtentries[i]);
+             ppufile.putderef(vmtentry^.procdefderef);
+             ppufile.putbyte(byte(vmtentry^.visibility));
+           end;
+
+
          if assigned(ImplementedInterfaces) then
            begin
              ppufile.putlongint(ImplementedInterfaces.Count);
@@ -3973,20 +3950,21 @@ implementation
 
     function tobjectdef.GetTypeName:string;
       begin
-        if (self <> current_objectdef) then
-          GetTypeName:=typename
+        { in this case we will go in endless recursion, because then  }
+        { there is no tsym associated yet with the def. It can occur  }
+        { (tests/webtbf/tw4757.pp), so for now give a generic name    }
+        { instead of the actual type name                             }
+        if not assigned(typesym) then
+          result:='<Currently Parsed Class>'
         else
-          { in this case we will go in endless recursion, because then  }
-          { there is no tsym associated yet with the def. It can occur  }
-          { (tests/webtbf/tw4757.pp), so for now give a generic name    }
-          { instead of the actual type name                             }
-          GetTypeName:='<Currently Parsed Class>';
+          result:=typename;
       end;
 
 
     procedure tobjectdef.buildderef;
       var
          i : longint;
+         vmtentry : pvmtentry;
       begin
          inherited buildderef;
          childofderef.build(childof);
@@ -3995,6 +3973,12 @@ implementation
          else
            tstoredsymtable(symtable).buildderef;
 
+         for i:=0 to vmtentries.count-1 do
+           begin
+             vmtentry:=pvmtentry(vmtentries[i]);
+             vmtentry^.procdefderef.build(vmtentry^.procdef);
+           end;
+
          if assigned(ImplementedInterfaces) then
            begin
              for i:=0 to ImplementedInterfaces.count-1 do
@@ -4006,6 +3990,7 @@ implementation
     procedure tobjectdef.deref;
       var
          i : longint;
+         vmtentry : pvmtentry;
       begin
          inherited deref;
          childof:=tobjectdef(childofderef.resolve);
@@ -4016,6 +4001,11 @@ implementation
            end
          else
            tstoredsymtable(symtable).deref;
+         for i:=0 to vmtentries.count-1 do
+           begin
+             vmtentry:=pvmtentry(vmtentries[i]);
+             vmtentry^.procdef:=tprocdef(vmtentry^.procdefderef.resolve);
+           end;
          if assigned(ImplementedInterfaces) then
            begin
              for i:=0 to ImplementedInterfaces.count-1 do
@@ -4040,6 +4030,32 @@ implementation
       end;
 
 
+    procedure tobjectdef.resetvmtentries;
+      var
+        i : longint;
+      begin
+        for i:=0 to vmtentries.Count-1 do
+          Dispose(pvmtentry(vmtentries[i]));
+        vmtentries.clear;
+      end;
+
+
+    procedure tobjectdef.copyvmtentries(objdef:tobjectdef);
+      var
+        i : longint;
+        vmtentry : pvmtentry;
+      begin
+        resetvmtentries;
+        vmtentries.count:=objdef.vmtentries.count;
+        for i:=0 to objdef.vmtentries.count-1 do
+          begin
+            new(vmtentry);
+            vmtentry^:=pvmtentry(objdef.vmtentries[i])^;
+            vmtentries[i]:=vmtentry;
+          end;
+       end;
+
+
     function tobjectdef.getparentdef:tdef;
       begin
 { TODO: Remove getparentdef hack}
@@ -4119,7 +4135,7 @@ implementation
              vs:=tfieldvarsym.create('_vptr$'+objname^,vs_value,voidpointertype,[]);
              hidesym(vs);
              tObjectSymtable(symtable).insert(vs);
-             tObjectSymtable(symtable).addfield(vs);
+             tObjectSymtable(symtable).addfield(vs,vis_hidden);
              include(objectoptions,oo_has_vmt);
           end;
      end;

compiler/symsym.pas

@@ -84,7 +84,6 @@ interface
           FProcdefList   : TFPObjectList;
           FProcdefDerefList : TFPList;
        public
-          overloadchecked : boolean;
           constructor create(const n : string);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
@@ -93,18 +92,13 @@ interface
           { tests, if all procedures definitions are defined and not }
           { only forward                                             }
           procedure check_forward;
-          procedure unchain_overload;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
-          procedure add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
           function find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
           function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
           function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
           function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
-          { currobjdef is the object def to assume, this is necessary for protected and
-            private, context is the object def we're really in, this is for the strict stuff }
-          function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override;
           property ProcdefList:TFPObjectList read FProcdefList;
        end;
 
@@ -372,6 +366,7 @@ implementation
          { Register symbol }
          current_module.symlist[SymId]:=self;
          ppufile.getposinfo(fileinfo);
+         visibility:=tvisibility(ppufile.getbyte);
          ppufile.getsmallset(symoptions);
       end;
 
@@ -381,6 +376,7 @@ implementation
          ppufile.putlongint(SymId);
          ppufile.putstring(realname);
          ppufile.putposinfo(fileinfo);
+         ppufile.putbyte(byte(visibility));
          ppufile.putsmallset(symoptions);
       end;
 
@@ -479,8 +475,7 @@ implementation
          FProcdefderefList:=nil;
          { the tprocdef have their own symoptions, make the procsym
            always visible }
-         symoptions:=[sp_public];
-         overloadchecked:=false;
+         visibility:=vis_public;
       end;
 
 
@@ -615,20 +610,6 @@ implementation
       end;
 
 
-    procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
-      var
-        i  : longint;
-        pd : tprocdef;
-      begin
-        for i:=0 to ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(ProcdefList[i]);
-            if Aprocsym.find_procdef_bypara(pd.paras,nil,cpoptions)=nil then
-              Aprocsym.ProcdefList.Add(pd);
-          end;
-      end;
-
-
     function Tprocsym.Find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
       var
         i  : longint;
@@ -777,51 +758,6 @@ implementation
       end;
 
 
-    procedure tprocsym.unchain_overload;
-      var
-        i  : longint;
-        pd : tprocdef;
-      begin
-        { remove all overloaded procdefs from the
-          procdeflist that are not in the current symtable }
-        overloadchecked:=false;
-        { reset new lists }
-        for i:=0 to ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(ProcdefList[i]);
-            { only keep the proc definitions:
-              - are not deref'd (def=nil)
-              - are in the same symtable as the procsym (for example both
-                are in the staticsymtable) }
-            if not(pd.owner=owner) then
-              ProcdefList[i]:=nil;
-          end;
-        { Remove cleared entries }
-        ProcdefList.Pack;
-      end;
-
-
-    function tprocsym.is_visible_for_object(currobjdef:tdef;context:tdef):boolean;
-      var
-        i  : longint;
-        pd : tprocdef;
-      begin
-        { This procsym is visible, when there is at least
-          one of the procdefs visible }
-        result:=false;
-        for i:=0 to ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(ProcdefList[i]);
-            if (pd.owner=owner) and
-                pd.is_visible_for_object(tobjectdef(currobjdef),tobjectdef(context)) then
-              begin
-                result:=true;
-                exit;
-              end;
-          end;
-      end;
-
-
 {****************************************************************************
                                   TERRORSYM
 ****************************************************************************}

compiler/symtable.pas

@@ -52,7 +52,6 @@ interface
           procedure varsymbolused(sym:TObject;arg:pointer);
           procedure TestPrivate(sym:TObject;arg:pointer);
           procedure objectprivatesymbolused(sym:TObject;arg:pointer);
-          procedure unchain_overloads(sym:TObject;arg:pointer);
           procedure loaddefs(ppufile:tcompilerppufile);
           procedure loadsyms(ppufile:tcompilerppufile);
           procedure writedefs(ppufile:tcompilerppufile);
@@ -74,7 +73,6 @@ interface
           procedure check_forwards;
           procedure checklabels;
           function  needs_init_final : boolean;
-          procedure unchain_overloaded;
           procedure testfordefaultproperty(sym:TObject;arg:pointer);
        end;
 
@@ -106,8 +104,7 @@ interface
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure alignrecord(fieldoffset:aint;varalign:shortint);
-          procedure addfield(sym:tfieldvarsym);
-          procedure insertfield(sym:tfieldvarsym);
+          procedure addfield(sym:tfieldvarsym;vis:tvisibility);
           procedure addalignmentpadding;
           procedure insertdef(def:TDefEntry);override;
           function is_packed: boolean;
@@ -236,6 +233,9 @@ interface
 
 {*** Search ***}
     procedure addsymref(sym:tsym);
+    function  is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean;
+    function  is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean;
+    function  is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean;
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
@@ -253,7 +253,6 @@ interface
     function  defined_macro(const s : string):boolean;
 
 {*** Object Helpers ***}
-    procedure search_class_overloads(aprocsym : tprocsym);
     function search_default_property(pd : tobjectdef) : tpropertysym;
 
 {*** Macro Helpers ***}
@@ -679,7 +678,7 @@ implementation
 
     procedure TStoredSymtable.TestPrivate(sym:TObject;arg:pointer);
       begin
-        if sp_private in tsym(sym).symoptions then
+        if tsym(sym).visibility=vis_private then
           varsymbolused(sym,arg);
       end;
 
@@ -696,11 +695,12 @@ implementation
       end;
 
 
-    procedure tstoredsymtable.unchain_overloads(sym:TObject;arg:pointer);
-      begin
-         if tsym(sym).typ=procsym then
-           tprocsym(sym).unchain_overload;
-      end;
+   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
+     begin
+        if (tsym(sym).typ=propertysym) and
+           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
+          ppointer(arg)^:=sym;
+     end;
 
 
 {***********************************************
@@ -745,12 +745,6 @@ implementation
       end;
 
 
-    procedure tstoredsymtable.unchain_overloaded;
-      begin
-         SymList.ForEachCall(@unchain_overloads,nil);
-      end;
-
-
     procedure TStoredSymtable._needs_init_final(sym:TObject;arg:pointer);
       begin
          if b_needs_init_final then
@@ -867,7 +861,7 @@ implementation
         recordalignment:=max(recordalignment,varalignrecord);
       end;
 
-    procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym);
+    procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym;vis:tvisibility);
       var
         l      : aint;
         varalignfield,
@@ -878,6 +872,8 @@ implementation
           internalerror(200602031);
         if sym.fieldoffset<>-1 then
           internalerror(200602032);
+        { set visibility for the symbol }
+        sym.visibility:=vis;
         { this symbol can't be loaded to a register }
         sym.varregable:=vr_none;
         { Calculate field offset }
@@ -966,13 +962,6 @@ implementation
       end;
 
 
-    procedure tabstractrecordsymtable.insertfield(sym:tfieldvarsym);
-      begin
-        insert(sym);
-        addfield(sym);
-      end;
-
-
     procedure tabstractrecordsymtable.addalignmentpadding;
       begin
         { make the record size aligned correctly so it can be
@@ -1160,8 +1149,9 @@ implementation
               hsym:=search_class_member(tobjectdef(defowner),hashedid.id);
               if assigned(hsym) and
                  (
-                  (not(m_delphi in current_settings.modeswitches) and
-                   tsym(hsym).is_visible_for_object(tobjectdef(defowner),tobjectdef(defowner))
+                  (
+                   not(m_delphi in current_settings.modeswitches) and
+                   is_visible_for_object(hsym,tobjectdef(defowner))
                   ) or
                   (
                    { In Delphi, you can repeat members of a parent class. You can't }
@@ -1871,7 +1861,7 @@ implementation
     procedure hidesym(sym:TSymEntry);
       begin
         sym.realname:='$hidden'+sym.realname;
-        include(tsym(sym).symoptions,sp_hidden);
+        tsym(sym).visibility:=vis_hidden;
       end;
 
 
@@ -1919,11 +1909,95 @@ implementation
        end;
 
 
+    function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean;
+      var
+        symownerdef : tobjectdef;
+      begin
+        result:=false;
+
+        { Get objdectdef owner of the symtable for the is_related checks }
+        if not assigned(symst) or
+           (symst.symtabletype<>objectsymtable) then
+          internalerror(200810285);
+        symownerdef:=tobjectdef(symst.defowner);
+        case symvisibility of
+          vis_private :
+            begin
+              { private symbols are allowed when we are in the same
+                module as they are defined }
+              result:=(symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                      (symownerdef.owner.iscurrentunit);
+            end;
+          vis_strictprivate :
+            begin
+              result:=assigned(current_objectdef) and
+                      (current_objectdef=symownerdef);
+            end;
+          vis_strictprotected :
+            begin
+               result:=assigned(current_objectdef) and
+                       current_objectdef.is_related(symownerdef);
+            end;
+          vis_protected :
+            begin
+              { protected symbols are visible in the module that defines them and
+                also visible to related objects. The related object must be defined
+                in the current module }
+              result:=(
+                       (
+                        (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                        (symownerdef.owner.iscurrentunit)
+                       ) or
+                       (
+                        assigned(contextobjdef) and
+                        (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                        (contextobjdef.owner.iscurrentunit) and
+                        contextobjdef.is_related(symownerdef)
+                       )
+                      );
+            end;
+          vis_public,
+          vis_published :
+            result:=true;
+        end;
+      end;
+
+
+    function is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean;
+      begin
+        result:=is_visible_for_object(pd.owner,pd.visibility,contextobjdef);
+      end;
+
+
+    function is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean;
+      var
+        i  : longint;
+        pd : tprocdef;
+      begin
+        if sym.typ=procsym then
+          begin
+            { A procsym is visible, when there is at least one of the procdefs visible }
+            result:=false;
+            for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
+              begin
+                pd:=tprocdef(tprocsym(sym).ProcdefList[i]);
+                if (pd.owner=sym.owner) and
+                   is_visible_for_object(pd,contextobjdef) then
+                  begin
+                    result:=true;
+                    exit;
+                  end;
+              end;
+          end
+        else
+          result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
+      end;
+
+
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var
         hashedid   : THashedIDString;
-        topclass   : tobjectdef;
-        context    : tobjectdef;
+        contextobjdef : tobjectdef;
         stackitem  : psymtablestackitem;
       begin
         result:=false;
@@ -1935,7 +2009,6 @@ implementation
             srsym:=tsym(srsymtable.FindWithHash(hashedid));
             if assigned(srsym) then
               begin
-                topclass:=nil;
                 { use the class from withsymtable only when it is
                   defined in this unit }
                 if (srsymtable.symtabletype=withsymtable) and
@@ -1943,17 +2016,11 @@ implementation
                    (srsymtable.defowner.typ=objectdef) and
                    (srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
                    (srsymtable.defowner.owner.iscurrentunit) then
-                  topclass:=tobjectdef(srsymtable.defowner)
-                else
-                  begin
-                    if assigned(current_procinfo) then
-                      topclass:=current_procinfo.procdef._class;
-                  end;
-                if assigned(current_procinfo) then
-                  context:=current_procinfo.procdef._class
+                  contextobjdef:=tobjectdef(srsymtable.defowner)
                 else
-                  context:=nil;
-                if tsym(srsym).is_visible_for_object(topclass,context) then
+                  contextobjdef:=current_objectdef;
+                if (srsym.owner.symtabletype<>objectsymtable) or
+                   is_visible_for_object(srsym,contextobjdef) then
                   begin
                     { we need to know if a procedure references symbols
                       in the static symtable, because then it can't be
@@ -2002,8 +2069,10 @@ implementation
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
                 if assigned(srsym) and
                    not(srsym.typ in [fieldvarsym,paravarsym]) and
-                   (not assigned(current_procinfo) or
-                    tsym(srsym).is_visible_for_object(current_procinfo.procdef._class,current_procinfo.procdef._class)) then
+                   (
+                    (srsym.owner.symtabletype<>objectsymtable) or
+                    is_visible_for_object(srsym,current_objectdef)
+                   ) then
                   begin
                     { we need to know if a procedure references symbols
                       in the static symtable, because then it can't be
@@ -2062,21 +2131,22 @@ implementation
 
     function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var
-        hashedid      : THashedIDString;
-        currentclassh : tobjectdef;
+        hashedid : THashedIDString;
       begin
+        { The contextclassh is used for visibility. The classh must be equal to
+          or be a parent of contextclassh. E.g. for inherited searches the classh is the
+          parent. }
+        if assigned(classh) and
+           not contextclassh.is_related(classh) then
+          internalerror(200811161);
         result:=false;
         hashedid.id:=s;
-        if assigned(current_procinfo) and assigned(current_procinfo.procdef) then
-          currentclassh:=current_procinfo.procdef._class
-        else
-          currentclassh:=nil;
         while assigned(classh) do
           begin
             srsymtable:=classh.symtable;
             srsym:=tsym(srsymtable.FindWithHash(hashedid));
             if assigned(srsym) and
-               tsym(srsym).is_visible_for_object(contextclassh,currentclassh) then
+               is_visible_for_object(srsym,contextclassh) then
               begin
                 addsymref(srsym);
                 result:=true;
@@ -2280,54 +2350,6 @@ implementation
                               Object Helpers
 ****************************************************************************}
 
-    procedure search_class_overloads(aprocsym : tprocsym);
-    { searches n in symtable of pd and all anchestors }
-      var
-        hashedid : THashedIDString;
-        srsym    : tprocsym;
-        objdef   : tobjectdef;
-      begin
-        if aprocsym.overloadchecked then
-         exit;
-        aprocsym.overloadchecked:=true;
-        if (aprocsym.owner.symtabletype<>ObjectSymtable) then
-         internalerror(200111021);
-        objdef:=tobjectdef(aprocsym.owner.defowner);
-        { we start in the parent }
-        if not assigned(objdef.childof) then
-         exit;
-        objdef:=objdef.childof;
-        hashedid.id:=aprocsym.name;
-        while assigned(objdef) do
-         begin
-           srsym:=tprocsym(objdef.symtable.FindWithHash(hashedid));
-           if assigned(srsym) then
-            begin
-              if (srsym.typ<>procsym) then
-               internalerror(200111022);
-              if srsym.is_visible_for_object(tobjectdef(aprocsym.owner.defowner),tobjectdef(aprocsym.owner.defowner)) then
-               begin
-                 srsym.add_para_match_to(Aprocsym,[cpo_ignorehidden,cpo_allowdefaults]);
-                 { we can stop if the overloads were already added
-                  for the found symbol }
-                 if srsym.overloadchecked then
-                  break;
-               end;
-            end;
-           { next parent }
-           objdef:=objdef.childof;
-         end;
-      end;
-
-
-   procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer);
-     begin
-        if (tsym(sym).typ=propertysym) and
-           (ppo_defaultproperty in tpropertysym(sym).propoptions) then
-          ppointer(arg)^:=sym;
-     end;
-
-
    function search_default_property(pd : tobjectdef) : tpropertysym;
    { returns the default property of a class, searches also anchestors }
      var
@@ -2529,7 +2551,6 @@ implementation
        class_tobject:=nil;
        interface_iunknown:=nil;
        rec_tguid:=nil;
-       current_objectdef:=nil;
        dupnr:=0;
      end;
 

compiler/symtype.pas

@@ -115,6 +115,7 @@ interface
       public
          fileinfo   : tfileposinfo;
          symoptions : tsymoptions;
+         visibility : tvisibility;
          refs       : longint;
          reflist    : TLinkedList;
          isdbgwritten : boolean;
@@ -123,11 +124,6 @@ interface
          function  mangledname:string; virtual;
          procedure buildderef;virtual;
          procedure deref;virtual;
-         { currobjdef is the object def to assume, this is necessary for protected and
-           private,
-           context is the object def we're really in, this is for the strict stuff
-         }
-         function is_visible_for_object(currobjdef:tdef;context : tdef):boolean;virtual;
          procedure ChangeOwner(st:TSymtable);
          procedure IncRefCount;
          procedure IncRefCountBy(AValue : longint);
@@ -213,9 +209,6 @@ interface
       memprocnodetree : tmemdebug;
 {$endif MEMDEBUG}
 
-    const
-       current_object_option : tsymoptions = [sp_public];
-
     function  FindUnitSymtable(st:TSymtable):TSymtable;
 
 
@@ -352,7 +345,7 @@ implementation
          symoptions:=[];
          fileinfo:=current_tokenpos;
          isdbgwritten := false;
-         symoptions:=current_object_option;
+         visibility:=vis_public;
       end;
 
     destructor  Tsym.destroy;
@@ -408,58 +401,8 @@ implementation
       end;
 
 
-    function tsym.is_visible_for_object(currobjdef:Tdef;context : tdef):boolean;
-      begin
-        is_visible_for_object:=false;
-
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        if (sp_private in symoptions) and
-           assigned(owner.defowner) and
-           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (not owner.defowner.owner.iscurrentunit) then
-          exit;
-
-        if (sp_strictprivate in symoptions) then
-          begin
-            result:=assigned(currobjdef) and
-              (context=tdef(owner.defowner));
-            exit;
-          end;
-
-        if (sp_strictprotected in symoptions) then
-          begin
-            result:=assigned(context) and
-              context.is_related(tdef(owner.defowner));
-            exit;
-          end;
-
-        { protected symbols are visible in the module that defines them and
-          also visible to related objects }
-        if (sp_protected in symoptions) and
-           (
-            (
-             assigned(owner.defowner) and
-             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             (not owner.defowner.owner.iscurrentunit)
-            ) and
-            not(
-                assigned(currobjdef) and
-                (currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                (currobjdef.owner.iscurrentunit) and
-                currobjdef.is_related(tdef(owner.defowner))
-               )
-           ) then
-          exit;
-
-        is_visible_for_object:=true;
-      end;
-
-
     procedure tsym.ChangeOwner(st:TSymtable);
       begin
-//        if assigned(Owner) then
-//          Owner.SymList.List.List^[i].Data:=nil;
         Owner:=st;
         inherited ChangeOwner(Owner.SymList);
       end;

compiler/utils/ppudump.pp

@@ -171,10 +171,10 @@ type
         target_arm_symbian,        { 60 }
         target_x86_64_darwin,      { 61 }
         target_avr_embedded,       { 62 }
-        target_i386_haiku          { 63 }             
+        target_i386_haiku          { 63 }
   );
 const
-  Targets : array[ttarget] of string[17]=(
+  Targets : array[ttarget] of string[18]=(
   { 0 }   'none',
   { 1 }   'GO32V1 (obsolete)',
   { 2 }   'GO32V2',
@@ -238,7 +238,7 @@ const
   { 60 }  'Symbian-arm',
   { 61 }  'MacOSX-x64',
   { 62 }  'Embedded-avr',
-  { 63 }  'Haiku-i386'        
+  { 63 }  'Haiku-i386'
   );
 begin
   if w<=ord(high(ttarget)) then
@@ -281,6 +281,20 @@ begin
 end;
 
 
+Function Visibility2Str(w:longint):string;
+const
+  visibilitystr : array[0..6] of string[16]=(
+    'hidden','strict private','private','strict protected','protected',
+    'public','published'
+  );
+begin
+  if w<=ord(high(visibilitystr)) then
+    result:=visibilitystr[w]
+  else
+    result:='<!! Unknown visibility value '+tostr(w)+'>';
+end;
+
+
 function PPUFlags2Str(flags:longint):string;
 type
   tflagopt=record
@@ -703,18 +717,18 @@ end;
 
 procedure readsymoptions;
 type
+  { symbol options }
   tsymoption=(sp_none,
-    sp_public,
-    sp_private,
-    sp_published,
-    sp_protected,
     sp_static,
     sp_hint_deprecated,
     sp_hint_platform,
     sp_hint_library,
     sp_hint_unimplemented,
+    sp_hint_experimental,
     sp_has_overloaded,
-    sp_internal  { internal symbol, not reported as unused }
+    sp_internal,  { internal symbol, not reported as unused }
+    sp_implicitrename,
+    sp_generic_para
   );
   tsymoptions=set of tsymoption;
   tsymopt=record
@@ -722,19 +736,18 @@ type
     str  : string[30];
   end;
 const
-  symopts=11;
+  symopts=10;
   symopt : array[1..symopts] of tsymopt=(
-     (mask:sp_public;         str:'Public'),
-     (mask:sp_private;        str:'Private'),
-     (mask:sp_published;      str:'Published'),
-     (mask:sp_protected;      str:'Protected'),
      (mask:sp_static;         str:'Static'),
      (mask:sp_hint_deprecated;str:'Hint Deprecated'),
-     (mask:sp_hint_deprecated;str:'Hint Platform'),
-     (mask:sp_hint_deprecated;str:'Hint Library'),
-     (mask:sp_hint_deprecated;str:'Hint Unimplemented'),
+     (mask:sp_hint_platform;  str:'Hint Platform'),
+     (mask:sp_hint_library;   str:'Hint Library'),
+     (mask:sp_hint_unimplemented;str:'Hint Unimplemented'),
+     (mask:sp_hint_experimental;str:'Hint Experimental'),
      (mask:sp_has_overloaded; str:'Has overloaded'),
-     (mask:sp_internal;       str:'Internal')
+     (mask:sp_internal;       str:'Internal'),
+     (mask:sp_implicitrename; str:'Implicit Rename'),
+     (mask:sp_generic_para;   str:'Generic Parameter')
   );
 var
   symoptions : tsymoptions;
@@ -763,9 +776,10 @@ procedure readcommonsym(const s:string);
 begin
   writeln(space,'** Symbol Id ',ppufile.getlongint,' **');
   writeln(space,s,ppufile.getstring);
-  write(space,'     File Pos : ');
+  write  (space,'     File Pos : ');
   readposinfo;
-  write(space,'   SymOptions : ');
+  writeln(space,'   Visibility : ',Visibility2Str(ppufile.getbyte));
+  write  (space,'   SymOptions : ');
   readsymoptions;
 end;
 
@@ -1793,6 +1807,7 @@ begin
              readderef;
              write  (space,'         File Pos : ');
              readposinfo;
+             writeln(space,'       Visibility : ',Visibility2Str(ppufile.getbyte));
              write  (space,'       SymOptions : ');
              readsymoptions;
              if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then

compiler/x86/aasmcpu.pas

@@ -997,7 +997,8 @@ implementation
               top_const :
                 begin
                   { allow 2nd or 3rd operand being a constant and expect no size for shuf* etc. }
-                  if (opsize=S_NO) and not(i in [1,2]) then
+                  { further, allow AAD and AAM with imm. operand }
+                  if (opsize=S_NO) and not((i in [1,2]) or ((i=0) and (opcode in [A_AAD,A_AAM]))) then
                     message(asmr_e_invalid_opcode_and_operand);
                   if (opsize<>S_W) and (aint(val)>=-128) and (val<=127) then
                     ot:=OT_IMM8 or OT_SIGNED
@@ -1180,12 +1181,12 @@ implementation
         optimize }
         if (Insentry=nil) or ((InsEntry^.flags and IF_PASS2)<>0) then
          begin
+           current_filepos:=fileinfo;
            { We need intel style operands }
            SetOperandOrder(op_intel);
            { create the .ot fields }
            create_ot(objdata);
            { set the file postion }
-           current_filepos:=fileinfo;
          end
         else
          begin

compiler/x86_64/cpupara.pas

@@ -202,8 +202,13 @@ unit cpupara;
             result:=(calloption=pocall_safecall) or
               (def.size>8) or not(def.size in [1,2,4,8])
           else
+            { return method pointers in LOC_REGISTER like records of the same size;
+              this is SysV only }              
+            if (def.typ=procvardef) and
+              (po_methodpointer in tprocvardef(def).procoptions) then
+              result:=false
             { handle objectdefs by the default code because they have no equivalence in C }
-            if (def.typ in [recorddef {,arraydef }]) and (def.size<=16) then
+            else if (def.typ in [recorddef {,arraydef }]) and (def.size<=16) then
               begin
                 case def.typ of
                   recorddef:
@@ -457,6 +462,12 @@ unit cpupara;
                     end;
                 end;
               end
+            else if retcgsize in [OS_128,OS_S128] then
+              begin
+                p.funcretloc[side].size:=retcgsize;
+                p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,R_SUBWHOLE);
+                p.funcretloc[side].registerhi:=newreg(R_INTREGISTER,RS_RDX,R_SUBWHOLE);                
+              end
             else
               begin
                 p.funcretloc[side].size:=retcgsize;

ide/fpini.pas

@@ -233,7 +233,8 @@ function strtopalette(S: string): string;
 {Converts a string in palette string format, i.e #$41#$42#$43 or
 #65#66#67 to an actual format.}
 
-var i,p,x,len:byte;
+var i: integer;
+    p,x,len:byte;
     code:integer;
 
 begin

ide/whtmlhlp.pas

@@ -159,6 +159,7 @@ type
       function    GetTopicInfo(T: PTopic) : string; virtual;
       function    SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
       function    ReadTopic(T: PTopic): boolean; virtual;
+      function    FormatLink(const s:String):string; virtual;
     private
       DefaultFileName: string;
       CurFileName: string;
@@ -183,6 +184,7 @@ type
       function    ReadTopic(T: PTopic): boolean; virtual;
       function    GetTopicInfo(T: PTopic) : string; virtual;
       function    SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
+      function    FormatLink(const s:String):string; virtual;
     private
       Chmw: TCHMWrapper;
     end;
@@ -1362,6 +1364,11 @@ begin
   SearchTopic:=P;
 end;
 
+function TCustomHTMLHelpFile.FormatLink(const s:String):string;
+begin
+ formatlink:=formatpath(s);
+end;
+
 function TCustomHTMLHelpFile.GetTopicInfo(T: PTopic) : string;
 var OK: boolean;
     Name: string;
@@ -1384,7 +1391,7 @@ begin
           DebugMessageS({$i %file%},'(Topicinfo) Link before formatpath "'+link+'"',{$i %line%},'1',0,0);
 {$ENDIF WDEBUG}
           
-          Link:=FormatPath(Link);
+          Link:=FormatLink(Link);
 {$IFDEF WDEBUG}
           DebugMessageS({$i %file%},'(Topicinfo) Link after formatpath "'+link+'"',{$i %line%},'1',0,0);
 {$ENDIF WDEBUG}
@@ -1598,6 +1605,12 @@ begin
     loadindex:=chmw.loadindex(id,TopicLinks,IndexEntries,helpfacility);
 end;
 
+function TCHMHelpFile.FormatLink(const s:String):string;
+// do not reformat for chms, we assume them internally consistent.
+begin
+ formatlink:=s;
+end;
+
 function TChmHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
 function MatchCtx(P: PTopic): boolean;
 begin
@@ -1683,9 +1696,9 @@ begin
 {$IFDEF WDEBUG}
           DebugMessageS({$i %file%},' Looking for  "'+Link+'"',{$i %line%},'1',0,0);
 {$endif WDEBUG}
-          Link:=FormatPath(Link);
+          Link:=FormatLink(Link);
 {$IFDEF WDEBUG}
-          DebugMessageS({$i %file%},' Looking for (after formatpath)  "'+Link+'"',{$i %line%},'1',0,0);
+          DebugMessageS({$i %file%},' Looking for (after formatlink)  "'+Link+'"',{$i %line%},'1',0,0);
 {$endif WDEBUG}
           P:=Pos('#',Link);
           if P>0 then

packages/a52/fpmake.pp

@@ -16,7 +16,7 @@ begin
     P:=AddPackage('a52');
     P.Author := 'Library: Michel Lespinasse and Aaron Holtzman, header: Ivo Steimann';
     P.License := 'Library: GPL2 or later, header: LGPL with modification';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'A free library for decoding ATSC A/52 streams.';
     P.NeedLibC:= true;

packages/amunits/fpmake.pp

@@ -20,7 +20,7 @@ begin
 
     P.Author := 'Nils Sjoholm';
     P.License := 'LGPL with modification';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'A set of units for Amiga OS. 68k only?';
     P.NeedLibC:= false;

packages/aspell/fpmake.pp

@@ -20,7 +20,7 @@ begin
 
     P.Author := 'header:Aleš Katona, library: Kevin Atkinson';
     P.License := 'header: LGPL with modification, library: LGPL 2.0 or 2.1';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'The New Aspell, spelling library';
     P.NeedLibC:= true;

packages/bfd/fpmake.pp

@@ -19,7 +19,7 @@ begin
     P.Version:='2.2.2-0';
     P.Author := 'Library: Cygnus Support, header: by Uli Tessel';
     P.License := 'Library: GPL2 or later, header: LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Binary File Descriptor library.';
     P.NeedLibC:= true;

packages/bzip2/fpmake.pp

@@ -22,7 +22,7 @@ begin
     P.Author := 'Library: Julian R. Seward, header: Daniel Mantione';
     // 3 clause becaue "prominent notice" is not required.
     P.License := 'Library: 3 clause BSD, header: 3 clause BSD ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'BZip2 decompression unit.';
     P.NeedLibC:= true;

packages/cairo/fpmake.pp

@@ -18,7 +18,7 @@ begin
     P.Version:='2.2.2-0';
     P.Author :=  'Library:  University of Southern California + Red Hat Inc., header: Luiz AmXrico Pereira CXmara';
     P.License := 'Library: MPL 1.1 + LGPL-2.1, header: LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'a vector graphics library with display and print output';
     P.NeedLibC:= true;

packages/cdrom/fpmake.pp

@@ -21,7 +21,7 @@ begin
 
     P.Author := 'Michael van Canneyt';
     P.License := 'LGPL with modification';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Unit to read a CDROM disc TOC and get a list of CD Rom devices';
     P.NeedLibC:= False;

packages/chm/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/25]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -439,178 +439,178 @@ ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_PROGRAMS+=chmcmd chmls
 endif
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer chmfiftimain
 endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)

packages/chm/Makefile.fpc

@@ -8,7 +8,8 @@ version=2.2.2
 
 [target]
 units=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes \
-      chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader  
+      chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader htmlindexer \
+      chmfiftimain
 programs=chmcmd chmls
 examples=
 

packages/chm/fpmake.pp

@@ -21,7 +21,7 @@ begin
 
     P.Author := 'Andrew Haines';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Standalone CHM reader and writer library';
     P.NeedLibC:= false;
@@ -59,6 +59,12 @@ begin
         begin
           AddUnit('chmbase');
         end;
+    T:=P.Targets.AddUnit('htmlindexer.pas');
+      with T.Dependencies do
+        begin
+          AddUnit('fasthtmlparser');
+          AddUnit('htmlutil');
+        end;
     T:=P.Targets.AddUnit('chmwriter.pas');
       with T.Dependencies do
         begin
@@ -66,6 +72,7 @@ begin
           AddUnit('chmtypes');
           AddUnit('chmspecialfiles');
           AddUnit('paslzxcomp');
+          AddUnit('chmfiftimain');
         end;
     T:=P.Targets.AddUnit('fasthtmlparser.pas');
     T:=P.Targets.AddUnit('htmlutil.pas');
@@ -76,6 +83,11 @@ begin
         begin
           AddUnit('paslznonslide');
         end;
+    T:=P.Targets.AddUnit('chmfiftimain.pas');
+      with T.Dependencies do
+        begin
+          AddUnit('htmlindexer');
+        end;
 
 //    P.ProgramPath.Add('src');
     T:=P.Targets.AddProgram('chmls.lpr');

packages/chm/src/chmbase.pas

@@ -171,7 +171,7 @@ var
   Value: QWord = 0;
   TheEnd: DWord = 0;
 begin
-  bit := (sizeof(dWord)*8)div 7*7;
+  bit := 28; //((sizeof(dWord)*8)div 7)*7; // = 28
   buf := @Value;
   while True do begin
     mask := $7f shl bit;

packages/chm/src/chmfiftimain.pas

@@ -0,0 +1,1059 @@
+{ Copyright (C) <2008> <Andrew Haines> chmfiftimain.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit chmFiftiMain;
+{$mode objfpc}{$H+}
+interface
+
+uses Classes, HTMLIndexer;
+
+type
+  TFiftiMainHeader = record
+    Sig: array [0..3] of byte;  //$00,$00,$28,$00
+    HTMLFilesCount: DWord;
+    RootNodeOffset: DWord;
+    Unknown1: DWord; // = 0
+    LeafNodeCount: DWord;
+    CopyOfRootNodeOffset: DWord;
+    TreeDepth: Word;
+    Unknown2: DWord; // = 7
+    DocIndexScale: Byte;
+    DocIndexRootSize: Byte;
+    CodeCountScale: Byte;
+    CodeCountRootSize: Byte;
+    LocationCodeScale: Byte;
+    LocationCodeRootSize: Byte;
+    Unknown3: array[0..9] of byte; // = 0
+    NodeSize: DWord; // 4096;
+    Unknown4: DWord; // 0 or 1;
+    LastDupWordIndex: DWord;
+    LastDupCharIndex: DWord;
+    LongestWordLength: DWord; // maximum 99
+    TotalWordsIndexed: DWord; // includes duplicates
+    TotalWords: DWord; // word count not including duplicates
+    TotalWordsLengthPart1: DWord; // length of all the words with duplicates plus the next dword!
+    TotalWordsLengthPart2: DWord;
+    TotalWordsLength: DWord; // length of all words not including duplicates
+    WordBlockUnusedBytes: DWord; // who knows, this makes no sense when there are more than one blocks
+    Unknown5: DWord; // 0
+    HTMLFilesCountMinusOne: DWord; // maybe
+    Unknown6: array[0..23] of Byte; // 0
+    WindowsCodePage: DWord; // usually 1252
+    LocalID: DWord;
+    //Unknown7: array [0..893] of Byte; // 0
+  end;
+
+  { TFIftiNode }
+
+  TFIftiNode = class(TObject)
+    FLastWord: String;
+    FWriteStream: TStream;
+    FBlockStream: TMemoryStream;
+    ParentNode: TFIftiNode;
+    function  AdjustedWord(AWord: String; out AOffset: Byte; AOldWord: String): String;
+    procedure ChildIsFull(AWord: String; ANodeOffset: DWord); virtual; abstract;
+    function  GuessIfCanHold(AWord: String): Boolean; virtual; abstract;
+    procedure Flush(NewBlockNeeded: Boolean); virtual; abstract;
+    procedure FillRemainingSpace;
+    function  RemainingSpace: DWord;
+    constructor Create(AStream: TStream);
+    destructor Destroy; override;
+  end;
+
+  { TChmSearchWriter }
+
+  TChmSearchWriter = class(TObject)
+  private
+    FHeaderRec: TFiftiMainHeader;
+    FStream: TStream;
+    FWordList: TIndexedWordList;
+    FActiveLeafNode: TFIftiNode;
+    procedure ProcessWords;
+    procedure WriteHeader(IsPlaceHolder: Boolean);
+    procedure WriteAWord(AWord: TIndexedWord);
+  public
+    procedure WriteToStream;
+    constructor Create(AStream: TStream; AWordList: TIndexedWordList);
+  end;
+
+  { TChmSearchReader }
+
+  TChmWLCTopic = record
+    TopicIndex: DWord;
+    LocationCodes: array of DWord;
+  end;
+
+  TChmWLCTopicArray = array of TChmWLCTopic;
+
+  TChmSearchReader = class;
+
+  TChmSearchReaderFoundDataEvent = procedure(Sender: TChmSearchReader; AWord: String; ATopic: DWord; AWordIndex: DWord) of object;
+
+  TChmSearchReader = class(TObject)
+  private
+    FStream: TStream;
+    FFileIsValid: Boolean;
+    FFreeStreamOnDestroy: Boolean;
+    FDocRootSize,
+    FCodeCountRootSize,
+    FLocCodeRootSize: Integer;
+    FTreeDepth: Integer;
+    FRootNodeOffset: DWord;
+    FActiveNodeStart: DWord;
+    FActiveNodeFreeSpace: Word;
+    FNextLeafNode: DWord;
+    procedure ReadCommonData;
+    procedure MoveToFirstLeafNode;
+    procedure MoveToRootNode;
+    procedure MoveToNode(ANodeOffset: DWord; ANodeDepth: Integer);
+    function  ReadWordOrPartialWord(ALastWord: String): String; // returns the whole word using the last word as a base
+    function  ReadIndexNodeEntry(ALastWord: String; out AWord: String; out ASubNodeStart: DWord): Boolean;
+    function  ReadLeafNodeEntry(ALastWord: String; out AWord: String; out AInTitle: Boolean; out AWLCCount: DWord; out AWLCOffset: DWord; out AWLCSize: DWord): Boolean;
+    function  ReadWLCEntries(AWLCCount: DWord; AWLCOffset: DWord; AWLCSize: DWord): TChmWLCTopicArray;
+  public
+    constructor Create(AStream: TStream; AFreeStreamOnDestroy: Boolean);
+    destructor  Destroy; override;
+    procedure   DumpData(AFoundDataEvent: TChmSearchReaderFoundDataEvent);
+    function    LookupWord(AWord: String; out ATitleHits: TChmWLCTopicArray): TChmWLCTopicArray;
+    property    FileIsValid: Boolean read FFileIsValid;
+  end;
+
+const
+  FIFTI_NODE_SIZE = 4096;
+
+implementation
+uses SysUtils, Math, ChmBase;
+
+type
+
+{ TIndexNode }
+
+  TIndexNode = class(TFIftiNode)
+    function  GuessIfCanHold(AWord: String): Boolean; override;
+    procedure ChildIsFull ( AWord: String; ANodeOffset: DWord ); override;
+    procedure Flush(NewBlockNeeded: Boolean); override;
+  end;
+
+  { TLeafNode }
+
+  TLeafNode = class(TFIftiNode)
+    FLeafNodeCount: DWord;
+    FLastNodeStart: DWord;
+    FreeSpace: DWord;
+    FDocRootSize,
+    FCodeRootSize,
+    FLocRootSize: Byte;
+    procedure WriteInitialHeader;
+    Destructor Destroy; override;
+    function  GuessIfCanHold(AWord: String): Boolean; override;
+    procedure Flush(NewBlockNeeded: Boolean); override;
+    procedure AddWord(AWord: TIndexedWord);
+    function WriteWLCEntries(AWord: TIndexedWord; ADocRootSize, ACodeRootSize, ALocRootSize: Byte): DWord;
+    property LeafNodeCount: DWord read FLeafNodeCount;
+    property DocRootSize: Byte read FDocRootSize write FDocRootSize;
+    property CodeRootSize: Byte read FCodeRootSize write FCodeRootSize;
+    property LocRootSize: Byte read FLocRootSize write FLocRootSize;
+  end;
+
+function GetCompressedIntegerBE(Stream: TStream): DWord;
+var
+  Buf: Byte;
+  Value: Dword = 0;
+  Shift: Integer = 0;
+begin
+  repeat
+    Buf := Stream.ReadByte;
+    Value := Value or  (Buf and $7F) shl Shift;
+    Inc(Shift, 7);
+  until (Buf and $80) = 0;
+  Result := Value;
+end;
+
+procedure WriteCompressedIntegerBE(Stream: TStream; AInt: DWord);
+var
+  Bits: Integer;
+  Tmp: DWord;
+  Buf: Byte;
+begin
+  Tmp := AInt;
+  Bits := 0;
+  while Tmp <> 0 do
+  begin
+    Tmp := Tmp shr 1;
+    Inc(Bits);
+  end;
+
+  repeat
+    Buf := (AInt shr (Tmp * 7)) and $7F;
+    if Bits > 7 then
+      Buf := Buf or $80;
+    Dec(Bits, 7);
+    Inc(Tmp);
+    Stream.WriteByte(Buf);
+  until Bits <= 0;
+end;
+
+function WriteScaleRootInt(ANumber: DWord; out Bits: DWord; Root: Integer): Byte;
+var
+  Tmp: DWord;
+  Mask: DWord;
+//  Scale: Integer;
+  NeededBits: Integer;
+  PrefixBits: Integer;
+  RootBits: Integer;
+begin
+//  Scale := 2;
+  Bits := 0;
+  Result := Root;
+
+  Tmp := ANumber;
+  NeededBits := 0;
+  while Tmp <> 0 do
+  begin
+    Inc(NeededBits);
+    Tmp := Tmp shr 1;
+  end;
+  PrefixBits := Max(0, NeededBits-Root);
+
+  RootBits := NeededBits -1; //
+  if RootBits < Root then
+    RootBits := Root;
+  if RootBits < 0 then
+    RootBits := 0;
+
+  Mask := 0;
+  if RootBits-1 >= 0 then
+    for Tmp := 0 to RootBits-1 do
+       Mask := Mask or (DWord(1) shl Tmp);
+  Bits := not Mask;
+  Bits := Bits shl 1; // make space for empty bit
+  Bits := Bits or (ANumber and Mask);
+
+  Result := PrefixBits + 1 + RootBits;
+  Bits := (Bits shl (32-Result)) shr (32 - Result);
+end;
+
+
+
+{ TChmSearchWriter }
+
+procedure TChmSearchWriter.ProcessWords;
+var
+  AWord: TIndexedWord;
+begin
+  AWord := FWordList.FirstWord;
+  while AWord <> nil do
+  begin
+    WriteAWord(AWord);
+    AWord := AWord.NextWord;
+  end;
+  if FActiveLeafNode <> nil then
+    FActiveLeafNode.Flush(False); // causes the unwritten parts of the tree to be written
+end;
+
+procedure TChmSearchWriter.WriteHeader ( IsPlaceHolder: Boolean ) ;
+var
+  TmpNode: TFIftiNode;
+  i: Integer;
+begin
+  if IsPlaceHolder then
+  begin
+    FStream.Size := $400; // the header size. we will fill this after the nodes have been determined
+    FStream.Position := $400;
+    FillChar(PChar(TMemoryStream(FStream).Memory)^, $400, 0);
+    FHeaderRec.DocIndexRootSize := 1;
+    FHeaderRec.CodeCountRootSize := 1;
+    FHeaderRec.LocationCodeRootSize := 4;
+    Exit;
+  end;
+  // write the glorious header
+  FHeaderRec.Sig[2] := $28;
+  FHeaderRec.HTMLFilesCount := FWordList.IndexedFileCount;
+  FHeaderRec.RootNodeOffset := FStream.Size-4096;
+  FHeaderRec.LeafNodeCount := TLeafNode(FActiveLeafNode).LeafNodeCount;
+  FHeaderRec.CopyOfRootNodeOffset := FHeaderRec.RootNodeOffset;
+  FHeaderRec.TreeDepth := 0;
+  TmpNode := FActiveLeafNode;
+  while TmpNode <> nil do
+  begin
+    Inc(FHeaderRec.TreeDepth);
+    TmpNode := TmpNode.ParentNode;
+  end;
+  FHeaderRec.DocIndexScale := 2;
+  FHeaderRec.CodeCountScale := 2;
+  FHeaderRec.LocationCodeScale := 2;
+
+  //FHeaderRec.DocIndexRootSize := 15;
+  //FHeaderRec.CodeCountRootSize := 15;
+  //FHeaderRec.LocationCodeRootSize := 15;
+
+  FHeaderRec.NodeSize := 4096;
+  FHeaderRec.LongestWordLength := FWordList.LongestWord;
+  FHeaderRec.TotalWordsIndexed := FWordList.TotalWordCount;
+  FHeaderRec.TotalWords := FWordList.TotalDIfferentWords;
+  FHeaderRec.TotalWordsLengthPart1 := FWordList.TotalWordLength;
+  FHeaderRec.TotalWordsLength := FWordList.TotalDifferentWordLength;
+  FHeaderRec.WindowsCodePage := 1252;
+
+  FStream.Position := 0;
+
+  FStream.Write(FHeaderRec.Sig[0], 4);
+  FStream.WriteDWord(NtoLE(FHeaderRec.HTMLFilesCount));
+  FStream.WriteDWord(NtoLE(FHeaderRec.RootNodeOffset));
+  FStream.WriteDWord(NtoLE(0)); // unknown 1
+  FStream.WriteDWord(NtoLE(FHeaderRec.LeafNodeCount));
+  FStream.WriteDWord(NtoLE(FHeaderRec.RootNodeOffset)); // yes twice
+  FStream.WriteWord(NtoLE(FHeaderRec.TreeDepth));
+  FStream.WriteDWord(NtoLE(DWord(7)));
+  FStream.WriteByte(2);
+  FStream.WriteByte(FHeaderRec.DocIndexRootSize);
+  FStream.WriteByte(2);
+  FStream.WriteByte(FHeaderRec.CodeCountRootSize);
+  FStream.WriteByte(2);
+  FStream.WriteByte(FHeaderRec.LocationCodeRootSize);
+  // eat 10 bytes
+  FStream.WriteWord(0);
+  FStream.WriteDWord(0);
+  FStream.WriteDWord(0);
+
+  FStream.WriteDWord(NtoLE(FHeaderRec.NodeSize));
+  FStream.WriteDWord(NtoLE(DWord(0)));
+  FStream.WriteDWord(1);
+  FStream.WriteDWord(5);
+  FStream.WriteDWord(NtoLE(FHeaderRec.LongestWordLength));
+  FStream.WriteDWord(NtoLE(FHeaderRec.TotalWordsIndexed));
+  FStream.WriteDWord(NtoLE(FHeaderRec.TotalWords));
+  FStream.WriteDWord(NtoLE(FHeaderRec.TotalWordsLengthPart1));
+  FStream.WriteDWord(NtoLE(FHeaderRec.TotalWordsLengthPart2));
+  FStream.WriteDWord(NtoLE(FHeaderRec.TotalWordsLength));
+  FStream.WriteDWord(NtoLE(TLeafNode(FActiveLeafNode).FreeSpace));
+  FStream.WriteDWord(NtoLE(0));
+  FStream.WriteDWord(NtoLE(FHeaderRec.HTMLFilesCount-1));
+  for i := 0 to 23 do FStream.WriteByte(0);
+  FStream.WriteDWord(NtoLE(FHeaderRec.WindowsCodePage));
+  FStream.WriteDWord(NtoLE(DWord(1033))); // LCID
+  for i := 0 to 893 do FStream.WriteByte(0);
+end;
+
+procedure TChmSearchWriter.WriteAWord ( AWord: TIndexedWord ) ;
+begin
+  if FActiveLeafNode = nil then
+  begin
+    FActiveLeafNode := TLeafNode.Create(FStream);
+    with TLeafNode(FActiveLeafNode) do
+    begin
+      DocRootSize := FHeaderRec.DocIndexRootSize;
+      CodeRootSize := FHeaderRec.CodeCountRootSize;
+      LocRootSize := FHeaderRec.LocationCodeRootSize;
+    end;
+  end;
+
+  if FActiveLeafNode.GuessIfCanHold(AWord.TheWord) = False then
+  begin
+    FActiveLeafNode.Flush(True);
+  end;
+  TLeafNode(FActiveLeafNode).AddWord(AWord);
+end;
+
+
+procedure TChmSearchWriter.WriteToStream;
+begin
+  WriteHeader(True);
+  ProcessWords;
+  WriteHeader(False);
+end;
+
+constructor TChmSearchWriter.Create ( AStream: TStream;
+  AWordList: TIndexedWordList ) ;
+begin
+  FStream := AStream;
+  FWordList := AWordList;
+
+end;
+
+{ TLeafNode }
+
+function TFIftiNode.RemainingSpace: DWord;
+begin
+  Result := FIFTI_NODE_SIZE - FBlockStream.Position;
+end;
+
+constructor TFIftiNode.Create ( AStream: TStream ) ;
+begin
+  inherited Create;
+  FWriteStream := AStream;
+  FBlockStream := TMemoryStream.Create;
+end;
+
+destructor TFIftiNode.Destroy;
+begin
+  FBlockStream.Free;
+  inherited Destroy;
+end;
+
+procedure TFIftiNode.FillRemainingSpace;
+begin
+  while RemainingSpace > 0 do
+    FBlockStream.WriteByte(0);
+end;
+
+function TFIftiNode.AdjustedWord ( AWord: String; out AOffset: Byte; AOldWord: String ) : String;
+var
+  Count1,
+  Count2: Integer;
+  Count: Integer;
+  i: Integer;
+begin
+  if AWord = AOldWord then
+  begin
+    AOffset := Length(AWord);
+    Exit('');
+  end;
+  // else
+  Count1 := Length(AOldWord);
+  Count2 := Length(AWord);
+
+  if Count1<Count2 then
+    Count := Count1
+  else
+    Count := Count2;
+
+  for i := 1 to Count do
+  begin
+    AOffset := i-1;
+    if AOldWord[i] <> AWord[i]
+      then Exit(Copy(AWord, i, Length(AWord)));
+  end;
+  Result := AWord;
+  AOffset := 0;
+end;
+
+procedure TLeafNode.WriteInitialHeader;
+begin
+  FBlockStream.WriteDWord(0);
+  FBlockStream.WriteWord(0);
+  FBlockStream.WriteWord(0);
+end;
+
+destructor TLeafNode.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TLeafNode.GuessIfCanHold ( AWord: String ) : Boolean;
+var
+  WordOffset: Byte;
+begin
+  Result := 17 + Length(AdjustedWord(AWord, WordOffset, FLastWord)) < RemainingSpace;
+end;
+
+procedure TLeafNode.Flush(NewBlockNeeded: Boolean);
+var
+  FTmpPos: DWord;
+begin
+  Inc(FLeafNodeCount);
+  FTmpPos := FWriteStream.Position;
+  // update the previous leaf node about our position.
+  if FLastNodeStart > 0 then
+  begin
+    FWriteStream.Position := FLastNodeStart;
+    FWriteStream.WriteDWord(NtoLE(FTmpPos));
+    FWriteStream.Position := FTmpPos;
+  end;
+  FLastNodeStart := FTmpPos;
+
+  FreeSpace := RemainingSpace;
+
+  FillRemainingSpace;
+
+  // update the leaf header to show the available space.
+  FBlockStream.Position := 6;
+  FBlockStream.WriteWord(NtoLE(Word(FreeSpace)));
+
+  // copy the leaf block to the fiftimain file
+  FBlockStream.Position := 0;
+  FWriteStream.CopyFrom(FBlockStream, FIFTI_NODE_SIZE);
+  FBlockStream.Position := 0;
+
+  if NewBlockNeeded or ((NewBlockNeeded = False) and (ParentNode <> nil)) then
+  begin
+    if ParentNode = nil then
+      ParentNode := TIndexNode.Create(FWriteStream);
+
+    ParentNode.ChildIsFull(FLastWord, FLastNodeStart);
+    if (NewBlockNeeded = False) then
+      ParentNode.Flush(False);
+  end;
+
+  FLastWord := '';
+end;
+
+procedure TLeafNode.AddWord ( AWord: TIndexedWord ) ;
+var
+  Offset: Byte;
+  NewWord: String;
+  WLCSize: DWord;
+begin
+  if Length(AWord.TheWord) > 99 then
+    Exit; // Maximum word length is 99
+  if FBlockStream.Position = 0 then
+    WriteInitialHeader;
+
+  NewWord := AdjustedWord(AWord.TheWord, Offset, FLastWord);
+
+  FLastWord := AWord.TheWord;
+
+  FBlockStream.WriteByte(Length(NewWord)+1);
+  FBlockStream.WriteByte(Offset);
+  FBlockStream.Write(NewWord[1], Length(Trim(NewWord)));
+  FBlockStream.WriteByte(Ord(AWord.IsTitle));
+  WriteCompressedIntegerBE(FBlockStream, AWord.DocumentCount);
+  FBlockStream.WriteDWord(NtoLE(DWord(FWriteStream.Position)));
+  FBlockStream.WriteWord(0);
+
+  // write WLC to FWriteStream so we can write the size of the wlc entries
+  WLCSize := WriteWLCEntries(AWord, FDocRootSize, FCodeRootSize, FLocRootSize);
+
+  WriteCompressedIntegerBE(FBlockStream, WLCSize);
+end;
+
+function Min(AValue, BValue: Byte): Byte;
+begin
+  if AValue < BValue then
+    Result := AValue
+  else Result := BValue;
+end;
+
+function Max(AValue, BValue: Byte): Byte;
+begin
+  if AValue > BValue then
+    Result := AValue
+  else Result := BValue;
+end;
+
+function Max(AValue, BValue: Integer): Integer;
+begin
+  if AValue > BValue then
+    Result := AValue
+  else Result := BValue;
+end;
+
+function Max(AValue, BValue: DWord): DWord;
+begin
+  if AValue > BValue then
+    Result := AValue
+  else Result := BValue;
+end;
+
+
+
+function TLeafNode.WriteWLCEntries ( AWord: TIndexedWord ; ADocRootSize, ACodeRootSize, ALocRootSize: Byte) : DWord;
+var
+  LastDocIndex: DWord;
+  LastLocCode: DWord;
+  UsedBits: Byte;
+  Buf: Byte;
+  function NewDocDelta(ADocIndex: DWord): DWord;
+  begin
+    Result := ADocIndex - LastDocIndex;
+    LastDocIndex := ADocIndex;
+  end;
+  function NewLocCode(ALocCode: DWord): DWord;
+  begin
+    Result := ALocCode - LastLocCode;
+    LastLocCode := ALocCode;
+  end;
+  procedure AddValue(AValue: DWord; BitCount: Byte);
+  var
+    NeededBits: Byte;
+    Tmp: Byte;
+  begin
+    AValue := AValue shl (32 - BitCount);
+    while BitCount > 0 do
+    begin
+      NeededBits := 8 - UsedBits;
+      Tmp := Hi(Hi(DWord(AValue shr (UsedBits))));
+      Buf := Buf or Tmp;
+      Inc(UsedBits, Min(BitCount, NeededBits));
+      AValue := AValue shl Min(BitCount, NeededBits);
+      Dec(BitCount, Min(BitCount, NeededBits));
+
+      if (UsedBits = 8) then
+      begin
+        FWriteStream.WriteByte(Buf);
+        UsedBits := 0;
+        NeededBits := 0;
+        Buf := 0;
+      end;
+    end;
+  end;
+  procedure FlushBuffer;
+  begin
+    if UsedBits > 0 then
+      FWriteStream.WriteByte(Buf);
+    UsedBits := 0;
+    Buf := 0;
+  end;
+var
+  DocDelta: DWord;
+  LocDelta: DWord;
+  StartPos: DWord;
+  Bits: DWord;
+  BitCount: Byte;
+  i,
+  j: Integer;
+  Doc: TIndexDocument;
+//  proced
+begin
+  StartPos := FWriteStream.Position;
+  LastDocIndex := 0;
+  UsedBits := 0;
+  Buf := 0;
+  for i := 0 to AWord.DocumentCount-1 do
+  begin
+    LastLocCode := 0;
+    Doc := AWord.GetLogicalDocument(i);
+    DocDelta := NewDocDelta(Doc.DocumentIndex);
+    BitCount := WriteScaleRootInt(DocDelta, Bits, ADocRootSize);
+    AddValue(Bits, BitCount);
+    BitCount := WriteScaleRootInt(Length(Doc.WordIndex), Bits, ACodeRootSize);
+    AddValue(Bits, BitCount);
+
+    for j := 0 to High(Doc.WordIndex) do
+    begin
+      LocDelta := NewLocCode(Doc.WordIndex[j]);
+      BitCount := WriteScaleRootInt(LocDelta, Bits, ALocRootSize);
+      AddValue(Bits, BitCount);
+    end;
+    FlushBuffer;
+  end;
+
+
+  Result := FWriteStream.Position-StartPos;
+end;
+
+
+{ TIndexNode }
+
+function TIndexNode.GuessIfCanHold ( AWord: String ) : Boolean;
+var
+  Offset: Byte;
+begin
+  Result := FBlockStream.Position + 8 + Length(AdjustedWord(AWord, Offset, FLastWord)) < FIFTI_NODE_SIZE;
+end;
+
+procedure TIndexNode.ChildIsFull ( AWord: String; ANodeOffset: DWord ) ;
+var
+  Offset: Byte;
+begin
+  if FBlockStream.Position = 0 then
+    FBlockStream.WriteWord(0); // free space at end. updated when the block is flushed
+  if GuessIfCanHold(AWord) = False then
+    Flush(True);
+  AWord := AdjustedWord(AWord, Offset, FLastWord);
+
+  // Write the Index node Entry
+  FBlockStream.WriteByte(Length(AWord)+1);
+  FBlockStream.WriteByte(Offset);
+  FBlockStream.Write(AWord[1], Length(AWord));
+  FBlockStream.WriteDWord(NtoLE(ANodeOffset));
+  FBlockStream.WriteWord(0);
+end;
+
+procedure TIndexNode.Flush ( NewBlockNeeded: Boolean ) ;
+var
+  RemSize: DWord;
+begin
+  if NewBlockNeeded then
+  begin
+    if ParentNode = nil then
+      ParentNode := TIndexNode.Create(FWriteStream);
+  end;
+
+  if ParentNode <> nil then
+    ParentNode.ChildIsFull(FLastWord, FWriteStream.Position);
+
+  RemSize := RemainingSpace;
+  FillRemainingSpace;
+  FBlockStream.Position := 0;
+  FBlockStream.WriteWord(NtoLE(RemSize));
+
+  FBlockStream.Position := 0;
+
+  FWriteStream.CopyFrom(FBlockStream, FIFTI_NODE_SIZE);
+
+  FLastWord := '';
+
+  if NewBlockNeeded then
+    FBlockStream.WriteDWord(0) // placeholder to write free space in when block is full
+  else
+    if ParentNode <> nil then
+      ParentNode.Flush(NewBlockNeeded);
+end;
+
+{ TChmSearchReader }
+
+procedure TChmSearchReader.ReadCommonData;
+var
+  Sig: DWord;
+begin
+   FStream.Position := 0;
+   Sig := LEtoN(FStream.ReadDWord);
+   FFileIsValid :=  Sig = $00280000;
+
+   if not FileIsValid then
+     Exit;
+
+   // root node address
+   FStream.Position := $8;
+   FRootNodeOffset := LEtoN(FStream.ReadDWord);
+
+   // Tree Depth
+   FStream.Position := $18;
+   FTreeDepth := LEtoN(FStream.ReadWord);
+
+   // Root sizes for scale and root integers
+   FStream.Position := $1E;
+   if FStream.ReadByte <> 2 then // we only can read the files when scale is 2
+     FFileIsValid := False;
+   FDocRootSize := FStream.ReadByte;
+
+   if FStream.ReadByte <> 2 then
+     FFileIsValid := False;
+   FCodeCountRootSize := FStream.ReadByte;
+
+   if FStream.ReadByte <> 2 then
+     FFileIsValid := False;
+   FLocCodeRootSize := FStream.ReadByte;
+
+end;
+
+procedure TChmSearchReader.MoveToFirstLeafNode;
+var
+  NodeDepth: Integer;
+  NodeOffset: DWord;
+  LastWord: String;
+  NewWord: String;
+begin
+  NodeDepth := FTreeDepth;
+  MoveToRootNode;
+  while NodeDepth > 1 do
+  begin
+    LastWord := '';
+    ReadIndexNodeEntry(LastWord, NewWord, NodeOffset);
+    Dec(NodeDepth);
+    MoveToNode(NodeOffset, NodeDepth);
+  end;
+end;
+
+procedure TChmSearchReader.MoveToRootNode;
+begin
+  MoveToNode(FRootNodeOffset, FTreeDepth);
+end;
+
+procedure TChmSearchReader.MoveToNode(ANodeOffset: DWord; ANodeDepth: Integer);
+begin
+  FStream.Position := ANodeOffset;
+  FActiveNodeStart := FStream.Position;
+  if ANodeDepth > 1 then
+  begin
+    FnextLeafNode := 0;
+    FActiveNodeFreeSpace := LEtoN(FStream.ReadWord); // empty space at end of node
+  end
+  else
+  begin
+    FnextLeafNode := LEtoN(FStream.ReadDWord);
+    FStream.ReadWord;
+    FActiveNodeFreeSpace := LEtoN(FStream.ReadWord);
+  end;
+end;
+
+function TChmSearchReader.ReadWordOrPartialWord ( ALastWord: String ) : String;
+var
+  WordLength: Integer;
+  CopyLastWordCharCount: Integer;
+begin
+  WordLength := FStream.ReadByte;
+  CopyLastWordCharCount := FStream.ReadByte;
+  if CopyLastWordCharCount > 0 then
+    Result := Copy(ALastWord, 1, CopyLastWordCharCount);
+  SetLength(Result, (WordLength-1) + CopyLastWordCharCount);
+  FStream.Read(Result[1+CopyLastWordCharCount], WordLength-1);
+end;
+
+function TChmSearchReader.ReadIndexNodeEntry (ALastWord: String;  out AWord: String; out
+  ASubNodeStart: DWord ): Boolean;
+begin
+  Result := FStream.Position - FActiveNodeStart < FIFTI_NODE_SIZE - FActiveNodeFreeSpace;
+  if not Result then
+    Exit;
+  AWord := ReadWordOrPartialWord(ALastWord);
+  ASubNodeStart := LEtoN(FStream.ReadDWord);
+  FStream.ReadWord;
+end;
+
+function TChmSearchReader.ReadLeafNodeEntry ( ALastWord: String; out
+  AWord: String; out AInTitle: Boolean; out AWLCCount: DWord; out
+  AWLCOffset: DWord; out AWLCSize: DWord ): Boolean;
+begin
+  Result := FStream.Position - FActiveNodeStart < FIFTI_NODE_SIZE - FActiveNodeFreeSpace;
+  if not Result then
+    Exit;
+  AWord := ReadWordOrPartialWord(ALastWord);
+  AInTitle := FStream.ReadByte = 1;
+  AWLCCount := GetCompressedIntegerBE(FStream);
+  AWLCOffset := LEtoN(FStream.ReadDWord);
+  FStream.ReadWord;
+  AWLCSize := GetCompressedIntegerBE(FStream);
+
+end;
+
+function TChmSearchReader.ReadWLCEntries (AWLCCount: DWord; AWLCOffset: DWord; AWLCSize: DWord ) : TChmWLCTopicArray;
+
+  function AtEndOfWLCEntries: Boolean;
+  begin
+    Result := AWLCOffset + AWLCSize <= FStream.Position;
+  end;
+var
+  Buf: Byte;
+  BitsInBuffer: Integer;
+
+  procedure FillBuffer;
+  begin
+    while (BitsInBuffer = 0) and not AtEndOfWLCEntries do
+    begin
+      Buf := FStream.ReadByte;
+      Inc(BitsInBuffer, 8);
+    end;
+  end;
+
+  function ReadWLC(RootSize: DWord): DWord;
+  var
+    PrefixBits: Integer = 0;
+    BitCount: Integer = 0;
+    RemainingBits: Integer; // only the bits for this number not the bits in buffer
+  begin
+    FillBuffer;
+    Result := 0;
+    while (Buf and $80) > 0 do // find out how many prefix bits there are
+    begin
+      Inc(PrefixBits);
+      Buf := Buf shl 1;
+      Dec(BitsInBuffer);
+      FillBuffer;
+
+    end;
+
+    if PrefixBits > 0 then
+      Result := 1;
+    Inc(BitCount, PrefixBits+1);
+    Buf := Buf shl 1;
+    Dec(BitsInBuffer);
+
+    FillBuffer;
+    Remainingbits := RootSize + Max(Integer(PrefixBits-1), 0);
+    while RemainingBits > 0 do
+    begin
+      Result := Result shl 1;
+      Result := Result or (Buf shr 7);
+      Dec(RemainingBits);
+      Buf := Buf shl 1;
+      Dec(BitsInBuffer);
+      FillBuffer;
+      Inc(BitCount);
+    end;
+  end;
+  procedure ClearBuffer;
+  begin
+    BitsInBuffer := 0;
+    Buf := 0;
+  end;
+
+var
+  TopicHits: DWord;
+  i: Integer;
+  j: Integer;
+  CachedStreamPos: QWord;
+  LastDoc,
+  LastLocCode: DWord;
+begin
+  CachedStreamPos := FStream.Position;
+  FStream.Position := AWLCOffset;
+  {for i := 0 to AWLCSize-1 do
+  begin
+    Buf := FStream.ReadByte;
+    Write(binStr(Buf, 8), ' ');
+  end;}
+  FStream.Position := AWLCOffset;
+  SetLength(Result, AWLCCount);
+  Buf := 0;
+  BitsInBuffer := 0;
+  LastDoc := 0;
+
+  for i := 0 to AWLCCount-1 do
+  begin
+    Result[i].TopicIndex := ReadWLC(FDocRootSize) + LastDoc;
+
+    LastDoc := Result[i].TopicIndex;
+    TopicHits := ReadWLC(FCodeCountRootSize);
+    SetLength(Result[i].LocationCodes, TopicHits);
+    LastLocCode := 0;
+    for j := 0 to TopicHits-1 do
+    begin
+      Result[i].LocationCodes[j] := ReadWLC(FLocCodeRootSize) + LastLocCode;
+      LastLocCode := Result[i].LocationCodes[j];
+    end;
+    ClearBuffer;
+  end;
+  FStream.Position := CachedStreamPos;
+end;
+
+
+
+constructor TChmSearchReader.Create ( AStream: TStream;
+  AFreeStreamOnDestroy: Boolean ) ;
+begin
+  FStream := AStream;
+  FFreeStreamOnDestroy := AFreeStreamOnDestroy;
+  ReadCommonData;
+end;
+
+destructor TChmSearchReader.Destroy;
+begin
+  if FFreeStreamOnDestroy then
+    FreeAndNil(FStream);
+  inherited Destroy;
+end;
+
+procedure TChmSearchReader.DumpData (
+  AFoundDataEvent: TChmSearchReaderFoundDataEvent ) ;
+var
+  LastWord: String;
+  TheWord: String;
+  InTitle: Boolean;
+  WLCCount: DWord;
+  WLCOffset: DWord;
+  WLCSize: DWord;
+  FoundHits: TChmWLCTopicArray;
+  i: Integer;
+  j: Integer;
+begin
+  MoveToFirstLeafNode;
+  LastWord := '';
+  repeat
+    if  (ReadLeafNodeEntry(LastWord, TheWord, InTitle, WLCCount, WLCOffset, WLCSize) = False) then
+    begin
+      if FnextLeafNode <> 0 then
+      begin
+        MoveToNode(FnextLeafNode, 1);
+        LastWord := '';
+      end
+      else
+        Break;
+    end
+    else begin
+      LastWord := TheWord;
+      //WriteLn('Reading Hits for ', TheWord ,' at ', hexstr(WLCOffset,8) );
+      FoundHits := ReadWLCEntries(WLCCount, WLCOffset, WLCSize);
+      //WriteLn('DONE Reading Hits for ', TheWord);
+     // AFoundDataEvent(Self, TheWord, 0,0);//FoundHits[i].TopicIndex ,-1);//FoundHits[i].LocationCodes[j]);
+      for i := 0 to High(FoundHits) do
+        for j := 0 to High(FoundHits[i].LocationCodes) do
+           AFoundDataEvent(Self, TheWord, FoundHits[i].TopicIndex ,FoundHits[i].LocationCodes[j]);
+    end;
+  until False; //FStream.Position - FActiveNodeStart >= FIFTI_NODE_SIZE - FActiveNodeFreeSpace
+end;
+
+function TChmSearchReader.LookupWord(AWord: String; out ATitleHits: TChmWLCTopicArray): TChmWLCTopicArray;
+var
+  LastWord: String;
+  NewWord: String;
+  NodeLevel: Integer;
+  NewNodePosition: DWord;
+  InTitle: Boolean;
+  WLCCount: DWord;
+  WLCOffset: DWord;
+  WLCSize: DWord;
+  CompareResult: Integer;
+  ReadNextResult: Boolean;
+begin
+  AWord := LowerCase(AWord);
+  NodeLevel := FTreeDepth;
+  MoveToRootNode;
+  SetLength(Result, 0);
+  LastWord := '';
+  // descend the index node tree until we find the leafnode
+  while NodeLevel > 1 do begin
+     //WriteLn('At Node Level ', NodeLevel);
+     if ReadIndexNodeEntry(LastWord, NewWord, NewNodePosition) <> False then
+     begin
+       //WriteLn('Found Index Entry: ', NewWord, ' Comparing to ', AWord);
+       if ChmCompareText(NewWord, AWord) >= 0 then
+       begin
+         LastWord := '';
+         Dec(NodeLevel);
+         MoveToNode(NewNodePosition, NodeLevel);
+       end;
+     end
+     else
+       Break;
+  end;
+  if NodeLevel > 1 then
+    Exit; // the entry we are looking for is > than the last entry of the last index node
+
+  // now we are in a leafnode
+  while ReadLeafNodeEntry(LastWord, NewWord, InTitle, WLCCount, WLCOffset, WLCSize) <> False do
+  begin
+    //WriteLn('Found Leaf Entry: ', NewWord, ' Comparing to ', AWord);
+    LastWord := NewWord;
+    CompareResult := ChmCompareText(AWord, NewWord);
+    if CompareResult < 0 then
+      Exit;
+    if CompareResult = 0 then
+    begin
+      if InTitle then
+        ATitleHits := ReadWLCEntries(WLCCount, WLCOffset, WLCSize)
+      else
+        Result := ReadWLCEntries(WLCCount, WLCOffset, WLCSize);
+      // check if the next entry is the same word since there is an entry for titles and for body
+
+      if  (ReadLeafNodeEntry(LastWord, NewWord, InTitle, WLCCount, WLCOffset, WLCSize)) then
+        ReadNextResult := True
+      else if (FNextLeafNode <> 0) then
+      begin
+        MoveToNode(FNextLeafNode, 1);
+        LastWord := '';
+        ReadNextResult := (ReadLeafNodeEntry(LastWord, NewWord, InTitle, WLCCount, WLCOffset, WLCSize));
+      end;
+      if ReadNextResult and (NewWord = AWord) then
+      begin
+        if InTitle then
+          ATitleHits := ReadWLCEntries(WLCCount, WLCOffset, WLCSize)
+        else
+          Result := ReadWLCEntries(WLCCount, WLCOffset, WLCSize);
+      end;
+      Exit;
+    end;
+  end;
+end;
+
+
+end.
+

packages/chm/src/chmobjinstconst.inc

@@ -0,0 +1,282 @@
+{ Copyright (C) <2005> <Andrew Haines> chmobjinstconst.inc
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+type
+  TObjInstEntry = array[0..9] of Byte;
+
+const
+  ObjInstEntries: array [0..255] of TObjInstEntry =(
+($00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
+($07,$00,$01,$00,$01,$01,$01,$01,$00,$00),
+($00,$00,$02,$00,$02,$02,$02,$02,$00,$00),
+($00,$00,$03,$00,$03,$03,$03,$03,$00,$00),
+($00,$00,$04,$00,$04,$04,$04,$04,$00,$00),
+($00,$00,$05,$00,$05,$05,$05,$05,$00,$00),
+($00,$00,$06,$00,$06,$06,$06,$06,$00,$00),
+($00,$00,$07,$00,$07,$07,$07,$07,$00,$00),
+($00,$00,$08,$00,$08,$08,$08,$08,$00,$00),
+($00,$00,$09,$00,$09,$09,$09,$09,$00,$00),
+($00,$00,$0A,$00,$0A,$0A,$0A,$0A,$00,$00),
+($00,$00,$0B,$00,$0B,$0B,$0B,$0B,$00,$00),
+($00,$00,$0C,$00,$0C,$0C,$0C,$0C,$00,$00),
+($00,$00,$0D,$00,$0D,$0D,$0D,$0D,$00,$00),
+($00,$00,$0E,$00,$0E,$0E,$14,$14,$00,$00),
+($00,$00,$0F,$00,$0F,$0F,$0F,$0F,$00,$00),
+($00,$00,$10,$00,$10,$10,$10,$10,$00,$00),
+($00,$00,$11,$00,$11,$11,$11,$11,$00,$00),
+($00,$00,$12,$00,$12,$12,$12,$12,$00,$00),
+($00,$00,$13,$00,$13,$13,$13,$13,$00,$00),
+($00,$00,$20,$00,$14,$14,$14,$14,$00,$00),
+($00,$00,$15,$00,$15,$15,$15,$15,$00,$00),
+($00,$00,$16,$00,$16,$16,$16,$16,$00,$00),
+($00,$00,$17,$00,$17,$17,$17,$17,$00,$00),
+($00,$00,$18,$00,$18,$18,$18,$18,$00,$00),
+($00,$00,$19,$00,$19,$19,$19,$19,$00,$00),
+($00,$00,$1A,$00,$1A,$1A,$1A,$1A,$00,$00),
+($00,$00,$1B,$00,$1B,$1B,$1B,$1B,$00,$00),
+($00,$00,$1C,$00,$1C,$1C,$1C,$1C,$00,$00),
+($00,$00,$1D,$00,$1D,$1D,$1D,$1D,$00,$00),
+($00,$00,$1E,$00,$1E,$1E,$1E,$1E,$00,$00),
+($00,$00,$1F,$00,$1F,$1F,$1F,$1F,$00,$00),
+($00,$00,$20,$00,$20,$20,$20,$20,$00,$00),
+($00,$00,$23,$00,$21,$21,$21,$21,$00,$00),
+($00,$00,$28,$00,$22,$22,$22,$22,$00,$00),
+($00,$00,$2D,$00,$23,$23,$23,$23,$00,$00),
+($00,$00,$32,$00,$24,$24,$24,$24,$00,$00),
+($00,$00,$37,$00,$25,$25,$25,$25,$00,$00),
+($00,$00,$3C,$00,$26,$26,$26,$26,$00,$00),
+($06,$00,$41,$00,$27,$27,$27,$27,$00,$00),
+($00,$00,$46,$00,$28,$28,$28,$28,$00,$00),
+($00,$00,$4B,$00,$29,$29,$29,$29,$00,$00),
+($09,$00,$50,$00,$2A,$2A,$2A,$2A,$00,$00),
+($00,$00,$55,$00,$2B,$2B,$2B,$2B,$00,$00),
+($04,$00,$5A,$00,$2C,$2C,$2C,$2C,$00,$00),
+($00,$00,$5F,$00,$2D,$2D,$2D,$2D,$00,$00),
+($05,$00,$64,$00,$2E,$2E,$2E,$2E,$00,$00),
+($00,$00,$69,$00,$2F,$2F,$2F,$2F,$00,$00),
+($03,$00,$60,$04,$30,$30,$30,$30,$00,$00),
+($03,$00,$6A,$04,$31,$31,$31,$31,$00,$00),
+($03,$00,$74,$04,$32,$32,$32,$32,$00,$00),
+($03,$00,$7E,$04,$33,$33,$33,$33,$00,$00),
+($03,$00,$88,$04,$34,$34,$34,$34,$00,$00),
+($03,$00,$92,$04,$35,$35,$35,$35,$00,$00),
+($03,$00,$9C,$04,$36,$36,$36,$36,$00,$00),
+($03,$00,$A6,$04,$37,$37,$37,$37,$00,$00),
+($03,$00,$B0,$04,$38,$38,$38,$38,$00,$00),
+($03,$00,$BA,$04,$39,$39,$39,$39,$00,$00),
+($00,$00,$6E,$00,$3A,$3A,$3A,$3A,$00,$00),
+($00,$00,$73,$00,$3B,$3B,$3B,$3B,$00,$00),
+($00,$00,$78,$00,$3C,$3C,$3C,$3C,$00,$00),
+($00,$00,$7D,$00,$3D,$3D,$3D,$3D,$00,$00),
+($00,$00,$82,$00,$3E,$3E,$3E,$3E,$00,$00),
+($09,$00,$87,$00,$3F,$3F,$3F,$3F,$00,$00),
+($00,$00,$8C,$00,$40,$40,$40,$40,$00,$00),
+($02,$00,$CE,$04,$61,$41,$41,$41,$00,$00),
+($02,$00,$E2,$04,$62,$42,$42,$42,$00,$00),
+($02,$00,$F6,$04,$63,$43,$43,$43,$00,$00),
+($02,$00,$0A,$05,$64,$44,$44,$44,$00,$00),
+($02,$00,$1E,$05,$65,$45,$45,$45,$00,$00),
+($02,$00,$32,$05,$66,$46,$46,$46,$00,$00),
+($02,$00,$46,$05,$67,$47,$47,$47,$00,$00),
+($02,$00,$5A,$05,$68,$48,$48,$48,$00,$00),
+($02,$00,$6E,$05,$69,$49,$49,$49,$00,$00),
+($02,$00,$82,$05,$6A,$4A,$4A,$4A,$00,$00),
+($02,$00,$96,$05,$6B,$4B,$4B,$4B,$00,$00),
+($02,$00,$AA,$05,$6C,$4C,$4C,$4C,$00,$00),
+($02,$00,$BE,$05,$6D,$4D,$4D,$4D,$00,$00),
+($02,$00,$D2,$05,$6E,$4E,$4E,$4E,$00,$00),
+($02,$00,$E6,$05,$6F,$4F,$4F,$4F,$00,$00),
+($02,$00,$FA,$05,$70,$50,$50,$50,$00,$00),
+($02,$00,$0E,$06,$71,$51,$51,$51,$00,$00),
+($02,$00,$22,$06,$72,$52,$52,$52,$00,$00),
+($02,$00,$36,$06,$73,$53,$53,$53,$00,$00),
+($02,$00,$4A,$06,$74,$54,$54,$54,$00,$00),
+($02,$00,$5E,$06,$75,$55,$55,$55,$00,$00),
+($02,$00,$72,$06,$76,$56,$56,$56,$00,$00),
+($02,$00,$86,$06,$77,$57,$57,$57,$00,$00),
+($02,$00,$9A,$06,$78,$58,$58,$58,$00,$00),
+($02,$00,$AE,$06,$79,$59,$59,$59,$00,$00),
+($02,$00,$C2,$06,$7A,$5A,$5A,$5A,$00,$00),
+($00,$00,$91,$00,$5B,$5B,$5B,$5B,$00,$00),
+($00,$00,$96,$00,$5C,$5C,$5C,$5C,$00,$00),
+($00,$00,$9B,$00,$5D,$5D,$5D,$5D,$00,$00),
+($00,$00,$A0,$00,$5E,$5E,$5E,$5E,$00,$00),
+($01,$00,$A5,$00,$5F,$5F,$5F,$5F,$00,$00),
+($00,$00,$AA,$00,$60,$60,$60,$60,$00,$00),
+($01,$00,$CE,$04,$61,$61,$61,$61,$00,$00),
+($01,$00,$E2,$04,$62,$62,$62,$62,$00,$00),
+($01,$00,$F6,$04,$63,$63,$63,$63,$00,$00),
+($01,$00,$0A,$05,$64,$64,$64,$64,$00,$00),
+($01,$00,$1E,$05,$65,$65,$65,$65,$00,$00),
+($01,$00,$32,$05,$66,$66,$66,$66,$00,$00),
+($01,$00,$46,$05,$67,$67,$67,$67,$00,$00),
+($01,$00,$5A,$05,$68,$68,$68,$68,$00,$00),
+($01,$00,$6E,$05,$69,$69,$69,$69,$00,$00),
+($01,$00,$82,$05,$6A,$6A,$6A,$6A,$00,$00),
+($01,$00,$96,$05,$6B,$6B,$6B,$6B,$00,$00),
+($01,$00,$AA,$05,$6C,$6C,$6C,$6C,$00,$00),
+($01,$00,$BE,$05,$6D,$6D,$6D,$6D,$00,$00),
+($01,$00,$D2,$05,$6E,$6E,$6E,$6E,$00,$00),
+($01,$00,$E6,$05,$6F,$6F,$6F,$6F,$00,$00),
+($01,$00,$FA,$05,$70,$70,$70,$70,$00,$00),
+($01,$00,$0E,$06,$71,$71,$71,$71,$00,$00),
+($01,$00,$22,$06,$72,$72,$72,$72,$00,$00),
+($01,$00,$36,$06,$73,$73,$73,$73,$00,$00),
+($01,$00,$4A,$06,$74,$74,$74,$74,$00,$00),
+($01,$00,$5E,$06,$75,$75,$75,$75,$00,$00),
+($01,$00,$72,$06,$76,$76,$76,$76,$00,$00),
+($01,$00,$86,$06,$77,$77,$77,$77,$00,$00),
+($01,$00,$9A,$06,$78,$78,$78,$78,$00,$00),
+($01,$00,$AE,$06,$79,$79,$79,$79,$00,$00),
+($01,$00,$C2,$06,$7A,$7A,$7A,$7A,$00,$00),
+($00,$00,$AF,$00,$7B,$7B,$7B,$7B,$00,$00),
+($00,$00,$B4,$00,$7C,$7C,$7C,$7C,$00,$00),
+($00,$00,$B9,$00,$7D,$7D,$7D,$7D,$00,$00),
+($00,$00,$BE,$00,$7E,$7E,$7E,$7E,$00,$00),
+($00,$00,$BF,$00,$7F,$7F,$7F,$7F,$00,$00),
+($00,$00,$C0,$00,$80,$80,$20,$20,$00,$00),
+($00,$00,$C1,$00,$81,$81,$20,$20,$00,$00),
+($00,$00,$C3,$00,$82,$82,$E2,$E2,$00,$00),
+($00,$00,$C8,$00,$83,$83,$C4,$C4,$00,$00),
+($00,$00,$CD,$00,$84,$84,$E3,$E3,$00,$00),
+($00,$00,$D2,$00,$85,$85,$C9,$C9,$00,$00),
+($00,$00,$D7,$00,$86,$86,$A0,$A0,$00,$00),
+($00,$00,$DC,$00,$87,$87,$E0,$E0,$00,$00),
+($00,$00,$E1,$00,$88,$88,$5E,$5E,$00,$00),
+($00,$00,$E6,$00,$89,$89,$E4,$E4,$00,$00),
+($02,$00,$36,$06,$73,$8A,$20,$20,$00,$00),
+($00,$00,$F0,$00,$8B,$8B,$DC,$DC,$00,$00),
+($0C,$00,$E6,$05,$6F,$8C,$CE,$CE,$00,$00),
+($00,$00,$F6,$00,$8D,$8D,$20,$20,$00,$00),
+($00,$00,$F7,$00,$8E,$8E,$20,$20,$00,$00),
+($00,$00,$F8,$00,$8F,$8F,$20,$20,$00,$00),
+($00,$00,$F9,$00,$90,$90,$20,$20,$00,$00),
+($00,$04,$FA,$00,$91,$91,$D4,$D4,$00,$00),
+($00,$05,$FF,$00,$92,$92,$D5,$D5,$00,$00),
+($00,$06,$04,$01,$93,$93,$D2,$D2,$00,$00),
+($00,$07,$09,$01,$94,$94,$D3,$D3,$00,$00),
+($00,$01,$0E,$01,$95,$95,$A5,$A5,$00,$00),
+($00,$02,$13,$01,$96,$96,$D0,$D0,$00,$00),
+($00,$03,$18,$01,$97,$97,$D1,$D1,$00,$00),
+($00,$00,$1D,$01,$98,$98,$7E,$7E,$00,$00),
+($00,$00,$22,$01,$99,$99,$AA,$AA,$00,$00),
+($02,$00,$36,$06,$73,$9A,$20,$20,$00,$00),
+($00,$00,$31,$01,$9B,$9B,$DD,$DD,$00,$00),
+($0C,$00,$E6,$05,$6F,$9C,$CF,$CF,$00,$00),
+($00,$00,$37,$01,$9D,$9D,$20,$20,$00,$00),
+($00,$00,$38,$01,$9E,$9E,$20,$20,$00,$00),
+($02,$00,$AE,$06,$79,$9F,$D9,$D9,$00,$00),
+($00,$00,$3C,$01,$A0,$A0,$A0,$A0,$00,$00),
+($00,$00,$40,$01,$A1,$A1,$C1,$C1,$00,$00),
+($00,$00,$45,$01,$A2,$A2,$A2,$A2,$00,$00),
+($00,$00,$4A,$01,$A3,$A3,$A3,$A3,$00,$00),
+($00,$00,$4F,$01,$A4,$A4,$DB,$DB,$00,$00),
+($00,$00,$54,$01,$A5,$A5,$B4,$B4,$00,$00),
+($00,$00,$59,$01,$A6,$A6,$20,$20,$00,$00),
+($00,$00,$5E,$01,$A7,$A7,$A4,$A4,$00,$00),
+($00,$00,$63,$01,$A8,$A8,$AC,$AC,$00,$00),
+($00,$00,$68,$01,$A9,$A9,$A9,$A9,$00,$00),
+($00,$00,$6D,$01,$AA,$AA,$BB,$BB,$00,$00),
+($00,$00,$72,$01,$AB,$AB,$C7,$C7,$00,$00),
+($00,$00,$77,$01,$AC,$AC,$C2,$C2,$00,$00),
+($00,$00,$7C,$01,$AD,$AD,$2D,$2D,$00,$00),
+($00,$00,$81,$01,$AE,$AE,$A8,$A8,$00,$00),
+($00,$00,$86,$01,$AF,$AF,$F8,$F8,$00,$00),
+($00,$00,$8B,$01,$B0,$B0,$A1,$A1,$00,$00),
+($00,$00,$90,$01,$B1,$B1,$B1,$B1,$00,$00),
+($00,$00,$95,$01,$B2,$B2,$20,$20,$00,$00),
+($00,$00,$9A,$01,$B3,$B3,$20,$20,$00,$00),
+($00,$00,$9F,$01,$B4,$B4,$AB,$AB,$00,$00),
+($00,$00,$A4,$01,$B5,$B5,$B5,$B5,$00,$00),
+($00,$00,$A9,$01,$B6,$B6,$A6,$A6,$00,$00),
+($00,$00,$AE,$01,$B7,$B7,$E1,$E1,$00,$00),
+($00,$00,$B3,$01,$B8,$B8,$FC,$FC,$00,$00),
+($00,$00,$B8,$01,$B9,$B9,$20,$20,$00,$00),
+($00,$00,$BD,$01,$BA,$BA,$BC,$BC,$00,$00),
+($00,$00,$C2,$01,$BB,$BB,$C8,$C8,$00,$00),
+($00,$00,$C7,$01,$BC,$BC,$20,$20,$00,$00),
+($00,$00,$CC,$01,$BD,$BD,$20,$20,$00,$00),
+($00,$00,$D1,$01,$BE,$BE,$20,$20,$00,$00),
+($00,$00,$D6,$01,$BF,$BF,$C0,$C0,$00,$00),
+($02,$00,$CE,$04,$61,$C0,$CB,$CB,$00,$00),
+($02,$00,$CE,$04,$61,$C1,$E7,$E7,$00,$00),
+($02,$00,$CE,$04,$61,$C2,$E5,$E5,$00,$00),
+($02,$00,$CE,$04,$61,$C3,$CC,$CC,$00,$00),
+($02,$00,$CE,$04,$61,$C4,$80,$80,$00,$00),
+($02,$00,$CE,$04,$61,$C5,$81,$81,$00,$00),
+($0C,$00,$CE,$04,$61,$C6,$AE,$AE,$00,$00),
+($02,$00,$F6,$04,$63,$C7,$82,$82,$00,$00),
+($02,$00,$1E,$05,$65,$C8,$E9,$E9,$00,$00),
+($02,$00,$1E,$05,$65,$C9,$83,$83,$00,$00),
+($02,$00,$1E,$05,$65,$CA,$E6,$E6,$00,$00),
+($02,$00,$1E,$05,$65,$CB,$E8,$E8,$00,$00),
+($02,$00,$6E,$05,$69,$CC,$ED,$ED,$00,$00),
+($02,$00,$6E,$05,$69,$CD,$EA,$EA,$00,$00),
+($02,$00,$6E,$05,$69,$CE,$EB,$EB,$00,$00),
+($02,$00,$6E,$05,$69,$CF,$EC,$EC,$00,$00),
+($02,$00,$0A,$05,$64,$D0,$20,$20,$00,$00),
+($02,$00,$D2,$05,$6E,$D1,$84,$84,$00,$00),
+($02,$00,$E6,$05,$6F,$D2,$F1,$F1,$00,$00),
+($02,$00,$E6,$05,$6F,$D3,$EE,$EE,$00,$00),
+($02,$00,$E6,$05,$6F,$D4,$EF,$EF,$00,$00),
+($02,$00,$E6,$05,$6F,$D5,$CD,$CD,$00,$00),
+($02,$00,$E6,$05,$6F,$D6,$85,$85,$00,$00),
+($00,$00,$DB,$01,$D7,$D7,$20,$20,$00,$00),
+($02,$00,$E6,$05,$6F,$D8,$AF,$AF,$00,$00),
+($02,$00,$5E,$06,$75,$D9,$F4,$F4,$00,$00),
+($02,$00,$5E,$06,$75,$DA,$F2,$F2,$00,$00),
+($02,$00,$5E,$06,$75,$DB,$F3,$F3,$00,$00),
+($02,$00,$5E,$06,$75,$DC,$86,$86,$00,$00),
+($02,$00,$AE,$06,$79,$DD,$20,$20,$00,$00),
+($02,$00,$42,$04,$DE,$DE,$20,$20,$00,$00),
+($0C,$00,$36,$06,$73,$DF,$A7,$A7,$00,$00),
+($02,$00,$CE,$04,$61,$E0,$88,$88,$00,$00),
+($02,$00,$CE,$04,$61,$E1,$87,$87,$00,$00),
+($02,$00,$CE,$04,$61,$E2,$89,$89,$00,$00),
+($02,$00,$CE,$04,$61,$E3,$8B,$8B,$00,$00),
+($02,$00,$CE,$04,$61,$E4,$8A,$8A,$00,$00),
+($02,$00,$CE,$04,$61,$E5,$8C,$8C,$00,$00),
+($0C,$00,$CE,$04,$61,$E6,$BE,$BE,$00,$00),
+($02,$00,$F6,$04,$63,$E7,$8D,$8D,$00,$00),
+($02,$00,$1E,$05,$65,$E8,$8F,$8F,$00,$00),
+($02,$00,$1E,$05,$65,$E9,$8E,$8E,$00,$00),
+($02,$00,$1E,$05,$65,$EA,$90,$90,$00,$00),
+($02,$00,$1E,$05,$65,$EB,$91,$91,$00,$00),
+($02,$00,$6E,$05,$69,$EC,$93,$93,$00,$00),
+($02,$00,$6E,$05,$69,$ED,$92,$92,$00,$00),
+($02,$00,$6E,$05,$69,$EE,$94,$94,$00,$00),
+($02,$00,$6E,$05,$69,$EF,$95,$95,$00,$00),
+($02,$00,$0A,$05,$6F,$F0,$20,$20,$00,$00),
+($02,$00,$D2,$05,$6E,$F1,$96,$96,$00,$00),
+($02,$00,$E6,$05,$6F,$F2,$98,$98,$00,$00),
+($02,$00,$E6,$05,$6F,$F3,$97,$97,$00,$00),
+($02,$00,$E6,$05,$6F,$F4,$99,$99,$00,$00),
+($02,$00,$E6,$05,$6F,$F5,$9B,$9B,$00,$00),
+($02,$00,$E6,$05,$6F,$F6,$9A,$9A,$00,$00),
+($00,$00,$66,$00,$F7,$F7,$D6,$D6,$00,$00),
+($02,$00,$E6,$05,$6F,$F8,$BF,$BF,$00,$00),
+($02,$00,$5E,$06,$75,$F9,$9D,$9D,$00,$00),
+($02,$00,$5E,$06,$75,$FA,$9C,$9C,$00,$00),
+($02,$00,$5E,$06,$75,$FB,$9E,$9E,$00,$00),
+($02,$00,$5E,$06,$75,$FC,$9F,$9F,$00,$00),
+($02,$00,$AE,$06,$79,$FD,$20,$20,$00,$00),
+($02,$00,$4C,$04,$FE,$FE,$20,$20,$00,$00),
+($02,$00,$AE,$06,$79,$FF,$D8,$D8,$00,$00)
+);

packages/chm/src/chmreader.pas

@@ -28,7 +28,7 @@ unit chmreader;
 interface
 
 uses
-  Classes, SysUtils, chmbase, paslzx;
+  Classes, SysUtils, chmbase, paslzx, chmFIftiMain;
   
 type
 
@@ -99,14 +99,22 @@ type
     fTitle: String;
     fPreferedFont: String;
     fContextList: TContextList;
+    fTOPICSStream,
+    fURLSTRStream,
+    fURLTBLStream,
+    fStringsStream: TMemoryStream;
     fLocaleID: DWord;
   private
+    FSearchReader: TChmSearchReader;
     procedure ReadCommonData;
+    function  ReadStringsEntry(APosition: DWord): String;
+    function  ReadURLSTR(APosition: DWord): String;
   public
     constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); override;
     destructor Destroy; override;
   public
     function GetContextUrl(Context: THelpContext): String;
+    function LookupTopicByID(ATopicID: Integer; out ATitle: String): String; // returns a url
     function HasContextList: Boolean;
     property DefaultPage: String read fDefaultPage;
     property IndexFile: String read fIndexFile;
@@ -114,6 +122,7 @@ type
     property Title: String read fTitle write fTitle;
     property PreferedFont: String read fPreferedFont;
     property LocaleID: dword read fLocaleID;
+    property SearchReader: TChmSearchReader read FSearchReader write FSearchReader;
   end;
 
   { TChmFileList }
@@ -430,6 +439,41 @@ begin
    {$ENDIF}
 end;
 
+function TChmReader.ReadStringsEntry ( APosition: DWord ) : String;
+begin
+  Result := '';
+  if fStringsStream = nil then
+    fStringsStream := GetObject('/#STRINGS');
+  if fStringsStream = nil then
+    Exit;
+  if APosition < fStringsStream.Size-1 then
+  begin
+    Result := PChar(fStringsStream.Memory+APosition);
+  end;
+end;
+
+function TChmReader.ReadURLSTR ( APosition: DWord ) : String;
+var
+  URLStrURLOffset: DWord;
+begin
+  if fURLSTRStream = nil then
+    fURLSTRStream := GetObject('/#URLSTR');
+  if fURLTBLStream = nil then
+    fURLTBLStream := GetObject('/#URLTBL');
+  if (fURLTBLStream <> nil) and (fURLSTRStream <> nil) then
+  begin
+
+    fURLTBLStream.Position := APosition;
+    fURLTBLStream.ReadDWord; // unknown
+    fURLTBLStream.ReadDWord; // TOPIC index #
+    fURLSTRStream.Position := LEtoN(fURLTBLStream.ReadDWord);
+    fURLSTRStream.ReadDWord;
+    fURLSTRStream.ReadDWord;
+    if fURLSTRStream.Position < fURLSTRStream.Size-1 then
+      Result := '/'+PChar(fURLSTRStream.Memory+fURLSTRStream.Position);
+  end;
+end;
+
 constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
 begin
   inherited Create(AStream, FreeStreamOnDestroy);
@@ -442,6 +486,11 @@ end;
 destructor TChmReader.Destroy;
 begin
   fContextList.Free;
+  FreeAndNil(FSearchReader);
+  FreeAndNil(fTOPICSStream);
+  FreeAndNil(fURLSTRStream);
+  FreeAndNil(fURLTBLStream);
+  FreeAndNil(fStringsStream);
   inherited Destroy;
 end;
 
@@ -658,7 +707,8 @@ var
 
     NameLength := GetCompressedInteger(ChunkStream);
     SetLength(Result, NameLength);
-    ChunkStream.Read(Result[1], NameLength);
+    if NameLength>0 then
+      ChunkStream.Read(Result[1], NameLength);
   end;
 var
   PMGLChunk: TPMGListChunk;
@@ -787,6 +837,31 @@ begin
  Result := fContextList.GetURL(Context);
 end;
 
+function TChmReader.LookupTopicByID ( ATopicID: Integer; out ATitle: String) : String;
+var
+  TopicURLTBLOffset: DWord;
+  TopicTitleOffset: DWord;
+begin
+  Result := '';
+  ATitle := '';
+  //WriteLn('Getting topic# ',ATopicID);
+  if fTOPICSStream = nil then;
+    fTOPICSStream := GetObject('/#TOPICS');
+  if fTOPICSStream = nil then
+    Exit;
+  fTOPICSStream.Position := ATopicID * 16;
+  if fTOPICSStream.Position = ATopicID * 16 then
+  begin
+    fTOPICSStream.ReadDWord;
+    TopicTitleOffset := LEtoN(fTOPICSStream.ReadDWord);
+    TopicURLTBLOffset := LEtoN(fTOPICSStream.ReadDWord);
+    if TopicTitleOffset <> $FFFFFFFF then
+      ATitle := ReadStringsEntry(TopicTitleOffset);
+     //WriteLn('Got a title: ', ATitle);
+    Result := ReadURLSTR(TopicURLTBLOffset);
+  end;
+end;
+
 function TChmReader.HasContextList: Boolean;
 begin
   Result := fContextList.Count > 0;

packages/chm/src/chmsitemap.pas

@@ -186,10 +186,9 @@ procedure TChmSiteMap.FoundTag(ACaseInsensitiveTag, AActualTag: string);
     end;
 var
   TagName,
-  TagAttribute,
+  //TagAttribute,
   TagAttributeName,
   TagAttributeValue: String;
-  I: Integer;
 begin
   //WriteLn('TAG:', AActualTag);
   TagName := GetTagName(ACaseInsensitiveTag);

packages/chm/src/chmspecialfiles.pas

@@ -42,7 +42,9 @@ function WriteNameListToStream(const AStream: TStream; SectionNames: TSectionNam
 var
   MSCompressedName: WideString = 'MSCompressed'#0; // Length 13
   UnCompressedName: WideString = 'Uncompressed'#0;
+{$IFDEF ENDIAN_BIG}
   I: Integer;
+{$ENDIF}
   Size: Word = 2;
   NEntries: Word = 0;
 begin

packages/chm/src/chmwriter.pas

@@ -22,7 +22,7 @@ unit chmwriter;
 {$MODE OBJFPC}{$H+}
 
 interface
-uses Classes, ChmBase, chmtypes, chmspecialfiles;
+uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer;
 
 type
 
@@ -50,7 +50,12 @@ type
     FCurrentStream: TStream; // used to buffer the files that are to be compressed
     FCurrentIndex: Integer;
     FOnGetFileData: TGetDataFunc;
-    FStringsStream: TMemoryStream;
+    FSearchTitlesOnly: Boolean;
+    FStringsStream: TMemoryStream; // the #STRINGS file
+    FTopicsStream: TMemoryStream;  // the #TOPICS file
+    FURLTBLStream: TMemoryStream;  // the #URLTBL file. has offsets of strings in URLSTR
+    FURLSTRStream: TMemoryStream;  // the #URLSTR file
+    FFiftiMainStream: TMemoryStream;
     FContextStream: TMemoryStream; // the #IVB file
     FSection0: TMemoryStream;
     FSection1: TStream; // Compressed Stream
@@ -67,6 +72,7 @@ type
     FHasIndex: Boolean;
     FWindowSize: LongWord;
     FReadCompressedSize: QWord; // Current Size of Uncompressed data that went in Section1 (compressed)
+    FIndexedFiles: TIndexedWordList;
     // Linear order of file
     ITSFHeader: TITSFHeader;
     HeaderSection0Table: TITSFHeaderEntry;  // points to HeaderSection0
@@ -88,12 +94,19 @@ type
     procedure WriteSYSTEM;
     procedure WriteITBITS;
     procedure WriteSTRINGS;
+    procedure WriteTOPICS;
     procedure WriteIVB; // context ids
+    procedure WriteURL_STR_TBL;
+    procedure WriteOBJINST;
+    procedure WriteFiftiMain;
     procedure WriteREADMEFile;
+    procedure WriteFinalCompressedFiles;
     procedure WriteSection0;
     procedure WriteSection1;
     procedure WriteDataSpaceFiles(const AStream: TStream);
     function AddString(AString: String): LongWord;
+    function AddURL(AURL: String; TopicsIndex: DWord): LongWord;
+    procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
     // callbacks for lzxcomp
     function  AtEndOfData: Longbool;
     function  GetData(Count: LongInt; Buffer: PByte): LongInt;
@@ -118,6 +131,7 @@ type
     property OutStream: TStream read FOutStream;
     property Title: String read FTitle write FTitle;
     property FullTextSearch: Boolean read FFullTextSearch write FFullTextSearch;
+    property SearchTitlesOnly: Boolean read FSearchTitlesOnly write FSearchTitlesOnly;
     property DefaultFont: String read FDefaultFont write FDefaultFont;
     property DefaultPage: String read FDefaultPage write FDefaultPage;
     property TempRawStream: TStream read FTempStream write SetTempRawStream;
@@ -125,13 +139,15 @@ type
   end;
 
 implementation
-uses dateutils, sysutils, paslzxcomp;
+uses dateutils, sysutils, paslzxcomp, chmFiftiMain;
 
 const
 
   LZX_WINDOW_SIZE = 16; // 16 = 2 frames = 1 shl 16
   LZX_FRAME_SIZE = $8000;
 
+{$I chmobjinstconst.inc}
+
 { TChmWriter }
 
 procedure TChmWriter.InitITSFHeader;
@@ -393,11 +409,21 @@ var
 const
   VersionStr = 'HHA Version 4.74.8702'; // does this matter?
 begin
+
+
   // this creates the /#SYSTEM file
   Entry.Name := '#SYSTEM';
   Entry.Path := '/';
   Entry.Compressed := False;
   Entry.DecompressedOffset := FSection0.Position;
+
+ { if FileExists('#SYSTEM') then
+  begin
+    TmpStream := TMemoryStream.Create;
+    TmpStream.LoadFromFile('#SYSTEM');
+    TmpStream.Position := 0;
+    FSection0.CopyFrom(TmpStream, TmpStream.Size);
+  end;                                    }
   // EntryCodeOrder: 10 9 4 2 3 16 6 0 1 5
   FSection0.WriteDWord(NToLE(Word(3))); // Version
   if Title <> '' then
@@ -418,11 +444,13 @@ begin
   // 4 A struct that is only needed to set if full text search is on.
   FSection0.WriteWord(NToLE(Word(4)));
   FSection0.WriteWord(NToLE(Word(36))); // size
+
   FSection0.WriteDWord(NToLE(DWord($0409)));
+  FSection0.WriteDWord(1);
   FSection0.WriteDWord(NToLE(DWord(Ord(FFullTextSearch))));
   FSection0.WriteDWord(0);
   FSection0.WriteDWord(0);
-  FSection0.WriteDWord(0);
+
   // two for a QWord
   FSection0.WriteDWord(0);
   FSection0.WriteDWord(0);
@@ -459,6 +487,10 @@ begin
   
   // 6
   // unneeded. if output file is :  /somepath/OutFile.chm the value here is outfile(lowercase)
+  {FSection0.WriteWord(6);
+  FSection0.WriteWord(Length('test1')+1);
+  Fsection0.Write('test1', 5);
+  FSection0.WriteByte(0);}
   
   // 0 Table of contents filename
   if FHasTOC then begin
@@ -479,7 +511,7 @@ begin
   end;
   // 5 Default Window.
   // Not likely needed
-  
+// }
   Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
   FInternalFiles.AddEntry(Entry);
 end;
@@ -492,7 +524,7 @@ begin
   Entry.Name := '#ITBITS';
   Entry.Path := '/';
   Entry.Compressed := False;
-  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedOffset :=0;// FSection0.Position;
   Entry.DecompressedSize := 0;
   
   FInternalFiles.AddEntry(Entry);
@@ -503,7 +535,35 @@ begin
   if FStringsStream.Size = 0 then;
     FStringsStream.WriteByte(0);
   FStringsStream.Position := 0;
-  AddStreamToArchive('#STRINGS', '/', FStringsStream);
+  PostAddStreamToArchive('#STRINGS', '/', FStringsStream);
+end;
+
+procedure TChmWriter.WriteTOPICS;
+var
+  AWord: TIndexedWord;
+  FHits: Integer;
+  i: Integer;
+begin
+  if FTopicsStream.Size = 0 then
+    Exit;
+  FTopicsStream.Position := 0;
+  PostAddStreamToArchive('#TOPICS', '/', FTopicsStream);
+
+  AWord := FIndexedFiles.FirstWord;
+  while AWord <> nil do
+  begin
+    FHits := 0;
+    for i := 0 to AWord.DocumentCount-1 do
+    begin
+      Inc(FHits, Length(AWord.GetLogicalDocument(i).WordIndex));
+    //if AWord.IsTitle then
+
+    end;
+    //WriteLn(AWord.TheWord,'             documents = ', AWord.DocumentCount, ' hits = ', FHits, ' is title = ', AWord.IsTitle);
+    AWord := AWord.NextWord;
+  end;
+
+
 end;
 
 procedure TChmWriter.WriteIVB;
@@ -518,6 +578,152 @@ begin
   AddStreamToArchive('#IVB', '/', FContextStream);
 end;
 
+procedure TChmWriter.WriteURL_STR_TBL;
+begin
+  if FURLSTRStream.Size <> 0 then begin
+    FURLSTRStream.Position := 0;
+    PostAddStreamToArchive('#URLSTR', '/', FURLSTRStream);
+  end;
+  if FURLTBLStream.Size <> 0 then begin
+    FURLTBLStream.Position := 0;
+    PostAddStreamToArchive('#URLTBL', '/', FURLTBLStream);
+  end;
+end;
+
+procedure TChmWriter.WriteOBJINST;
+var
+  i: Integer;
+  ObjStream: TMemoryStream;
+  //Flags: Word;
+begin
+  ObjStream := TMemorystream.Create;
+  // this file is needed to enable searches for the ms reader
+  ObjStream.WriteDWord(NtoLE($04000000));
+  ObjStream.WriteDWord(NtoLE(Dword(2))); // two entries
+
+  ObjStream.WriteDWord(NtoLE(DWord(24))); // offset into file of entry
+  ObjStream.WriteDWord(NtoLE(DWord(2691))); // size
+
+  ObjStream.WriteDWord(NtoLE(DWord(2715))); // offset into file of entry
+  ObjStream.WriteDWord(NtoLE(DWord(36))); // size
+
+  // first entry
+  // write guid 4662DAAF-D393-11D0-9A56-00C04FB68BF7
+  ObjStream.WriteDWord(NtoLE($4662DAAF));
+  ObjStream.WriteWord(NtoLE($D393));
+  ObjStream.WriteWord(NtoLE($11D0));
+  ObjStream.WriteWord(NtoLE($569A));
+  ObjStream.WriteByte($00);
+  ObjStream.WriteByte($C0);
+  ObjStream.WriteByte($4F);
+  ObjStream.WriteByte($B6);
+  ObjStream.WriteByte($8B);
+  ObjStream.WriteByte($F7);
+
+  ObjStream.WriteDWord(NtoLE($04000000));
+  ObjStream.WriteDWord(NtoLE(11));  // bit flags
+  ObjStream.WriteDWord(NtoLE(DWord(1252)));
+  ObjStream.WriteDWord(NtoLE(DWord(1033)));
+  ObjStream.WriteDWord(NtoLE($00000000));
+  ObjStream.WriteDWord(NtoLE($00000000));
+  ObjStream.WriteDWord(NtoLE($00145555));
+  ObjStream.WriteDWord(NtoLE($00000A0F));
+  ObjStream.WriteWord(NtoLE($0100));
+  ObjStream.WriteDWord(NtoLE($00030005));
+  for i := 0 to 5 do
+    ObjStream.WriteDWord($00000000);
+  ObjStream.WriteWord($0000);
+  // okay now the fun stuff
+  for i := 0 to $FF do
+  ObjStream.Write(ObjInstEntries[i], SizeOF(TObjInstEntry));
+  {begin
+    if i = 1 then
+      Flags := 7
+    else
+      Flags := 0;
+    if (i >= $41) and (i <= $5A) then
+      Flags := Flags or 2;
+    if (i >= $61) and (i <= $7A) then
+      Flags := Flags or 1;
+    if i = $27 then
+      Flags := Flags or 6;
+    ObjStream.WriteWord(NtoLE(Flags));
+    ObjStream.WriteWord(NtoLE(Word(i)));
+    if (i >= $41) and (i <= $5A) then
+      ObjStream.WriteByte(NtoLE(i+$20))
+    else
+      ObjStream.WriteByte(NtoLE(i));
+    ObjStream.WriteByte(NtoLE(i));
+    ObjStream.WriteByte(NtoLE(i));
+    ObjStream.WriteByte(NtoLE(i));
+    ObjStream.WriteWord(NtoLE($0000));
+  end;}
+  ObjStream.WriteDWord(NtoLE($E66561C6));
+  ObjStream.WriteDWord(NtoLE($73DF6561));
+  ObjStream.WriteDWord(NtoLE($656F8C73));
+  ObjStream.WriteWord(NtoLE($6F9C));
+  ObjStream.WriteByte(NtoLE($65));
+  // third bit of second entry
+  // write guid 8FA0D5A8-DEDF-11D0-9A61-00C04FB68BF7
+  ObjStream.WriteDWord(NtoLE($8FA0D5A8));
+  ObjStream.WriteWord(NtoLE($DEDF));
+  ObjStream.WriteWord(NtoLE($11D0));
+  ObjStream.WriteWord(NtoLE($619A));
+  ObjStream.WriteByte($00);
+  ObjStream.WriteByte($C0);
+  ObjStream.WriteByte($4F);
+  ObjStream.WriteByte($B6);
+  ObjStream.WriteByte($8B);
+  ObjStream.WriteByte($F7);
+
+  ObjStream.WriteDWord(NtoLE($04000000));
+  ObjStream.WriteDWord(NtoLE(DWord(1)));
+  ObjStream.WriteDWord(NtoLE(DWord(1252)));
+  ObjStream.WriteDWord(NtoLE(DWord(1033)));
+  ObjStream.WriteDWord(NtoLE(DWord(0)));
+
+  // second entry
+  // write guid 4662DAB0-D393-11D0-9A56-00C04FB68B66
+  ObjStream.WriteDWord(NtoLE($4662DAB0));
+  ObjStream.WriteWord(NtoLE($D393));
+  ObjStream.WriteWord(NtoLE($11D0));
+  ObjStream.WriteWord(NtoLE($569A));
+  ObjStream.WriteByte($00);
+  ObjStream.WriteByte($C0);
+  ObjStream.WriteByte($4F);
+  ObjStream.WriteByte($B6);
+  ObjStream.WriteByte($8B);
+  ObjStream.WriteByte($66);
+
+  ObjStream.WriteDWord(NtoLE(DWord(666))); // not kidding
+  ObjStream.WriteDWord(NtoLE(DWord(1252)));
+  ObjStream.WriteDWord(NtoLE(DWord(1033)));
+  ObjStream.WriteDWord(NtoLE(DWord(10031)));
+  ObjStream.WriteDWord(NtoLE(DWord(0)));
+
+  ObjStream.Position := 0;
+  AddStreamToArchive('$OBJINST', '/', ObjStream, True);
+  ObjStream.Free;
+
+end;
+
+procedure TChmWriter.WriteFiftiMain;
+var
+  SearchWriter: TChmSearchWriter;
+begin
+  if FTopicsStream.Size = 0 then
+    Exit;
+  SearchWriter := TChmSearchWriter.Create(FFiftiMainStream, FIndexedFiles);
+  SearchWriter.WriteToStream;
+  SearchWriter.Free;
+
+  if FFiftiMainStream.Size = 0 then
+    Exit;
+
+  FFiftiMainStream.Position := 0;
+  PostAddStreamToArchive('$FIftiMain', '/', FFiftiMainStream);
+end;
+
 procedure TChmWriter.WriteREADMEFile;
 const DISCLAIMER_STR = 'This archive was not made by the MS HTML Help Workshop(r)(tm) program.';
 var
@@ -533,6 +739,14 @@ begin
   FInternalFiles.AddEntry(Entry);
 end;
 
+procedure TChmWriter.WriteFinalCompressedFiles;
+begin
+  WriteTOPICS;
+  WriteURL_STR_TBL;
+  WriteSTRINGS;
+  WriteFiftiMain;
+end;
+
 
 procedure TChmWriter.WriteSection0;
 begin
@@ -609,6 +823,45 @@ begin
   FStringsStream.WriteByte(0);
 end;
 
+function TChmWriter.AddURL ( AURL: String; TopicsIndex: DWord ) : LongWord;
+
+  procedure CheckURLStrBlockCanHold(AString: String);
+  var
+    Rem: LongWord;
+    Len: LongWord;
+  begin
+    Rem := $4000 - (FURLSTRStream.Size mod $4000);
+    Len := 9 + Length(AString);  // 2 dwords the string and NT
+    if Rem < Len then
+      while Rem > 0 do
+      begin
+        FURLSTRStream.WriteByte(0);
+        Dec(Rem);
+      end;
+  end;
+
+  function AddURLString(AString: String): DWord;
+  begin
+    CheckURLStrBlockCanHold(AString);
+    if FURLSTRStream.Size mod $4000 = 0 then
+      FURLSTRStream.WriteByte(0);
+      Result := FURLSTRStream.Position;
+      FURLSTRStream.WriteDWord(NToLE(DWord(0))); // URL Offset for topic after the the "Local" value
+      FURLSTRStream.WriteDWord(NToLE(DWord(0))); // Offset of FrameName??
+      FURLSTRStream.Write(AString[1], Length(AString));
+      FURLSTRStream.WriteByte(0); //NT
+  end;
+begin
+  if AURL[1] = '/' then Delete(AURL,1,1);
+  //if $1000 - (FURLTBLStream.Size mod $1000) = 4 then // we are at 4092
+  if FURLTBLStream.Size and $FFC = $FFC then // faster :)
+    FURLTBLStream.WriteDWord(0);
+  Result := FURLTBLStream.Position;
+  FURLTBLStream.WriteDWord(0);//($231e9f5c); //unknown
+  FURLTBLStream.WriteDWord(NtoLE(TopicsIndex)); // Index of topic in #TOPICS
+  FURLTBLStream.WriteDWord(NtoLE(AddURLString(AURL)));
+end;
+
 function _AtEndOfData(arg: pointer): LongBool; cdecl;
 begin
   Result := TChmWriter(arg).AtEndOfData;
@@ -643,6 +896,9 @@ begin
       FileEntry.DecompressedOffset := FReadCompressedSize; //269047723;//to test writing really large numbers
       FileEntry.Compressed := True;
       
+      if FullTextSearch then
+        CheckFileMakeSearchable(FCurrentStream, FileEntry);
+
       FInternalFiles.AddEntry(FileEntry);
       // So the next file knows it's offset
       Inc(FReadCompressedSize,  FileEntry.DecompressedSize);
@@ -657,6 +913,7 @@ begin
       if Assigned(FOnLastFile) then
         FOnLastFile(Self);
       FCurrentStream.Free;
+      WriteFinalCompressedFiles;
       FCurrentStream := FPostStream;
       FCurrentStream.Position := 0;
       Inc(FReadCompressedSize, FCurrentStream.Size);
@@ -730,6 +987,43 @@ begin
   // We have to trim the last entry off when we are done because there is no next block in that case
 end;
 
+procedure TChmWriter.CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
+type
+  TTopicEntry = record
+    TocOffset,
+    StringsOffset,
+    URLTableOffset: DWord;
+    InContents: Word;// 2 = in contents 6 = not in contents
+    Unknown: Word; // 0,2,4,8,10,12,16,32
+  end;
+
+  function GetNewTopicsIndex: Integer;
+  begin
+    Result := FTopicsStream.Size div 16;
+  end;
+  var
+    TopicEntry: TTopicEntry;
+    ATitle: String;
+begin
+  if Pos('.ht', AFileEntry.Name) > 0 then
+  begin
+    ATitle := FIndexedFiles.IndexFile(AStream, GetNewTopicsIndex, FSearchTitlesOnly);
+    if ATitle <> '' then
+      TopicEntry.StringsOffset := AddString(ATitle)
+    else
+      TopicEntry.StringsOffset := $FFFFFFFF;
+    TopicEntry.URLTableOffset := AddURL(AFileEntry.Path+AFileEntry.Name, GetNewTopicsIndex);
+    TopicEntry.InContents := 2;
+    TopicEntry.Unknown := 0;
+    TopicEntry.TocOffset := 0;
+    FTopicsStream.WriteDWord(LEtoN(TopicEntry.TocOffset));
+    FTopicsStream.WriteDWord(LEtoN(TopicEntry.StringsOffset));
+    FTopicsStream.WriteDWord(LEtoN(TopicEntry.URLTableOffset));
+    FTopicsStream.WriteWord(LEtoN(TopicEntry.InContents));
+    FTopicsStream.WriteWord(LEtoN(TopicEntry.Unknown));
+  end;
+end;
+
 constructor TChmWriter.Create(OutStream: TStream; FreeStreamOnDestroy: Boolean);
 begin
   if OutStream = nil then Raise Exception.Create('TChmWriter.OutStream Cannot be nil!');
@@ -738,6 +1032,10 @@ begin
   FOutStream := OutStream;
   FInternalFiles := TFileEntryList.Create;
   FStringsStream := TmemoryStream.Create;
+  FTopicsStream := TMemoryStream.Create;
+  FURLSTRStream := TMemoryStream.Create;
+  FURLTBLStream := TMemoryStream.Create;
+  FFiftiMainStream := TMemoryStream.Create;
   FSection0 := TMemoryStream.Create;
   FSection1 := TMemoryStream.Create;
   FSection1ResetTable := TMemoryStream.Create;
@@ -745,6 +1043,7 @@ begin
   FPostStream := TMemoryStream.Create;;
   FDestroyStream := FreeStreamOnDestroy;
   FFileNames := TStringList.Create;
+  FIndexedFiles := TIndexedWordList.Create;
 end;
 
 destructor TChmWriter.Destroy;
@@ -754,11 +1053,16 @@ begin
   FInternalFiles.Free;
   FCurrentStream.Free;
   FStringsStream.Free;
+  FTopicsStream.Free;
+  FURLSTRStream.Free;
+  FURLTBLStream.Free;
+  FFiftiMainStream.Free;
   FSection0.Free;
   FSection1.Free;
   FSection1ResetTable.Free;
   FDirectoryListings.Free;
   FFileNames.Free;
+  FIndexedFiles.Free;
   inherited Destroy;
 end;
 
@@ -770,10 +1074,11 @@ begin
 
   // write any internal files to FCurrentStream that we want in the compressed section
   WriteIVB;
-  WriteSTRINGS;
   
   // written to Section0 (uncompressed)
   WriteREADMEFile;
+
+  WriteOBJINST;
   
   // move back to zero so that we can start reading from zero :)
   FReadCompressedSize := FCurrentStream.Size;
@@ -790,6 +1095,7 @@ begin
   // This creates and writes the #SYSTEM file to section0
   WriteSystem;
 
+
   //this creates all special files in the archive that start with ::DataSpace
   WriteDataSpaceFiles(FSection0);
   
@@ -843,6 +1149,8 @@ begin
   Entry.Compressed :=  Compress;
   Entry.DecompressedOffset := TargetStream.Position;
   Entry.DecompressedSize := AStream.Size;
+  if FullTextSearch then
+    CheckFileMakeSearchable(AStream, Entry); // Must check before we add it to the list so we know if the name needs to be added to #STRINGS
   FInternalFiles.AddEntry(Entry);
   AStream.Position := 0;
   TargetStream.CopyFrom(AStream, AStream.Size);
@@ -871,6 +1179,8 @@ begin
   FInternalFiles.AddEntry(Entry);
   AStream.Position := 0;
   TargetStream.CopyFrom(AStream, AStream.Size);
+  if FullTextSearch then
+    CheckFileMakeSearchable(AStream, Entry);
 end;
 
 procedure TChmWriter.AddContext(AContext: DWord; ATopic: String);
@@ -909,3 +1219,4 @@ begin
 end;
 
 end.
+

packages/chm/src/fasthtmlparser.pas

@@ -159,7 +159,12 @@ type
   TOnFoundText = procedure(Text: string) of object;
 
   // Lars's modified html parser, case insensitive or case sensitive 
+
+  { THTMLParser }
+
   THTMLParser = class(TObject)
+    private
+      FDone: Boolean;
     public
       OnFoundTag: TOnFoundTag;
       OnFoundText: TOnFoundText;
@@ -169,6 +174,7 @@ type
       procedure Exec;
       procedure NilOnFoundTag(NoCaseTag, ActualTag: string);
       procedure NilOnFoundText(Text: string);
+      property Done: Boolean read FDone write FDone;
   end;
 
 
@@ -220,7 +226,6 @@ var
   L: Integer;
   TL: Integer;
   I: Integer;
-  Done: Boolean;
   TagStart,
   TextStart,
   P: PChar;   // Pointer to current char.

packages/chm/src/htmlindexer.pas

@@ -0,0 +1,479 @@
+{ Copyright (C) <2008> <Andrew Haines> htmlindexer.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit HTMLIndexer;
+{$MODE OBJFPC}{$H+}
+interface
+uses Classes, SysUtils, FastHTMLParser;
+
+Type
+
+  { TIndexedWord }
+
+  { TIndexDocument }
+
+  TIndexDocument = class(TObject)
+  private
+    FDocumentIndex: Integer;
+  public
+    WordIndex: array of Integer;
+    procedure AddWordIndex(AIndex: Integer);
+    constructor Create(ADocumentIndex: Integer);
+    property DocumentIndex: Integer read FDocumentIndex;
+  end;
+
+
+
+
+  TIndexedWord = class(TObject)
+  private
+    FIsTitle: Boolean;
+    FNextWord: TIndexedWord;
+    FPrevWord: TIndexedWord;
+    FTheWord: string;
+    FCachedTopic: TIndexDocument;
+    FDocuments: Array of TIndexDocument;
+    function GetDocument ( TopicIndexNum: Integer ) : TIndexDocument;
+    function GetDocumentCount: Integer;
+  public
+    constructor Create(AWord: String; AIsTitle: Boolean);
+    destructor Destroy; override;
+    function GetLogicalDocument(AIndex: Integer): TIndexDocument;
+    property TheWord: string read FTheWord; // Always lowercase
+    property PrevWord: TIndexedWord read FPrevWord write FPrevWord;
+    property NextWord: TIndexedWord read FNextWord write FNextWord;
+    property DocumentTopic[TopicIndexNum: Integer]: TIndexDocument read GetDocument;
+    property DocumentCount: Integer read GetDocumentCount;
+    property IsTitle: Boolean read FIsTitle;
+  end;
+
+  { TIndexedWordList }
+
+  TIndexedWordList = class(TObject)
+  private
+    FIndexTitlesOnly: Boolean;
+    FIndexedFileCount: DWord;
+    //vars while processing page
+    FInTitle,
+    FInBody: Boolean;
+    FWordCount: Integer; // only words in body
+    FDocTitle: String;
+    FTopicIndex: Integer;
+    //end vars
+    FTotalDifferentWordLength: DWord;
+    FTotalDIfferentWords: DWord;
+    FTotalWordCount: DWord;
+    FTotalWordLength: DWord;
+    FLongestWord: DWord;
+    FFirstWord: TIndexedWord;
+    FCachedWord: TIndexedWord;
+    FParser: THTMLParser;
+    function AddGetWord(AWord: String; IsTitle: Boolean): TIndexedWord;
+    function GetWordForward(AWord: String; StartWord: TIndexedWord; out WrongWord: TIndexedWord; AIsTitle: Boolean): TIndexedWord;
+    function GetWordBackward(AWord: String; StartWord: TIndexedWord; out WrongWord: TIndexedWord; AIsTitle: Boolean): TIndexedWord;
+    function CompareWord(AWord: String; AIndexWord: TIndexedWord; AIsTitle: Boolean): Integer;
+    // callbacks
+    procedure CBFoundTag(NoCaseTag, ActualTag: string);
+    procedure CBFountText(Text: string);
+
+    procedure EatWords(Words: String; IsTitle: Boolean);
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    function  IndexFile(AStream: TStream; ATOPICIndex: Integer; AIndexOnlyTitles: Boolean): String; // returns the documents <Title>
+    procedure Clear;
+    procedure AddWord(const AWord: TIndexedWord; StartingWord: TIndexedWord; AIsTitle: Boolean);
+    property FirstWord: TIndexedWord read FFirstWord;
+    property IndexedFileCount: DWord read FIndexedFileCount;
+    property LongestWord: DWord read FLongestWord;
+    property TotalWordCount: DWord read FTotalWordCount;
+    property TotalDIfferentWords: DWord read FTotalDIfferentWords;
+    property TotalWordLength: DWord read FTotalWordLength;
+    property TotalDifferentWordLength: DWord read FTotalDifferentWordLength;
+    property Words[AWord: String; IsTitle: Boolean] : TIndexedWord read AddGetWord;
+  end;
+
+implementation
+
+function Max(ANumber, BNumber: DWord): DWord;
+begin
+  if ANumber > BNumber then
+    Result := ANumber
+  else
+    Result := BNumber;
+end;
+
+{ TIndexedWordList }
+
+function TIndexedWordList.AddGetWord(AWord: String; IsTitle: Boolean): TIndexedWord;
+var
+  //StartWord,
+  WrongWord: TIndexedWord;
+begin
+  Result := nil;
+  AWord := LowerCase(AWord);
+
+  {if FCachedWord <> nil then
+    StartWord := FCachedWord
+  else
+    StartWord := FFirstWord;
+
+  if StartWord <> nil then
+  begin
+    case CompareWord(AWord, StartWord, IsTitle) of
+      0: Exit(WrongWord);
+      1: Result := GetWordBackward(AWord, StartWord, WrongWord, IsTitle);
+     -1: Result := GetWordForward(AWord, StartWord, WrongWord, IsTitle);
+    end;
+  end
+  else}
+    Result := GetWordForward(AWord, FFirstWord, WrongWord, IsTitle);
+
+  if Result = nil then
+  begin
+    Inc(FTotalDifferentWordLength, Length(AWord));
+    Inc(FTotalDIfferentWords);
+    Result := TIndexedWord.Create(AWord,IsTitle);
+    AddWord(Result, WrongWord,IsTitle);
+    if IsTitle then
+    ;//WriteLn('Creating word: ', AWord);
+    FLongestWord := Max(FLongestWord, Length(AWord));
+  end;
+  Inc(FTotalWordLength, Length(AWord));
+  Inc(FTotalWordCount);
+end;
+
+function TIndexedWordList.GetWordForward(AWord: String; StartWord: TIndexedWord; out WrongWord: TIndexedWord; AIsTitle: Boolean): TIndexedWord;
+var
+  FCurrentWord: TIndexedWord;
+begin
+  Result := nil;
+  WrongWord := nil;
+  FCurrentWord := StartWord;
+  while (FCurrentWord <> nil) and (CompareWord(AWord, FCurrentWord, AIsTitle) <> 0) do
+  begin
+    WrongWord := FCurrentWord;
+    case CompareWord(AWord, FCurrentWord, AIsTitle) of
+      -1: FCurrentWord := nil;
+       0: Exit(FCurrentWord);
+       1: FCurrentWord := FCurrentWord.NextWord;
+    end;
+  end;
+
+  if FCurrentWord <> nil then
+    Result := FCurrentWord;
+end;
+
+function TIndexedWordList.GetWordBackward(AWord: String; StartWord: TIndexedWord; out WrongWord: TIndexedWord; AIsTitle: Boolean): TIndexedWord;
+var
+  FCurrentWord: TIndexedWord;
+begin
+  Result := nil;
+  WrongWord := nil;
+  FCurrentWord := StartWord;
+  while (FCurrentWord <> nil) and (CompareWord(AWord, FCurrentWord, AIsTitle) <> 0) do
+  begin
+    WrongWord := FCurrentWord;
+    case CompareWord(AWord, FCurrentWord, AIsTitle) of
+      -1:
+          begin
+            WrongWord := FCurrentWord;
+            FCurrentWord := nil
+          end;
+       0: Exit(FCurrentWord);
+       1: FCurrentWord := FCurrentWord.PrevWord;
+    end;
+  end;
+  if FCurrentWord <> nil then
+    Result := FCurrentWord;
+end;
+
+function TIndexedWordList.CompareWord ( AWord: String;
+  AIndexWord: TIndexedWord; AIsTitle: Boolean ) : Integer;
+begin
+  Result := CompareText(AWord, AIndexWord.TheWord);
+  if Result = 0 then
+  begin
+    Result := Result + ord(AIndexWord.IsTitle);
+    Result := Result - ord(AIsTitle);
+  end;
+  if Result < 0 then Result := -1
+  else if Result > 0 then Result := 1;
+  //if AIsTitle then
+    //WriteLn('Looking for title word :', AWord);
+  //WriteLn(Result);
+end;
+
+procedure TIndexedWordList.CBFoundTag(NoCaseTag, ActualTag: string);
+begin
+  if FInBody then begin
+    if NoCaseTag = '</BODY>' then FInBody := False;
+  end
+  else begin
+    //WriteLn('"',NoCaseTag,'"');
+    if NoCaseTag      = '<TITLE>' then FInTitle := True
+    else if NoCaseTag = '</TITLE>' then FInTitle := False
+    else if NoCaseTag = '<BODY>' then FInBody := True
+    else
+  end;
+  if FInBody and FIndexTitlesOnly then FParser.Done := True;
+end;
+
+procedure TIndexedWordList.CBFountText(Text: string);
+begin
+  if Length(Text) < 1 then
+    Exit;
+  EatWords(Text, FInTitle and not FInBody);
+end;
+
+procedure TIndexedWordList.EatWords ( Words: String; IsTitle: Boolean ) ;
+var
+  WordPtr: PChar;
+  WordStart: PChar;
+  InWord: Boolean;
+  IsNumberWord: Boolean;
+  function IsEndOfWord: Boolean;
+  begin
+    Result := not (WordPtr^ in ['a'..'z', '0'..'9', #01, #$DE, #$FE]);
+    if  Result and IsNumberWord then
+      Result :=  Result and (WordPtr[0] <> '.');
+    if Result and InWord then
+      Result := Result and (WordPtr[0] <> '''');
+  ;
+  end;
+  var
+    WordIndex: TIndexedWord;
+    WordName: String;
+    FPos: Integer;
+begin
+  if IsTitle then
+    FDocTitle := Words;
+  Words := LowerCase(Words);
+  WordStart := PChar(Words);
+  WordPtr := WordStart;
+  IsNumberWord := False;
+  InWord := False;
+  repeat
+    if InWord and IsEndOfWord then
+    begin
+      WordName := Copy(WordStart, 0, (WordPtr-WordStart));
+      FPos := Pos('''', WordName);
+      while FPos > 0 do
+      begin
+        Delete(WordName, FPos, 1);
+        FPos := Pos('''', WordName);
+      end;
+      WordIndex := Self.Words[WordName, IsTitle];
+      InWord := False;
+      //if IsNumberWord then WriteLn('Following is NUMBER WORD: "', (WordStart[0]),'"'); ;
+      IsNumberWord := False;
+      WordIndex.DocumentTopic[FTopicIndex].AddWordIndex(FWordCount);
+      //WriteLn(FWordCount, ' "', WordName,'"');
+      //if not IsTitle then
+        Inc(FWordCount);
+
+    end
+    else if not InWord and not IsEndOfWord then
+    begin
+      InWord := True;
+      WordStart := WordPtr;
+      IsNumberWord := WordPtr^ in ['0'..'9'];
+      //if IsNumberWord then WriteLn('Following is NUMBER WORD: "', WordPtr[0],'"'); ;
+    end;
+    Inc(WordPtr);
+  until WordPtr^ = #0;
+
+  if InWord then
+  begin
+    WordName := Copy(WordStart, 0, (WordPtr-WordStart));
+    WordIndex := Self.Words[WordName, IsTitle];
+    WordIndex.DocumentTopic[FTopicIndex].AddWordIndex(FWordCount);
+    InWord := False;
+    //if IsNumberWord then WriteLn('Following is NUMBER WORD: "', (WordStart[0]),'"'); ;
+    IsNumberWord := False;
+    //WriteLn(FWordCount, ' "', WordName,'"');
+    if not IsTitle then
+      Inc(FWordCount);
+
+  end;
+
+end;
+
+constructor TIndexedWordList.Create;
+begin
+  inherited;
+end;
+
+destructor TIndexedWordList.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+function TIndexedWordList.IndexFile(AStream: TStream; ATOPICIndex: Integer; AIndexOnlyTitles: Boolean): String;
+var
+  TheFile: String;
+begin
+  FInBody := False;
+  FInTitle:= False;
+  FIndexTitlesOnly := AIndexOnlyTitles;
+  FWordCount := 0;
+  FTopicIndex := ATOPICIndex;
+  FIndexedFileCount := FIndexedFileCount +1;
+
+  SetLength(TheFile, AStream.Size+1);
+  AStream.Position := 0;
+  AStream.Read(TheFile[1], AStream.Size);
+  TheFile[Length(TheFile)] := #0;
+
+  FParser := THTMLParser.Create(@TheFile[1]);
+  FParser.OnFoundTag := @CBFoundTag;
+  FParser.OnFoundText := @CBFountText;
+  FParser.Exec;
+  FParser.Free;
+
+  Result := FDocTitle;
+  FDocTitle := '';
+  FInBody := False;
+  FInTitle:= False;
+  FWordCount := 0;
+  FTopicIndex := -1;
+
+  AStream.Position := 0;
+end;
+
+procedure TIndexedWordList.Clear;
+var
+  FCurrentWord: TIndexedWord;
+begin
+  FCurrentWord := FFirstWord;
+  while FCurrentWord <> nil do
+  begin
+    FFirstWord := FCurrentWord.NextWord;
+    FCurrentWord.Free;
+    FCurrentWord := FFirstWord;
+  end;
+end;
+
+procedure TIndexedWordList.AddWord(const AWord: TIndexedWord; StartingWord: TIndexedWord; AIsTitle: Boolean);
+var
+  WrongWord: TIndexedWord;
+begin
+  if FFirstWord = nil then
+    FFirstWord := AWord
+  else begin
+    if StartingWord <> nil then
+      WrongWord := StartingWord;
+    case CompareWord(AWord.TheWord, StartingWord, AIsTitle) of
+       1: GetWordForward(AWord.TheWord, StartingWord, WrongWord, AIsTitle);
+       0: ; // uh oh
+      -1: GetWordBackward(AWord.TheWord, StartingWord, WrongWord, AIsTitle);
+    end;
+    if WrongWord = nil then
+       WrongWord := FirstWord;
+    case CompareWord(AWord.TheWord, WrongWord, AIsTitle) of
+       -1:
+          begin
+            AWord.PrevWord := WrongWord.PrevWord;
+            if AWord.PrevWord <> nil then
+              AWord.PrevWord.NextWord := AWord;
+            WrongWord.PrevWord := AWord;
+            AWord.NextWord := WrongWord;
+          end;
+        0: ;//WriteLn('Found word which shouldn''t happen'); // uh oh
+        1:
+          begin
+            AWord.PrevWord := WrongWord;
+            AWord.NextWord := WrongWord.NextWord;
+            WrongWord.NextWord := AWord;
+          end;
+    end;
+  end;
+  if AWord.PrevWord = nil then
+     FFirstWord := AWord;
+  FCachedWord := AWord;
+end;
+
+
+{ TIndexedWord }
+
+function TIndexedWord.GetDocument ( TopicIndexNum: Integer ) : TIndexDocument;
+var
+  i: Integer;
+begin
+  Result := nil;
+  if (FCachedTopic <> nil) and (FCachedTopic.FDocumentIndex = TopicIndexNum) then
+    Exit(FCachedTopic);
+
+  for i := 0 to High(FDocuments) do
+    if FDocuments[i].FDocumentIndex = TopicIndexNum then
+      Exit(FDocuments[i]);
+  if Result = nil then
+  begin
+    Result := TIndexDocument.Create(TopicIndexNum);
+    SetLength(FDocuments, Length(FDocuments)+1);
+    FDocuments[High(FDocuments)] := Result;
+  end;
+  FCachedTopic := Result;
+end;
+
+function TIndexedWord.GetDocumentCount: Integer;
+begin
+  Result := Length(FDocuments);
+end;
+
+constructor TIndexedWord.Create(AWord: String; AIsTitle: Boolean);
+begin
+  FTheWord := AWord;
+  FIsTitle := AIsTitle;
+end;
+
+destructor TIndexedWord.Destroy;
+var
+  i: Integer;
+begin
+  if FPrevWord <> nil then
+    FPrevWord.NextWord := FNextWord;
+  if FNextWord <> nil then
+    FNextWord.PrevWord := FPrevWord;
+  for i := 0 to High(FDocuments) do
+    FreeAndNil(FDocuments[i]);
+  inherited Destroy;
+end;
+
+function TIndexedWord.GetLogicalDocument ( AIndex: Integer ) : TIndexDocument;
+begin
+  Result := FDocuments[AIndex];;
+end;
+
+{ TIndexDocument }
+
+procedure TIndexDocument.AddWordIndex ( AIndex: Integer ) ;
+begin
+  SetLength(WordIndex, Length(WordIndex)+1);
+  WordIndex[High(WordIndex)] := AIndex;
+end;
+
+constructor TIndexDocument.Create ( ADocumentIndex: Integer ) ;
+begin
+  FDocumentIndex := ADocumentIndex;
+end;
+
+end.

packages/dbus/fpmake.pp

@@ -20,7 +20,7 @@ begin
 
     P.Author := 'Library: Red Hat, header: Unknown (but probably Sebastian Guenther)';
     P.License := 'Library: GPL2 or later, header: LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'D-Bus message bus interface. (Pre 1.0?)';
     P.NeedLibC:= true;

packages/dts/fpmake.pp

@@ -20,7 +20,7 @@ begin
 
     P.Author := 'Library: Gildas Bazin, header: Ivo Steinmann';
     P.License := 'Library: GPL2 or later, header: LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'a low-level interface to decoding audio frames encoded using DTS Coherent Acoustics';
     P.NeedLibC:= true;

packages/fcl-async/fpmake.pp

@@ -20,7 +20,7 @@ begin
 
     P.Author := 'Mostly Sebastian Guenther';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Asynchonous event management of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;

packages/fcl-base/Makefile.fpc

@@ -49,6 +49,7 @@ includedir_win32=src/win
 includedir_win64=src/win
 includedir_wince=src/win
 sourcedir=src/$(OS_TARGET) src
+includedir_linux=src/dummy
 
 [prerules]
 ifeq ($(OS_TARGET),win32)

packages/fcl-base/fpmake.pp

@@ -34,6 +34,7 @@ begin
     P.IncludePath.Add('src/unix',AllUnixOSes);
     P.IncludePath.Add('src/win',AllWindowsOSes);
     P.IncludePath.Add('src/$(OS)',AllOSes-AllWindowsOSes-AllUnixOSes);
+    P.IncludePath.Add('src/dummy',AllOSes);
 
     T:=P.Targets.AddUnit('avl_tree.pp');
     T:=P.Targets.AddUnit('base64.pp');
@@ -55,8 +56,7 @@ begin
       T.ResourceStrings:=true;
       with T.Dependencies do
         begin
-          AddInclude('eventlog.inc',AllUnixOSes+[Win32,Win64]);
-          AddInclude('felog.inc',AllOSes-AllUnixOSes-[Win32,Win64]);
+          AddInclude('eventlog.inc');
         end;
     T:=P.Targets.AddUnit('fptimer.pp',AllWindowsOSes+AllUnixOSes);
     T:=P.Targets.AddUnit('gettext.pp');

packages/fcl-base/src/avl_tree.pp

@@ -40,8 +40,6 @@ type
     Data: Pointer;
     procedure Clear;
     function TreeDepth: integer; // longest WAY down. e.g. only one node => 0 !
-    constructor Create;
-    destructor Destroy; override;
   end;
 
   TAVLTree = class
@@ -1033,18 +1031,6 @@ end;
 
 { TAVLTreeNode }
 
-constructor TAVLTreeNode.Create;
-begin
-  inherited Create;
-
-end;
-
-destructor TAVLTreeNode.Destroy;
-begin
-
-  inherited Destroy;
-end;
-
 function TAVLTreeNode.TreeDepth: integer;
 // longest WAY down. e.g. only one node => 0 !
 var LeftDepth, RightDepth: integer;

packages/fcl-base/src/contnrs.pp

@@ -1378,7 +1378,7 @@ begin
       FHashList := nil;
     end;
   SetHashCapacity(1);
-  FHashTable^[0]:=longword(-1); // sethashcapacity does not always call rehash
+  FHashTable^[0]:=(-1); // sethashcapacity does not always call rehash
   if Assigned(FStrs) then
     begin
       FStrCount:=0;

packages/fcl-base/src/eventlog.pp

@@ -111,11 +111,9 @@ Resourcestring
 
 implementation
 
-{$if defined(win32) or defined(win64) or defined(unix)}
- {$i eventlog.inc}
-{$else}
- {$i felog.inc}
-{$endif}
+{$i eventlog.inc}
+(* File based dummy implementation is used for all platforms not providing
+   specific implementation of eventlog.inc for the particular platform. *)
 
 { TEventLog }
 

packages/fcl-db/fpmake.pp

@@ -16,7 +16,7 @@ begin
 
     P.Author := '<various>';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Database library of Free Component Libraries(FCL), FPC''s OOP library.';
     P.NeedLibC:= false;

packages/fcl-db/src/base/bufdataset.pas

@@ -76,6 +76,10 @@ type
      - If UpdateKind is ukDelete it contains a bookmark to the record just after the deleted record
 }
     BookmarkData       : TBufBookmark;
+{  DelBookMarkData:
+     - If UpdateKind is ukDelete it contains a bookmark to the deleted record, before it got deleted
+}
+    DelBookmarkData    : TBufBookmark;
 {  OldValuesBuffer:
      - If UpdateKind is ukModify it contains a record-buffer which contains the old data
      - If UpdateKind is ukDelete it contains a record-buffer with the data of the deleted record
@@ -105,7 +109,6 @@ type
   TBufIndex = class(TObject)
   private
     FDataset : TBufDataset;
-
   protected
     function GetBookmarkSize: integer; virtual; abstract;
     function GetCurrentBuffer: Pointer; virtual; abstract;
@@ -283,22 +286,9 @@ type
   { TBufDatasetReader }
 
 type
-  TChangeLogInfo = record
-       FirstChangeNode : pointer;
-       SecondChangeNode : pointer;
-       Bookmark   : TBufBookmark;
-  end;
-  TChangeLogEntry = record
-       UpdateKind : TUpdateKind;
-       OrigEntry  : integer;
-       NewEntry   : integer;
-  end;
-  TChangeLogInfoArr = array of TChangeLogInfo;
-  TChangeLogEntryArr = array of TChangeLogEntry;
   TRowStateValue = (rsvOriginal, rsvDeleted, rsvInserted, rsvUpdated, rsvDetailUpdates);
   TRowState = set of TRowStateValue;
 
-
 type
 
   { TDataPacketReader }
@@ -306,22 +296,35 @@ type
   TDatapacketReaderClass = class of TDatapacketReader;
   TDataPacketReader = class(TObject)
     FStream : TStream;
+  protected
+    class function RowStateToByte(const ARowState : TRowState) : byte;
+    class function ByteToRowState(const AByte : Byte) : TRowState;
   public
     constructor create(AStream : TStream); virtual;
-
+    // Load a dataset from stream:
+    // Load the field-definitions from a stream.
     procedure LoadFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
-    procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
-    procedure GetRecordUpdState(var AIsUpdate,AAddRecordBuffer,AIsFirstEntry : boolean); virtual; abstract;
-    procedure EndStoreRecord(const AChangeLog : TChangeLogEntryArr); virtual; abstract;
+    // Is called before the records are loaded
+    procedure InitLoadRecords; virtual; abstract;
+    // Return the RowState of the current record, and the order of the update
+    function GetRecordRowState(out AUpdOrder : Integer) : TRowState; virtual; abstract;
+    // Returns if there is at least one more record available in the stream
     function GetCurrentRecord : boolean; virtual; abstract;
-    procedure GotoNextRecord; virtual; abstract;
-    function GetCurrentElement : pointer; virtual; abstract;
-    procedure GotoElement(const AnElement : pointer); virtual; abstract;
+    // Store a record from stream in the current record-buffer
     procedure RestoreRecord(ADataset : TBufDataset); virtual; abstract;
-    procedure StoreRecord(ADataset : TBufDataset; RowState : TRowState); virtual; abstract;
-    procedure InitLoadRecords(var AChangeLog : TChangeLogEntryArr); virtual; abstract;
-    property Stream: TStream read FStream;
+    // Move the stream to the next record
+    procedure GotoNextRecord; virtual; abstract;
+
+    // Store a dataset to stream:
+    // Save the field-definitions to a stream.
+    procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
+    // Save a record from the current record-buffer to the stream
+    procedure StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract;
+    // Is called after all records are stored
+    procedure FinalizeStoreRecords; virtual; abstract;
+    // Checks if the provided stream is of the right format for this class
     class function RecognizeStream(AStream : TStream) : boolean; virtual; abstract;
+    property Stream: TStream read FStream;
   end;
 
   { TFpcBinaryDatapacketReader }
@@ -330,16 +333,13 @@ type
   public
     procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
     procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
-    procedure GetRecordUpdState(var AIsUpdate, AAddRecordBuffer,
-                     AIsFirstEntry: boolean); override;
-    procedure EndStoreRecord(const AChangeLog : TChangeLogEntryArr); override;
+    function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
+    procedure FinalizeStoreRecords; override;
     function GetCurrentRecord : boolean; override;
     procedure GotoNextRecord; override;
-    procedure GotoElement(const AnElement : pointer); override;
-    procedure InitLoadRecords(var AChangeLog : TChangeLogEntryArr); override;
-    function GetCurrentElement: pointer; override;
+    procedure InitLoadRecords; override;
     procedure RestoreRecord(ADataset : TBufDataset); override;
-    procedure StoreRecord(ADataset : TBufDataset; RowState : TRowState); override;
+    procedure StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
     class function RecognizeStream(AStream : TStream) : boolean; override;
   end;
 
@@ -385,7 +385,8 @@ type
     function GetIndexName: String;
     function LoadBuffer(Buffer : PChar): TGetResult;
     function GetFieldSize(FieldDef : TFieldDef) : longint;
-    function GetRecordUpdateBuffer(const ABookmark : TBufBookmark) : boolean;
+    function GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludeDeleted : boolean = false; AFindNext : boolean = false) : boolean;
+    function GetRecordUpdateBufferCached(const ABookmark : TBufBookmark; IncludeDeleted : boolean = false) : boolean;
     function GetActiveRecordUpdateBuffer : boolean;
     procedure ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
     procedure SetIndexFieldNames(const AValue: String);
@@ -395,7 +396,7 @@ type
     function  IntAllocRecordBuffer: PChar;
     procedure DoFilterRecord(var Acceptable: Boolean);
     procedure ParseFilter(const AFilter: string);
-    procedure IntLoadFielddefsFromFile(const FileName: string);
+    procedure IntLoadFielddefsFromFile;
     procedure IntLoadRecordsFromFile;
   protected
     procedure UpdateIndexDefs; override;
@@ -466,6 +467,7 @@ type
     procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
     procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
     procedure CreateDataset;
+    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
 
     property ChangeCount : Integer read GetChangeCount;
     property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount;
@@ -653,6 +655,7 @@ destructor TBufDataset.Destroy;
 Var
   I : Integer;
 begin
+  if Active then Close;
   SetLength(FUpdateBuffer,0);
   SetLength(FBlobBuffers,0);
   SetLength(FUpdateBlobBuffers,0);
@@ -913,7 +916,7 @@ begin
     FFileStream := TFileStream.Create(FileName,fmOpenRead);
     FDatasetReader := TFpcBinaryDatapacketReader.Create(FFileStream);
     end;
-  if assigned(FDatasetReader) then IntLoadFielddefsFromFile(FFileName);
+  if assigned(FDatasetReader) then IntLoadFielddefsFromFile;
   CalcRecordSize;
 
   FBRecordcount := 0;
@@ -1299,7 +1302,7 @@ var ABookmark : TBufBookmark;
 
 begin
   GetBookmarkData(ActiveBuffer,@ABookmark);
-  result := GetRecordUpdateBuffer(ABookmark);
+  result := GetRecordUpdateBufferCached(ABookmark);
 end;
 
 procedure TBufDataset.ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
@@ -1516,21 +1519,37 @@ begin
 {$ENDIF}
 end;
 
-function TBufDataset.GetRecordUpdateBuffer(const ABookmark: TBufBookmark): boolean;
+function TBufDataset.GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludeDeleted : boolean = false; AFindNext : boolean = false): boolean;
 
-var x : integer;
+var x        : integer;
+    StartBuf : integer;
 
 begin
-  if (FCurrentUpdateBuffer >= length(FUpdateBuffer)) or not FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) then
-   for x := 0 to high(FUpdateBuffer) do
-    if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) and
-       (FUpdateBuffer[x].UpdateKind<>ukDelete) then // The Bookmarkdata of a deleted record does not contain the deleted record, but the record thereafter
-      begin
-      FCurrentUpdateBuffer := x;
-      break;
-      end;
-  Result := (FCurrentUpdateBuffer < length(FUpdateBuffer))  and
-            (FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark));
+  if AFindNext then
+    StartBuf:=FCurrentUpdateBuffer+1
+  else
+    StartBuf := 0;
+  Result := False;
+  for x := StartBuf to high(FUpdateBuffer) do
+   if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) and
+       ((FUpdateBuffer[x].UpdateKind<>ukDelete) or IncludeDeleted) then // The Bookmarkdata of a deleted record does not contain the deleted record, but the record thereafter
+    begin
+    FCurrentUpdateBuffer := x;
+    Result := True;
+    break;
+    end;
+end;
+
+function TBufDataset.GetRecordUpdateBufferCached(const ABookmark: TBufBookmark;
+  IncludeDeleted: boolean): boolean;
+begin
+  // if the current update buffer complies, immediately return true
+  if (FCurrentUpdateBuffer < length(FUpdateBuffer))  and
+     (FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark)) and
+     ((FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind<>ukDelete) or IncludeDeleted) then
+    Result := True
+  else
+    Result := GetRecordUpdateBuffer(ABookmark,IncludeDeleted);
 end;
 
 function TBufDataset.LoadBuffer(Buffer : PChar): TGetResult;
@@ -1660,11 +1679,7 @@ begin
     DatabaseErrorFmt(SNotEditing,[Name],self);
     exit;
     end;
-  if state = dsFilter then  // Set the value into the 'temporary' FLastRecBuf buffer for Locate and Lookup
-    with FCurrentIndex do
-      CurrBuff := SpareBuffer
-  else
-    CurrBuff := GetCurrentBuffer;
+  CurrBuff := GetCurrentBuffer;
   If Field.Fieldno > 0 then // If = 0, then calculated field or something
     begin
     NullMask := CurrBuff;
@@ -1696,6 +1711,7 @@ var i         : Integer;
     RemRecBuf : Pchar;
     RemRec    : pointer;
     RemRecBookmrk : TBufBookmark;
+    TempUpdBuf: TRecUpdateBuffer;
 begin
   InternalSetToRecord(ActiveBuffer);
   // Remove the record from all active indexes
@@ -1711,7 +1727,8 @@ begin
 // may arise. The 'delete' is placed in the update-buffer before the actual delete
 // took place. This can lead into troubles, because other updates can depend on
 // the record still being available.
-  if not GetActiveRecordUpdateBuffer or (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind = ukModify) then
+  if not GetActiveRecordUpdateBuffer or
+    (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind = ukModify) then
     begin
     FCurrentUpdateBuffer := length(FUpdateBuffer);
     SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
@@ -1719,18 +1736,40 @@ begin
     FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
     move(RemRec^, FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
     FreeRecordBuffer(RemRecBuf);
-    FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
     end
   else //with FIndexes[0] do
     begin
     FreeRecordBuffer(RemRecBuf);
-    FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
     if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind <> ukModify then
       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil;  //this 'disables' the updatebuffer
     end;
+  FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
+  FUpdateBuffer[FCurrentUpdateBuffer].DelBookmarkData := RemRecBookmrk;
+  FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukDelete;
+
+  // Search for update-buffers which are linked to the deleted record and re-link
+  // them to the current record.
+  if GetRecordUpdateBuffer(RemRecBookmrk,True,False) then
+    begin
+    repeat
+    if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind = ukDelete then
+      begin
+      // If one of the update-buffers, linked to the deleted record, is a delete
+      // then disable the old update-buffer and create a new one. Such that the
+      // position of the records stays the samein case of a cancelupdates or
+      // something similar
+      TempUpdBuf := FUpdateBuffer[FCurrentUpdateBuffer];
+      move(FUpdateBuffer[FCurrentUpdateBuffer+1],FUpdateBuffer[FCurrentUpdateBuffer],((length(FUpdateBuffer)-FCurrentUpdateBuffer))*Sizeof(TRecUpdateBuffer));
+      dec(FCurrentUpdateBuffer);
+      FCurrentIndex.StoreCurrentRecIntoBookmark(@TempUpdBuf.BookmarkData);
+      FUpdateBuffer[length(FUpdateBuffer)-1] := TempUpdBuf;
+      end
+    else
+      FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
+    until not GetRecordUpdateBuffer(RemRecBookmrk,True,True)
+    end;
 
   dec(FBRecordCount);
-  FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukDelete;
 end;
 
 
@@ -2321,100 +2360,85 @@ begin
 end;
 
 procedure TBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
-var i              : integer;
-    ScrollResult   : TGetResult;
+
+  procedure StoreUpdateBuffer(AUpdBuffer : TRecUpdateBuffer; var ARowState: TRowState);
+  var AThisRowState : TRowState;
+  begin
+    FFilterBuffer:=AUpdBuffer.OldValuesBuffer;
+    if AUpdBuffer.UpdateKind = ukModify then
+      begin
+      AThisRowState := [rsvOriginal];
+      ARowState:=[rsvUpdated];
+      end
+    else if AUpdBuffer.UpdateKind = ukDelete then
+      AThisRowState := [rsvDeleted]
+    else // ie: updatekind = ukInsert
+      begin
+      ARowState := [rsvInserted];
+      Exit;
+      end;
+    FDatasetReader.StoreRecord(Self,AThisRowState,FCurrentUpdateBuffer);
+  end;
+
+  procedure HandleUpdateBuffersFromRecord(ARecBookmark : TBufBookmark; var ARowState: TRowState);
+  var
+    StoreUpdBuf    : integer;
+    ADumRowstate   : TRowState;
+  begin
+    if GetRecordUpdateBuffer(ARecBookmark,True) then
+      begin
+      // Loop to see if there is more then one update-buffer
+      // linked to the current record
+      repeat
+      StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
+      until not GetRecordUpdateBuffer(ARecBookmark,True,True)
+      end
+    else
+      ARowState:=[];
+  end;
+
+var ScrollResult   : TGetResult;
     StoreDSState   : TDataSetState;
     ABookMark      : PBufBookmark;
     ATBookmark     : TBufBookmark;
-    ChangeLog      : array of TChangeLogEntry;
-
-var RowState : TRowState;
-    RecUpdBuf: integer;
-    EntryNr  : integer;
-    ChangeLogStr : String;
+    RowState       : TRowState;
+    EntryNr        : integer;
 
 begin
   FDatasetReader := AWriter;
   try
-
-  //  CheckActive;
+    //CheckActive;
     ABookMark:=@ATBookmark;
     FDatasetReader.StoreFieldDefs(FieldDefs);
 
-    SetLength(ChangeLog,length(FUpdateBuffer));
-    EntryNr:=1;
-
     StoreDSState:=State;
     SetTempState(dsFilter);
     ScrollResult:=FCurrentIndex.ScrollFirst;
     while ScrollResult=grOK do
       begin
+      RowState:=[];
       FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
-      if GetRecordUpdateBuffer(ABookmark^) and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind <> ukDelete) then
-        begin
-        if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind = ukInsert then
-          begin
-          RowState:=[rsvInserted];
-          FFilterBuffer:=FCurrentIndex.CurrentBuffer;
-          with ChangeLog[FCurrentUpdateBuffer] do
-            begin
-            OrigEntry:=0;
-            NewEntry:=EntryNr;
-            UpdateKind:=ukInsert;
-            end;
-          end
-        else // This is always ukModified
-          begin
-          RowState:=[rsvOriginal];
-          FFilterBuffer:=FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer;
-          ChangeLog[FCurrentUpdateBuffer].OrigEntry:=EntryNr;
-          end;
-        end
+      HandleUpdateBuffersFromRecord(ABookmark^,RowState);
+      FFilterBuffer:=FCurrentIndex.CurrentBuffer;
+      if RowState=[] then
+        FDatasetReader.StoreRecord(Self,[])
       else
-        begin
-        FFilterBuffer:=FCurrentIndex.CurrentBuffer;
-        RowState:=[];
-        end;
+        FDatasetReader.StoreRecord(Self,RowState,FCurrentUpdateBuffer);
 
-      FDatasetReader.StoreRecord(Self,RowState);
-      inc(EntryNr);
       ScrollResult:=FCurrentIndex.ScrollForward;
-      end;
-
-    for RecUpdBuf:=0 to length(FUpdateBuffer)-1 do with FUpdateBuffer[RecUpdBuf] do
-      begin
-      if UpdateKind = ukDelete then
-        begin
-        RowState:=[rsvDeleted];
-        FFilterBuffer:=FUpdateBuffer[RecUpdBuf].OldValuesBuffer;
-        FDatasetReader.StoreRecord(Self, RowState);
-        with ChangeLog[RecUpdBuf] do
-          begin
-          NewEntry:=EntryNr;
-          UpdateKind:=ukDelete;
-          end;
-        inc(EntryNr);
-        end
-      else if UpdateKind = ukModify then
+      if ScrollResult<>grOK then
         begin
-        RowState:=[rsvUpdated];
-        FCurrentIndex.GotoBookmark(@BookmarkData);
-        FFilterBuffer:=FCurrentIndex.CurrentBuffer;
-        FDatasetReader.StoreRecord(Self, RowState);
-        with ChangeLog[RecUpdBuf] do
-          begin
-          NewEntry:=EntryNr;
-          UpdateKind:=ukModify;
-          end;
-        inc(EntryNr);
+        if getnextpacket>0 then
+          ScrollResult := FCurrentIndex.ScrollForward;
         end;
       end;
+    // There could be a update-buffer linked to the last (spare) record
+    FCurrentIndex.StoreSpareRecIntoBookmark(ABookmark);
+    HandleUpdateBuffersFromRecord(ABookmark^,RowState);
 
     RestoreState(StoreDSState);
 
-    FDatasetReader.EndStoreRecord(ChangeLog);
-    SetLength(ChangeLog,0);
-
+    FDatasetReader.FinalizeStoreRecords;
   finally
     FDatasetReader := nil;
   end;
@@ -2427,7 +2451,10 @@ begin
   if GetRegisterDatapacketReader(AStream,format,APacketReaderReg) then
     APacketReader := APacketReaderReg.ReaderClass.create(AStream)
   else if TFpcBinaryDatapacketReader.RecognizeStream(AStream) then
+    begin
+    AStream.Seek(0,soFromBeginning);
     APacketReader := TFpcBinaryDatapacketReader.create(AStream)
+    end
   else
     DatabaseError(SStreamNotRecognised);
   try
@@ -2472,7 +2499,16 @@ begin
   CreateFields;
 end;
 
-procedure TBufDataset.IntLoadFielddefsFromFile(const FileName: string);
+function TBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
+  ): Longint;
+begin
+  if FCurrentIndex.CompareBookmarks(Bookmark1,Bookmark2) then
+    Result := 0
+  else
+    Result := -1;
+end;
+
+procedure TBufDataset.IntLoadFielddefsFromFile;
 
 begin
   FDatasetReader.LoadFielddefs(FieldDefs);
@@ -2481,44 +2517,69 @@ end;
 
 procedure TBufDataset.IntLoadRecordsFromFile;
 
-
-var StoreState     : TDataSetState;
-    ChangeLog      : TChangeLogEntryArr;
-    ChangeLogStr   : string;
-    ChangeLogInfo  : TChangeLogInfoArr;
-    EntryNr        : integer;
-    i              : integer;
-    IsUpdate,
-    AddRecordBuffer,
-    IsFirstEntry    : boolean;
+var StoreState      : TDataSetState;
+    AddRecordBuffer : boolean;
+    ARowState       : TRowState;
+    AUpdOrder       : integer;
 
 begin
-  FDatasetReader.InitLoadRecords(ChangeLog);
-  EntryNr:=1;
+  FDatasetReader.InitLoadRecords;
   StoreState:=SetTempState(dsFilter);
-  SetLength(ChangeLogInfo,length(ChangeLog));
 
   while FDatasetReader.GetCurrentRecord do
     begin
-    FDatasetReader.GetRecordUpdState(IsUpdate,AddRecordBuffer,IsFirstEntry);
-
-    if IsUpdate then
+    ARowState := FDatasetReader.GetRecordRowState(AUpdOrder);
+    if rsvOriginal in ARowState then
       begin
-      if IsFirstEntry then
-        begin
-        for i := 0 to length(ChangeLog) -1 do
-          if ChangeLog[i].OrigEntry=EntryNr then break;
-        ChangeLogInfo[i].FirstChangeNode:=FDatasetReader.GetCurrentElement;
-        end
+      if length(FUpdateBuffer) < (AUpdOrder+1) then
+        SetLength(FUpdateBuffer,AUpdOrder+1);
+
+      FCurrentUpdateBuffer:=AUpdOrder;
+
+      FFilterBuffer:=IntAllocRecordBuffer;
+      fillchar(FFilterBuffer^,FNullmaskSize,0);
+      FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := FFilterBuffer;
+      FDatasetReader.RestoreRecord(self);
+
+      FDatasetReader.GotoNextRecord;
+      if not FDatasetReader.GetCurrentRecord then
+        DatabaseError(SStreamNotRecognised);
+      ARowState := FDatasetReader.GetRecordRowState(AUpdOrder);
+      if rsvUpdated in ARowState then
+        FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukModify
       else
-        begin
-        for i := 0 to length(ChangeLog) -1 do
-          if ChangeLog[i].NewEntry=EntryNr then break;
-        ChangeLogInfo[i].SecondChangeNode:=FDatasetReader.GetCurrentElement;
-        end;
+        DatabaseError(SStreamNotRecognised);
 
-      FIndexes[0].StoreSpareRecIntoBookmark(@ChangeLogInfo[i].Bookmark);
-      end;
+      FFilterBuffer:=FIndexes[0].SpareBuffer;
+      FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
+      fillchar(FFilterBuffer^,FNullmaskSize,0);
+
+      FDatasetReader.RestoreRecord(self);
+      FIndexes[0].AddRecord(IntAllocRecordBuffer);
+      inc(FBRecordCount);
+
+      AddRecordBuffer:=False;
+
+      end
+    else if rsvDeleted in ARowState then
+      begin
+      if length(FUpdateBuffer) < (AUpdOrder+1) then
+        SetLength(FUpdateBuffer,AUpdOrder+1);
+
+      FCurrentUpdateBuffer:=AUpdOrder;
+
+      FFilterBuffer:=IntAllocRecordBuffer;
+      fillchar(FFilterBuffer^,FNullmaskSize,0);
+      FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := FFilterBuffer;
+      FDatasetReader.RestoreRecord(self);
+
+      FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukDelete;
+      FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
+
+      AddRecordBuffer:=False;
+      end
+    else
+      AddRecordBuffer:=True;
 
     if AddRecordBuffer then
       begin
@@ -2526,43 +2587,23 @@ begin
       fillchar(FFilterBuffer^,FNullmaskSize,0);
 
       FDatasetReader.RestoreRecord(self);
+
+      if rsvInserted in ARowState then
+        begin
+        if length(FUpdateBuffer) < (AUpdOrder+1) then
+          SetLength(FUpdateBuffer,AUpdOrder+1);
+        FCurrentUpdateBuffer:=AUpdOrder;
+        FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukInsert;
+        FCurrentIndex.StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
+        end;
+
       FIndexes[0].AddRecord(IntAllocRecordBuffer);
       inc(FBRecordCount);
       end;
 
     FDatasetReader.GotoNextRecord;
-    inc(EntryNr);
     end;
 
-  // Iterate through the ChangeLog list and add modifications to he update buffer
-  for i := 0 to length(ChangeLog)-1 do
-    begin
-    FCurrentUpdateBuffer:=Length(FUpdateBuffer);
-    setlength(FUpdateBuffer,FCurrentUpdateBuffer+1);
-    case ChangeLog[i].UpdateKind of
-      ukDelete : begin
-                 FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:=ukDelete;
-                 FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData:=ChangeLogInfo[i].Bookmark;
-                 FDatasetReader.GotoElement(ChangeLogInfo[i].FirstChangeNode);
-                 FDatasetReader.RestoreRecord(self);
-                 FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer:=IntAllocRecordBuffer;
-                 move(findexes[0].SpareBuffer^,FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
-                 end;
-      ukModify : begin
-                 FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:=ukModify;
-                 FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData:=ChangeLogInfo[i].Bookmark;
-                 FDatasetReader.GotoElement(ChangeLogInfo[i].SecondChangeNode);
-                 FDatasetReader.RestoreRecord(self);
-                 FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer:=IntAllocRecordBuffer;
-                 move(findexes[0].SpareBuffer^,FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
-                 end;
-      ukInsert : begin
-                 FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:=ukInsert;
-                 FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData:=ChangeLogInfo[i].Bookmark;
-                 FDatasetReader.GotoElement(ChangeLogInfo[i].FirstChangeNode);
-                 end;
-    end; {case}
-    end;
   RestoreState(StoreState);
   FIndexes[0].SetToFirstRecord;
   FAllPacketsFetched:=True;
@@ -2820,6 +2861,7 @@ end;
 
 constructor TArrayBufIndex.Create(const ADataset: TBufDataset);
 begin
+  Inherited create(ADataset);
   FInitialBuffers:=10000;
   FGrowBuffer:=1000;
 end;
@@ -2993,6 +3035,27 @@ end;
 
 { TDataPacketReader }
 
+class function TDataPacketReader.RowStateToByte(const ARowState: TRowState
+  ): byte;
+var RowStateInt : Byte;
+begin
+  RowStateInt:=0;
+  if rsvOriginal in ARowState then RowStateInt := RowStateInt+1;
+  if rsvDeleted in ARowState then RowStateInt := RowStateInt+2;
+  if rsvInserted in ARowState then RowStateInt := RowStateInt+4;
+  if rsvUpdated in ARowState then RowStateInt := RowStateInt+8;
+  Result := RowStateInt;
+end;
+
+class function TDataPacketReader.ByteToRowState(const AByte: Byte): TRowState;
+begin
+  result := [];
+  if (AByte and 1)=1 then Result := Result+[rsvOriginal];
+  if (AByte and 2)=2 then Result := Result+[rsvDeleted];
+  if (AByte and 4)=4 then Result := Result+[rsvInserted];
+  if (AByte and 8)=8 then Result := Result+[rsvUpdated];
+end;
+
 constructor TDataPacketReader.create(AStream: TStream);
 begin
   FStream := AStream;
@@ -3044,17 +3107,20 @@ begin
     end;
 end;
 
-procedure TFpcBinaryDatapacketReader.GetRecordUpdState(var AIsUpdate,
-  AAddRecordBuffer, AIsFirstEntry: boolean);
+function TFpcBinaryDatapacketReader.GetRecordRowState(out AUpdOrder : Integer) : TRowState;
+var Buf : byte;
 begin
-  AIsUpdate:=False;
-  AAddRecordBuffer:=True;
+  Stream.Read(Buf,1);
+  Result := ByteToRowState(Buf);
+  if Result<>[] then
+    Stream.ReadBuffer(AUpdOrder,sizeof(integer))
+  else
+    AUpdOrder := 0;
 end;
 
-procedure TFpcBinaryDatapacketReader.EndStoreRecord(
-  const AChangeLog: TChangeLogEntryArr);
+procedure TFpcBinaryDatapacketReader.FinalizeStoreRecords;
 begin
-//  inherited EndStoreRecord(AChangeLog);
+//  Do nothing
 end;
 
 function TFpcBinaryDatapacketReader.GetCurrentRecord: boolean;
@@ -3068,20 +3134,9 @@ begin
 //  Do Nothing
 end;
 
-procedure TFpcBinaryDatapacketReader.GotoElement(const AnElement: pointer);
-begin
-//  inherited GotoElement(AnElement);
-end;
-
-procedure TFpcBinaryDatapacketReader.InitLoadRecords(
-  var AChangeLog: TChangeLogEntryArr);
-begin
-  SetLength(AChangeLog,0);
-end;
-
-function TFpcBinaryDatapacketReader.GetCurrentElement: pointer;
+procedure TFpcBinaryDatapacketReader.InitLoadRecords;
 begin
-//  Result:=inherited GetCurrentElement;
+//  SetLength(AChangeLog,0);
 end;
 
 procedure TFpcBinaryDatapacketReader.RestoreRecord(ADataset: TBufDataset);
@@ -3090,10 +3145,13 @@ begin
 end;
 
 procedure TFpcBinaryDatapacketReader.StoreRecord(ADataset: TBufDataset;
-  RowState: TRowState);
+  ARowState: TRowState; AUpdOrder : integer);
 begin
   // Ugly because private members of ADataset are used...
   Stream.WriteByte($fe);
+  Stream.WriteByte(RowStateToByte(ARowState));
+  if ARowState<>[] then
+    Stream.WriteBuffer(AUpdOrder,sizeof(integer));
   Stream.WriteBuffer(ADataset.GetCurrentBuffer^,ADataset.FRecordSize);
 end;
 

packages/fcl-db/src/base/xmldatapacketreader.pp

@@ -23,6 +23,14 @@ interface
 uses
   Classes, SysUtils, Bufdataset, dom, db;
 
+type
+  TChangeLogEntry = record
+       UpdateKind : TUpdateKind;
+       OrigEntry  : integer;
+       NewEntry   : integer;
+  end;
+  TChangeLogEntryArr = array of TChangeLogEntry;
+
 type
   { TXMLDatapacketReader }
 
@@ -34,21 +42,21 @@ type
     FChangeLogNode,
     FParamsNode,
     FRowDataNode,
-    FRecordNode       : TDOMNode;
+    FRecordNode    : TDOMNode;
+    FChangeLog     : TChangeLogEntryArr;
+    FEntryNr       : integer;
+    FLastChange    : integer;
   public
     destructor destroy; override;
-    procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
     procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
-    procedure GetRecordUpdState(var AIsUpdate, AAddRecordBuffer,
-                     AIsFirstEntry: boolean); override;
-    procedure EndStoreRecord(const AChangeLog : TChangeLogEntryArr); override;
+    procedure StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
+    procedure FinalizeStoreRecords; override;
+    procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
+    procedure InitLoadRecords; override;
     function GetCurrentRecord : boolean; override;
-    procedure GotoNextRecord; override;
-    procedure GotoElement(const AnElement : pointer); override;
-    procedure InitLoadRecords(var AChangeLog : TChangeLogEntryArr); override;
-    function GetCurrentElement: pointer; override;
+    function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
     procedure RestoreRecord(ADataset : TBufDataset); override;
-    procedure StoreRecord(ADataset : TBufDataset; RowState : TRowState); override;
+    procedure GotoNextRecord; override;
     class function RecognizeStream(AStream : TStream) : boolean; override;
   end;
 
@@ -101,6 +109,9 @@ const
       ''
     );
 
+resourcestring
+  sUnknownXMLDatasetFormat = 'Unknown XML Dataset format';
+
 { TXMLDatapacketReader }
 
 destructor TXMLDatapacketReader.destroy;
@@ -131,13 +142,13 @@ var i           : integer;
 begin
   ReadXMLFile(XMLDocument,Stream);
   DataPacketNode := XMLDocument.FindNode('DATAPACKET') as TDOMElement;
-  if not assigned(DataPacketNode) then DatabaseError('Onbekend formaat');
+  if not assigned(DataPacketNode) then DatabaseError(sUnknownXMLDatasetFormat);
 
   MetaDataNode := DataPacketNode.FindNode('METADATA');
-  if not assigned(MetaDataNode) then DatabaseError('Onbekend formaat');
+  if not assigned(MetaDataNode) then DatabaseError(sUnknownXMLDatasetFormat);
 
   FieldsNode := MetaDataNode.FindNode('FIELDS');
-  if not assigned(FieldsNode) then DatabaseError('Onbekend formaat');
+  if not assigned(FieldsNode) then DatabaseError(sUnknownXMLDatasetFormat);
 
   with FieldsNode.ChildNodes do for i := 0 to Count - 1 do
     begin
@@ -166,7 +177,6 @@ begin
 
   FRowDataNode := DataPacketNode.FindNode('ROWDATA');
   FRecordNode := nil;
-
 end;
 
 procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
@@ -214,43 +224,24 @@ begin
   MetaDataNode.AppendChild(FParamsNode);
   DataPacketNode.AppendChild(MetaDataNode);
   FRowDataNode := XMLDocument.CreateElement('ROWDATA');
+  setlength(FChangeLog,0);
+  FEntryNr:=0;
+  FLastChange:=-1;
 end;
 
-procedure TXMLDatapacketReader.GetRecordUpdState(var AIsUpdate,
-  AAddRecordBuffer, AIsFirstEntry: boolean);
-var ARowStateNode  : TDOmNode;
-    ARowState      : integer;
-
-begin
-  ARowStateNode := FRecordNode.Attributes.GetNamedItem('RowState');
-  if ARowStateNode = nil then // This item is not edited
-    begin
-    AIsUpdate:=False;
-    AAddRecordBuffer:=True;
-    end
-  else
-    begin
-    AIsUpdate:=True;
-    ARowState:=StrToIntDef(ARowStateNode.NodeValue,0);
-    AAddRecordBuffer:=((ARowState and 5) = 4)      // This item contains an inserted record which is not edited afterwards
-                      or ((ARowState and 9) = 8); // This item contains the last edited record
-    AIsFirstEntry:=((ARowState and 2) = 2)         // This item is deleted
-                 or ((ARowState and 8) = 8)       // This item is a change
-    end;
-end;
-
-procedure TXMLDatapacketReader.EndStoreRecord(const AChangeLog : TChangeLogEntryArr);
+procedure TXMLDatapacketReader.FinalizeStoreRecords;
 var ChangeLogStr : String;
     i            : integer;
 begin
   ChangeLogStr:='';
-  for i := 0 to length(AChangeLog) -1 do with AChangeLog[i] do
+  for i := 0 to length(FChangeLog)-1 do with FChangeLog[i] do
     begin
     ChangeLogStr:=ChangeLogStr+' '+inttostr(NewEntry)+' '+inttostr(OrigEntry)+' ';
     if UpdateKind=ukModify then ChangeLogStr := ChangeLogStr+'8';
     if UpdateKind=ukInsert then ChangeLogStr := ChangeLogStr+'4';
     if UpdateKind=ukDelete then ChangeLogStr := ChangeLogStr+'2';
     end;
+  setlength(FChangeLog,0);
 
   if ChangeLogStr<>'' then
     (FParamsNode as TDomElement).SetAttribute('CHANGE_LOG',Trim(ChangeLogStr));
@@ -266,8 +257,35 @@ begin
   Result := assigned(FRecordNode);
 end;
 
-procedure TXMLDatapacketReader.InitLoadRecords(
-  var AChangeLog: TChangeLogEntryArr);
+function TXMLDatapacketReader.GetRecordRowState(out AUpdOrder: Integer
+  ): TRowState;
+var ARowStateNode  : TDOmNode;
+    ARowState      : integer;
+    i              : integer;
+begin
+  ARowStateNode := FRecordNode.Attributes.GetNamedItem('RowState');
+  if ARowStateNode = nil then // This item is not edited
+    Result := []
+  else
+    begin
+    Result := ByteToRowState(StrToIntDef(ARowStateNode.NodeValue,0));
+    if Result = [rsvOriginal] then
+      begin
+      for i := 0 to length(FChangeLog)-1 do
+        if FChangeLog[i].NewEntry=FEntryNr then break;
+      assert(FChangeLog[i].NewEntry=FEntryNr);
+      end
+    else
+      begin
+      for i := 0 to length(FChangeLog)-1 do
+        if FChangeLog[i].OrigEntry=FEntryNr then break;
+      assert(FChangeLog[i].OrigEntry=FEntryNr);
+      end;
+    AUpdOrder:=i;
+    end;
+end;
+
+procedure TXMLDatapacketReader.InitLoadRecords;
 
 var ChangeLogStr : String;
     i,cp         : integer;
@@ -275,6 +293,8 @@ var ChangeLogStr : String;
 
 begin
   FRecordNode := FRowDataNode.FirstChild;
+  FEntryNr := 1;
+  setlength(FChangeLog,0);
   if assigned(FChangeLogNode) then
     ChangeLogStr:=FChangeLogNode.NodeValue
   else
@@ -289,17 +309,17 @@ begin
       begin
       case (cp mod 3) of
         0 : begin
-            SetLength(AChangeLog,length(AChangeLog)+1);
-            AChangeLog[cp div 3].OrigEntry:=StrToIntDef(ps,0);
+            SetLength(FChangeLog,length(FChangeLog)+1);
+            FChangeLog[cp div 3].OrigEntry:=StrToIntDef(ps,0);
             end;
-        1 : AChangeLog[cp div 3].NewEntry:=StrToIntDef(ps,0);
+        1 : FChangeLog[cp div 3].NewEntry:=StrToIntDef(ps,0);
         2 : begin
             if ps = '2' then
-              AChangeLog[cp div 3].UpdateKind:=ukDelete
+              FChangeLog[cp div 3].UpdateKind:=ukDelete
             else if ps = '4' then
-              AChangeLog[cp div 3].UpdateKind:=ukInsert
+              FChangeLog[cp div 3].UpdateKind:=ukInsert
             else if ps = '8' then
-              AChangeLog[cp div 3].UpdateKind:=ukModify;
+              FChangeLog[cp div 3].UpdateKind:=ukModify;
             end;
       end; {case}
       ps := '';
@@ -308,11 +328,6 @@ begin
     end;
 end;
 
-function TXMLDatapacketReader.GetCurrentElement: pointer;
-begin
-  Result:=FRecordNode;
-end;
-
 procedure TXMLDatapacketReader.RestoreRecord(ADataset : TBufDataset);
 var FieldNr    : integer;
     AFieldNode : TDomNode;
@@ -322,29 +337,37 @@ begin
     AFieldNode := FRecordNode.Attributes.GetNamedItem(Fields[FieldNr].FieldName);
     if assigned(AFieldNode) then
       begin
-      Fields[FieldNr].AsString := AFieldNode.NodeValue;  // set it to the sparebuf
+      Fields[FieldNr].AsString := AFieldNode.NodeValue;  // set it to the filterbuffer
       end
     end;
 end;
 
-procedure TXMLDatapacketReader.StoreRecord(ADataset: TBufDataset;
-  RowState: TRowState);
+procedure TXMLDatapacketReader.StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0);
 var FieldNr : Integer;
-    RowStateInt : Integer;
     ARecordNode : TDOMElement;
 begin
+  inc(FEntryNr);
   ARecordNode := XMLDocument.CreateElement('ROW');
   for FieldNr := 0 to ADataset.Fields.Count-1 do
     begin
     ARecordNode.SetAttribute(ADataset.fields[FieldNr].FieldName,ADataset.fields[FieldNr].AsString);
     end;
-  RowStateInt:=0;
-  if rsvOriginal in RowState then RowStateInt := RowStateInt+1;
-  if rsvInserted in RowState then RowStateInt := RowStateInt+4;
-  if rsvUpdated in RowState then RowStateInt := RowStateInt+8;
-  RowStateInt:=integer(RowState);
-  if RowStateInt<>0 then
-    ARecordNode.SetAttribute('RowState',inttostr(RowStateInt));
+  if ARowState<>[] then
+    begin
+    ARecordNode.SetAttribute('RowState',inttostr(RowStateToByte(ARowState)));
+    if AUpdOrder>=length(FChangeLog) then
+      setlength(FChangeLog,AUpdOrder+1);
+    if (rsvOriginal in ARowState) or (rsvDeleted in ARowState) then
+      FChangeLog[AUpdOrder].OrigEntry:=FEntryNr;
+    if (rsvDeleted in ARowState) or (rsvUpdated in ARowState) or (rsvInserted in ARowState) then
+      FChangeLog[AUpdOrder].NewEntry:=FEntryNr;
+    if ARowState=[rsvUpdated] then
+      FChangeLog[AUpdOrder].UpdateKind := ukModify;
+    if ARowState=[rsvInserted] then
+      FChangeLog[AUpdOrder].UpdateKind := ukInsert;
+    if ARowState=[rsvDeleted] then
+      FChangeLog[AUpdOrder].UpdateKind := ukDelete;
+    end;
   FRowDataNode.AppendChild(ARecordNode);
 end;
 
@@ -365,15 +388,11 @@ end;
 procedure TXMLDatapacketReader.GotoNextRecord;
 begin
   FRecordNode := FRecordNode.NextSibling;
+  inc(FEntryNr);
   while assigned(FRecordNode) and (FRecordNode.CompareName('ROW')<>0) do
     FRecordNode := FRecordNode.NextSibling;
 end;
 
-procedure TXMLDatapacketReader.GotoElement(const AnElement: pointer);
-begin
-  FRecordNode:=TDomNode(AnElement);
-end;
-
 initialization
   RegisterDatapacketReader(TXMLDatapacketReader,dfXML);
 end.

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -1,6 +1,5 @@
 
 {$mode objfpc}{$H+}
-{$MACRO on}
 
 interface
 
@@ -8,30 +7,14 @@ uses
   Classes, SysUtils,bufdataset,sqldb,db,dynlibs,
 {$IfDef mysql50}
   mysql50dyn;
-  {$DEFINE TConnectionName:=TMySQL50Connection}
-  {$DEFINE TMySQLConnectionDef:=TMySQL50ConnectionDef}
-  {$DEFINE TTransactionName:=TMySQL50Transaction}
-  {$DEFINE TCursorName:=TMySQL50Cursor}
 {$ELSE}
   {$IfDef mysql41}
     mysql41dyn;
-    {$DEFINE TConnectionName:=TMySQL41Connection}
-    {$DEFINE TMySQLConnectionDef:=TMySQL41ConnectionDef}
-    {$DEFINE TTransactionName:=TMySQL41Transaction}
-    {$DEFINE TCursorName:=TMySQL41Cursor}
   {$ELSE}
     {$IFDEF mysql4} // temporary backwards compatibility for Lazarus
       mysql40dyn;
-      {$DEFINE TConnectionName:=TMySQLConnection}
-      {$DEFINE TMySQLConnectionDef:=TMySQL40ConnectionDef}
-      {$DEFINE TTransactionName:=TMySQLTransaction}
-      {$DEFINE TCursorName:=TMySQLCursor}
     {$ELSE}
       mysql40dyn;
-      {$DEFINE TConnectionName:=TMySQL40Connection}
-      {$DEFINE TMySQLConnectionDef:=TMySQL40ConnectionDef}
-      {$DEFINE TTransactionName:=TMySQL40Transaction}
-      {$DEFINE TCursorName:=TMySQL40Cursor}
     {$EndIf}
   {$EndIf}
 {$EndIf}
@@ -149,6 +132,33 @@ Type
 
   EMySQLError = Class(Exception);
 
+{$IfDef mysql50}
+  TMySQL50Connection = Class(TConnectionName);
+  TMySQL50ConnectionDef = Class(TMySQLConnectionDef);
+  TMySQL50Transaction = Class(TTransactionName);
+  TMySQL50Cursor = Class(TCursorName);
+{$ELSE}
+  {$IfDef mysql41}
+    TMySQL41Connection = Class(TConnectionName);
+    TMySQL41ConnectionDef = Class(TMySQLConnectionDef);
+    TMySQL41Transaction = Class(TTransactionName);
+    TMySQL41Cursor = Class(TCursorName);
+  {$ELSE}
+    {$IFDEF mysql4} // temporary backwards compatibility for Lazarus
+      TMySQLConnection = Class(TConnectionName);
+      TMySQL40ConnectionDef = Class(TMySQLConnectionDef);
+      TMySQLTransaction = Class(TTransactionName);
+      TMySQLCursor = Class(TCursorName);
+    {$ELSE}
+      TMySQL40Connection = Class(TConnectionName);
+      TMySQL40ConnectionDef = Class(TMySQLConnectionDef);
+      TMySQL40Transaction = Class(TTransactionName);
+      TMySQL40Cursor = Class(TCursorName);
+    {$EndIf}
+  {$EndIf}
+{$EndIf}
+
+
 implementation
 
 uses dbconst,ctypes,strutils;
@@ -349,7 +359,19 @@ end;
 
 function TConnectionName.AllocateCursorHandle: TSQLCursor;
 begin
-  Result:=TCursorName.Create;
+  {$IfDef mysql50}
+    Result:=TMySQL50Cursor.Create;
+  {$ELSE}
+    {$IfDef mysql41}
+      Result:=TMySQL41Cursor.Create;
+    {$ELSE}
+      {$IFDEF mysql4} // temporary backwards compatibility for Lazarus
+        Result:=TMySQLCursor.Create;
+      {$ELSE}
+        Result:=TMySQL40Cursor.Create;
+      {$EndIf}
+    {$EndIf}
+  {$EndIf}
 end;
 
 Procedure TConnectionName.DeAllocateCursorHandle(var cursor : TSQLCursor);
@@ -957,7 +979,19 @@ end;
 
 class function TMySQLConnectionDef.ConnectionClass: TSQLConnectionClass;
 begin
-  Result:=TConnectionName;
+  {$IfDef mysql50}
+    Result:=TMySQL50Connection;
+  {$ELSE}
+    {$IfDef mysql41}
+      Result:=TMySQL41Connection;
+    {$ELSE}
+      {$IFDEF mysql4} // temporary backwards compatibility for Lazarus
+        Result:=TMySQLConnection;
+      {$ELSE}
+        Result:=TMySQL40Connection;
+      {$EndIf}
+    {$EndIf}
+  {$EndIf}
 end;
 
 class function TMySQLConnectionDef.Description: String;
@@ -965,8 +999,30 @@ begin
   Result:='Connect to a MySQL '+MySQLVersion+'database directly via the client library';
 end;
 
-initialization
-  RegisterConnection(TMySQLConnectionDef);
-finalization
-  UnRegisterConnection(TMySQLConnectionDef);
+{$IfDef mysql50}
+  initialization
+    RegisterConnection(TMySQL50ConnectionDef);
+  finalization
+    UnRegisterConnection(TMySQL50ConnectionDef);
+{$ELSE}
+  {$IfDef mysql41}
+    initialization
+      RegisterConnection(TMySQL41ConnectionDef);
+    finalization
+      UnRegisterConnection(TMySQL41ConnectionDef);
+  {$ELSE}
+    {$IFDEF mysql4} // temporary backwards compatibility for Lazarus
+      initialization
+        RegisterConnection(TMySQL40ConnectionDef);
+      finalization
+        UnRegisterConnection(TMySQL40ConnectionDef);
+    {$ELSE}
+      initialization
+        RegisterConnection(TMySQL40ConnectionDef);
+      finalization
+        UnRegisterConnection(TMySQL40ConnectionDef);
+    {$EndIf}
+  {$EndIf}
+{$EndIf}
+
 end.

packages/fcl-fpcunit/fpmake.pp

@@ -23,7 +23,7 @@ begin
 
     P.Author := ' Dean Zobec, Michael van Canneyt';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Unit testing system inspired by JUnit of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;

packages/fcl-image/fpmake.pp

@@ -23,7 +23,7 @@ begin
 
     P.Author := 'Michael Van Canneyt of the Free Pascal development team';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Image loading and conversion parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;

packages/fcl-json/fpmake.pp

@@ -20,7 +20,7 @@ begin
     P.Dependencies.Add('fcl-base');
     P.Author := 'Michael van Canneyt';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Json interfacing, part of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;

packages/fcl-net/fpmake.pp

@@ -24,7 +24,7 @@ begin
 
     P.Author := 'Sebastian Guenther and Free Pascal development team';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Network related parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;

packages/fcl-net/src/ssockets.pp

@@ -546,8 +546,8 @@ Var
   addr: TInetSockAddr;
 
 begin
-  A := StrToNetAddr(FHost);
-  if A.s_bytes[4] = 0 then
+  A := StrToHostAddr(FHost);
+  if A.s_bytes[1] = 0 then
     With THostResolver.Create(Nil) do
       try
         If Not NameLookup(FHost) then

packages/fcl-passrc/fpmake.pp

@@ -20,7 +20,7 @@ begin
     P.Dependencies.Add('fcl-base');
     P.Author := 'Sebastian Guenther';
     P.License := 'LGPL with modification, ';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Pascal parsing parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;

packages/fcl-process/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/11/18]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -788,49 +788,49 @@ ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_OPTIONS+=-S2h
 endif
 ifeq ($(FULL_TARGET),i386-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/os2 src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-netware)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/os2
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/os2 src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -839,7 +839,7 @@ ifeq ($(FULL_TARGET),i386-netwlibc)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win src/dummy
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -848,13 +848,13 @@ ifeq ($(FULL_TARGET),i386-symbian)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -863,7 +863,7 @@ ifeq ($(FULL_TARGET),m68k-atari)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -872,10 +872,10 @@ ifeq ($(FULL_TARGET),m68k-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -884,7 +884,7 @@ ifeq ($(FULL_TARGET),powerpc-macos)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -893,43 +893,43 @@ ifeq ($(FULL_TARGET),powerpc-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win src/dummy
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/win src/dummy
 endif
 ifeq ($(FULL_TARGET),arm-gba)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -944,10 +944,10 @@ ifeq ($(FULL_TARGET),arm-symbian)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
@@ -956,7 +956,7 @@ ifeq ($(FULL_TARGET),avr-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix
+override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src  src/unix src/dummy
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override COMPILER_INCLUDEDIR+=src/$(OS_TARGET) src

packages/fcl-process/Makefile.fpc

@@ -27,19 +27,21 @@ rsts=process simpleipc
 [compiler]
 options=-S2h
 includedir=src/$(OS_TARGET) src
-includedir_linux=src/unix
-includedir_freebsd=src/unix
-includedir_darwin=src/unix
-includedir_netbsd=src/unix
-includedir_openbsd=src/unix
-includedir_solaris=src/unix
-includedir_qnx=src/unix
-includedir_beos=src/unix
-includedir_haiku=src/unix
-includedir_emx=src/os2
-includedir_win32=src/win
-includedir_win64=src/win
-includedir_wince=src/win
+includedir_linux=src/unix src/dummy
+includedir_freebsd=src/unix src/dummy
+includedir_darwin=src/unix src/dummy
+includedir_netbsd=src/unix src/dummy
+includedir_openbsd=src/unix src/dummy
+includedir_solaris=src/unix src/dummy
+includedir_qnx=src/unix src/dummy
+includedir_beos=src/unix src/dummy
+includedir_haiku=src/unix src/dummy
+includedir_emx=src/os2 src/dummy
+includedir_win32=src/win src/dummy
+includedir_win64=src/win src/dummy
+includedir_wince=src/win src/dummy
+includedir_go32v2=src/dummy
+includedir_os2=src/os2 src/dummy
 sourcedir=src/$(OS_TARGET) src
 
 [install]

packages/fcl-process/fpmake.pp

@@ -19,7 +19,7 @@ begin
     P.Version:='2.2.2-0';
     P.Author := 'Michael van Canneyt and Free Pascal Development team';
     P.License := 'LGPL with modification';
-    P.ExternalURL := 'www.freepascal.org';
+    P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
     P.Description := 'Process (execution) related parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
@@ -28,6 +28,8 @@ begin
     P.IncludePath.Add('src/unix',AllUnixOSes);
     P.IncludePath.Add('src/win',AllWindowsOSes);
     P.IncludePath.Add('src/$(OS)',AllOSes-AllWindowsOSes-AllUnixOSes);
+    P.IncludePath.Add('src/dummy');
+
     T:=P.Targets.AddUnit('pipes.pp');
       T.Dependencies.AddInclude('pipes.inc');
     T:=P.Targets.AddUnit('process.pp');

packages/fcl-process/src/amiga/pipes.inc

@@ -1,30 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt
-
-    AmigaOS specific part of pipe stream.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-// Unsupported for the moment...
-
-Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
-
-begin
-  Result := False;
-end;
-
-
-Function TInputPipeStream.GetNumBytesAvailable: DWord;
-
-begin
-  Result := 0;
-end;
-

packages/fcl-process/src/amiga/process.inc

@@ -1,42 +0,0 @@
-{
-  Dummy process.inc
-}
-
-procedure TProcess.CloseProcessHandles;
-begin
-end;
-
-Function TProcess.PeekExitStatus : Boolean;
-begin
-end;
-
-Procedure TProcess.Execute;
-begin
-end;
-
-Function TProcess.WaitOnExit : Boolean;
-begin
-  Result:=False;
-end;
-
-Function TProcess.Suspend : Longint;
-begin
-  Result:=0;
-end;
-
-Function TProcess.Resume : LongInt;
-
-begin
-  Result:=0;
-end;
-
-Function TProcess.Terminate(AExitCode : Integer) : Boolean;
-begin
-  Result:=False;
-end;
-
-Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
-begin
-end;
-
-

packages/fcl-process/src/beos/pipes.inc

@@ -1,30 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt
-
-    DOS/go32v2 specific part of pipe stream.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-// No pipes under beos, sorry...
-
-Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
-
-begin
-  Result := False;
-end;
-
-
-Function TInputPipeStream.GetNumBytesAvailable: DWord;
-
-begin
-  Result := 0;
-end;
-

packages/fcl-process/src/dummy/simpleipc.inc

@@ -0,0 +1,13 @@
+{
+  dummy simpleipc.inc
+}
+
+Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
+begin
+  Result:=nil;
+end;
+
+function TSimpleIPCClient.CommClass: TIPCClientCommClass;
+begin
+  Result:=nil;
+end;

packages/fcl-process/src/haiku/pipes.inc

@@ -1,30 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt
-
-    DOS/go32v2 specific part of pipe stream.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-// No pipes under beos, sorry...
-
-Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
-
-begin
-  Result := False;
-end;
-
-
-Function TInputPipeStream.GetNumBytesAvailable: DWord;
-
-begin
-  Result := 0;
-end;
-

packages/fcl-process/src/morphos/pipes.inc

@@ -1,30 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt
-
-    AmigaOS specific part of pipe stream.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-// Unsupported for the moment...
-
-Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
-
-begin
-  Result := False;
-end;
-
-
-Function TInputPipeStream.GetNumBytesAvailable: DWord;
-
-begin
-  Result := 0;
-end;
-

packages/fcl-process/src/morphos/process.inc

@@ -1,42 +0,0 @@
-{
-  Dummy process.inc
-}
-
-procedure TProcess.CloseProcessHandles;
-begin
-end;
-
-Function TProcess.PeekExitStatus : Boolean;
-begin
-end;
-
-Procedure TProcess.Execute;
-begin
-end;
-
-Function TProcess.WaitOnExit : Boolean;
-begin
-  Result:=False;
-end;
-
-Function TProcess.Suspend : Longint;
-begin
-  Result:=0;
-end;
-
-Function TProcess.Resume : LongInt;
-
-begin
-  Result:=0;
-end;
-
-Function TProcess.Terminate(AExitCode : Integer) : Boolean;
-begin
-  Result:=False;
-end;
-
-Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
-begin
-end;
-
-

packages/fcl-process/src/netware/pipes.inc

@@ -1,30 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt
-
-    Netware specific part of pipe stream.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-// Unsupported for the moment...
-
-Function CreatePipeHandles (Var Inhandle,OutHandle : THandle) : Boolean;
-
-begin
-  Result := false;  {dont know how to do that with netware clib}
-end;
-
-
-Function TInputPipeStream.GetNumBytesAvailable: DWord;
-
-begin
-  Result := 0;
-end;
-

packages/fcl-process/src/netware/process.inc

@@ -1,42 +0,0 @@
-{
-  Dummy process.inc
-}
-
-procedure TProcess.CloseProcessHandles;
-begin
-end;
-
-Function TProcess.PeekExitStatus : Boolean;
-begin
-end;
-
-Procedure TProcess.Execute;
-begin
-end;
-
-Function TProcess.WaitOnExit : Boolean;
-begin
-  Result:=False;
-end;
-
-Function TProcess.Suspend : Longint;
-begin
-  Result:=0;
-end;
-
-Function TProcess.Resume : LongInt;
-
-begin
-  Result:=0;
-end;
-
-Function TProcess.Terminate(AExitCode : Integer) : Boolean;
-begin
-  Result:=False;
-end;
-
-Procedure TProcess.SetShowWindow (Value : TShowWindowOptions);
-begin
-end;
-
-