Merged revisions 11879-11880,11884-11888,11890,11896-11898,11903-11919,11926-11930,11933-11934,11936-11937,11939-11940,11942-11985,11987-11991,11993-12013,12015-12017,12019-12040,12043,12045,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

git-svn-id: branches/wpo@12210 -

.gitattributes

@@ -713,6 +713,7 @@ ide/unit.pt -text
 ide/vesa.pas svneol=native#text/plain
 ide/wansi.pas svneol=native#text/plain
 ide/wcedit.pas svneol=native#text/plain
+ide/wchmhwrap.pas svneol=native#text/plain
 ide/wconsole.pas svneol=native#text/plain
 ide/wconsts.pas svneol=native#text/plain
 ide/wconstse.inc svneol=native#text/plain
@@ -952,15 +953,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
@@ -1022,6 +1026,7 @@ packages/fcl-base/examples/dparser.pp svneol=native#text/plain
 packages/fcl-base/examples/dsockcli.pp svneol=native#text/plain
 packages/fcl-base/examples/dsocksvr.pp svneol=native#text/plain
 packages/fcl-base/examples/fpdoc.dtd -text
+packages/fcl-base/examples/fpexprpars.txt svneol=native#text/plain
 packages/fcl-base/examples/fstream.pp svneol=native#text/plain
 packages/fcl-base/examples/htdump.pp svneol=native#text/plain
 packages/fcl-base/examples/intl/Makefile svneol=native#text/plain
@@ -1066,6 +1071,7 @@ packages/fcl-base/examples/testbs.pp svneol=native#text/plain
 packages/fcl-base/examples/testcgi.html -text
 packages/fcl-base/examples/testcgi.pp svneol=native#text/plain
 packages/fcl-base/examples/testcont.pp svneol=native#text/plain
+packages/fcl-base/examples/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/examples/testez.pp svneol=native#text/plain
 packages/fcl-base/examples/testhres.pp svneol=native#text/plain
 packages/fcl-base/examples/testnres.pp svneol=native#text/plain
@@ -1092,34 +1098,28 @@ packages/fcl-base/examples/tstelgtk.pp svneol=native#text/plain
 packages/fcl-base/examples/txmlreg.pp svneol=native#text/plain
 packages/fcl-base/examples/xmldump.pp svneol=native#text/plain
 packages/fcl-base/fpmake.pp svneol=native#text/plain
-packages/fcl-base/src/amiga/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/avl_tree.pp svneol=native#text/plain
 packages/fcl-base/src/base64.pp svneol=native#text/plain
-packages/fcl-base/src/beos/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/blowfish.pp svneol=native#text/plain
 packages/fcl-base/src/bufstream.pp svneol=native#text/plain
 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
 packages/fcl-base/src/go32v2/custapp.inc svneol=native#text/plain
-packages/fcl-base/src/go32v2/eventlog.inc svneol=native#text/plain
-packages/fcl-base/src/haiku/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/idea.pp svneol=native#text/plain
 packages/fcl-base/src/inicol.pp svneol=native#text/plain
 packages/fcl-base/src/inifiles.pp svneol=native#text/plain
 packages/fcl-base/src/iostream.pp svneol=native#text/plain
 packages/fcl-base/src/libtar.pp svneol=native#text/plain
 packages/fcl-base/src/maskutils.pp svneol=native#text/plain
-packages/fcl-base/src/morphos/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/netware/custapp.inc svneol=native#text/plain
-packages/fcl-base/src/netware/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/netwlibc/custapp.inc svneol=native#text/plain
-packages/fcl-base/src/netwlibc/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/os2/custapp.inc svneol=native#text/plain
 packages/fcl-base/src/os2/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/pooledmm.pp svneol=native#text/plain
@@ -1142,7 +1142,6 @@ packages/fcl-base/src/win/fclel.mc -text
 packages/fcl-base/src/win/fclel.rc -text
 packages/fcl-base/src/win/fclel.res -text
 packages/fcl-base/src/win/fileinfo.pp svneol=native#text/plain
-packages/fcl-base/src/wince/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/wtex.pp svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
@@ -1411,13 +1410,16 @@ packages/fcl-image/src/fpreadpcx.pas svneol=native#text/plain
 packages/fcl-image/src/fpreadpng.pp svneol=native#text/plain
 packages/fcl-image/src/fpreadpnm.pp svneol=native#text/plain
 packages/fcl-image/src/fpreadtga.pp svneol=native#text/plain
+packages/fcl-image/src/fpreadtiff.pas svneol=native#text/plain
 packages/fcl-image/src/fpreadxpm.pp svneol=native#text/plain
+packages/fcl-image/src/fptiffcmn.pas svneol=native#text/plain
 packages/fcl-image/src/fpwritebmp.pp svneol=native#text/plain
 packages/fcl-image/src/fpwritejpeg.pas svneol=native#text/plain
 packages/fcl-image/src/fpwritepcx.pas svneol=native#text/plain
 packages/fcl-image/src/fpwritepng.pp svneol=native#text/plain
 packages/fcl-image/src/fpwritepnm.pp svneol=native#text/plain
 packages/fcl-image/src/fpwritetga.pp svneol=native#text/plain
+packages/fcl-image/src/fpwritetiff.pas svneol=native#text/plain
 packages/fcl-image/src/fpwritexpm.pp svneol=native#text/plain
 packages/fcl-image/src/freetype.pp svneol=native#text/plain
 packages/fcl-image/src/freetypeh.pp svneol=native#text/plain
@@ -1492,22 +1494,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
@@ -1519,7 +1511,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
@@ -1693,6 +1684,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
@@ -1706,6 +1699,7 @@ packages/fv/examples/platform.inc svneol=native#text/plain
 packages/fv/examples/testapp.lpi svneol=native#text/plain
 packages/fv/examples/testapp.pas svneol=native#text/plain
 packages/fv/fpmake.pp svneol=native#text/plain
+packages/fv/src/amismsg.inc svneol=native#text/plain
 packages/fv/src/app.pas svneol=native#text/plain
 packages/fv/src/asciitab.pas svneol=native#text/plain
 packages/fv/src/buildfv.pas svneol=native#text/plain
@@ -1739,6 +1733,8 @@ packages/fv/src/views.pas svneol=native#text/plain
 packages/fv/src/w32smsg.inc svneol=native#text/plain
 packages/gdbint/Makefile svneol=native#text/plain
 packages/gdbint/Makefile.fpc svneol=native#text/plain
+packages/gdbint/examples/symify.pp svneol=native#text/plain
+packages/gdbint/examples/testgdb.pp svneol=native#text/plain
 packages/gdbint/fpmake.pp svneol=native#text/plain
 packages/gdbint/src/freadlin.pp svneol=native#text/x-pascal
 packages/gdbint/src/gdbcon.pp svneol=native#text/plain
@@ -1746,8 +1742,6 @@ packages/gdbint/src/gdbint.pp svneol=native#text/plain
 packages/gdbint/src/gdbobjs.inc svneol=native#text/plain
 packages/gdbint/src/gdbver.pp svneol=native#text/plain
 packages/gdbint/src/gdbver_nogdb.inc svneol=native#text/x-pascal
-packages/gdbint/src/symify.pp svneol=native#text/plain
-packages/gdbint/src/testgdb.pp svneol=native#text/plain
 packages/gdbm/Makefile svneol=native#text/plain
 packages/gdbm/Makefile.fpc svneol=native#text/plain
 packages/gdbm/README svneol=native#text/plain
@@ -2178,6 +2172,7 @@ packages/gtk2/src/glib/grel.inc svneol=native#text/plain
 packages/gtk2/src/glib/gscanner.inc svneol=native#text/plain
 packages/gtk2/src/glib/gshell.inc svneol=native#text/plain
 packages/gtk2/src/glib/gsignal.inc svneol=native#text/plain
+packages/gtk2/src/glib/gslice.inc svneol=native#text/pascal
 packages/gtk2/src/glib/gslist.inc svneol=native#text/plain
 packages/gtk2/src/glib/gsourceclosure.inc svneol=native#text/plain
 packages/gtk2/src/glib/gspawn.inc svneol=native#text/plain
@@ -2731,7 +2726,6 @@ packages/iconvenc/examples/Makefile svneol=native#text/plain
 packages/iconvenc/examples/Makefile.fpc svneol=native#text/plain
 packages/iconvenc/examples/iconvtest.pp svneol=native#text/plain
 packages/iconvenc/fpmake.pp svneol=native#text/plain
-packages/iconvenc/manifest.xml svneol=native#text/plain
 packages/iconvenc/src/iconvenc.pas svneol=native#text/plain
 packages/imagemagick/Makefile svneol=native#text/plain
 packages/imagemagick/Makefile.fpc svneol=native#text/plain
@@ -4610,12 +4604,18 @@ packages/winceunits/src/buildwinceunits.pp svneol=native#text/plain
 packages/winceunits/src/cesync.pp svneol=native#text/plain
 packages/winceunits/src/commctrl.pp svneol=native#text/plain
 packages/winceunits/src/commdlg.pp svneol=native#text/plain
+packages/winceunits/src/connmgr.pp svneol=native#text/plain
 packages/winceunits/src/cpl.pp svneol=native#text/plain
+packages/winceunits/src/devload.pp svneol=native#text/plain
+packages/winceunits/src/devmgmt.pp svneol=native#text/plain
 packages/winceunits/src/gpsapi.pp svneol=native#text/plain
 packages/winceunits/src/gx.pp svneol=native#text/plain
 packages/winceunits/src/htmlctrl.pp svneol=native#text/plain
 packages/winceunits/src/iphlpapi.pp svneol=native#text/plain
 packages/winceunits/src/keybd.pp svneol=native#text/plain
+packages/winceunits/src/mmreg.pp svneol=native#text/plain
+packages/winceunits/src/mmsystem.pp svneol=native#text/plain
+packages/winceunits/src/msacm.pp svneol=native#text/plain
 packages/winceunits/src/msgqueue.pp svneol=native#text/plain
 packages/winceunits/src/nled.pp svneol=native#text/plain
 packages/winceunits/src/notify.pp svneol=native#text/plain
@@ -4625,6 +4625,8 @@ packages/winceunits/src/pimstore.pp svneol=native#text/plain
 packages/winceunits/src/pm.pp svneol=native#text/plain
 packages/winceunits/src/power.pp svneol=native#text/plain
 packages/winceunits/src/rapi.pp svneol=native#text/plain
+packages/winceunits/src/ras.pp svneol=native#text/plain
+packages/winceunits/src/raserror.pp svneol=native#text/plain
 packages/winceunits/src/ril.pp svneol=native#text/plain
 packages/winceunits/src/service.pp svneol=native#text/plain
 packages/winceunits/src/shellapi.pp svneol=native#text/plain
@@ -4635,6 +4637,7 @@ packages/winceunits/src/tapi.pp svneol=native#text/plain
 packages/winceunits/src/todaycmn.pp svneol=native#text/plain
 packages/winceunits/src/windbase.pp svneol=native#text/plain
 packages/winceunits/src/windbase_edb.inc svneol=native#text/plain
+packages/winceunits/src/wininet.pp svneol=native#text/plain
 packages/winceunits/src/winioctl.pp svneol=native#text/plain
 packages/winceunits/src/ws2bth.pp svneol=native#text/plain
 packages/winunits-base/Makefile svneol=native#text/plain
@@ -5108,6 +5111,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
@@ -6575,6 +6579,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
@@ -7128,6 +7133,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
@@ -7204,6 +7210,10 @@ tests/test/cg/obj/go32v2/i386/ctest.o -text
 tests/test/cg/obj/go32v2/i386/tcext3.o -text
 tests/test/cg/obj/go32v2/i386/tcext4.o -text
 tests/test/cg/obj/go32v2/i386/tcext5.o -text
+tests/test/cg/obj/linux/arm-eabi/ctest.o -text
+tests/test/cg/obj/linux/arm-eabi/tcext3.o -text
+tests/test/cg/obj/linux/arm-eabi/tcext4.o -text
+tests/test/cg/obj/linux/arm-eabi/tcext5.o -text
 tests/test/cg/obj/linux/arm/ctest.o -text
 tests/test/cg/obj/linux/arm/tcext3.o -text
 tests/test/cg/obj/linux/arm/tcext4.o -text
@@ -7589,6 +7599,7 @@ tests/test/packages/webtbs/tw11570.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw1808.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw3820.pp svneol=native#text/plain
 tests/test/packages/win-base/tdispvar1.pp svneol=native#text/plain
+tests/test/packages/zlib/tzlib1.pp svneol=native#text/plain
 tests/test/t4cc1.pp svneol=native#text/plain
 tests/test/t4cc2.pp svneol=native#text/plain
 tests/test/tabstrcl.pp svneol=native#text/plain
@@ -7739,6 +7750,10 @@ tests/test/tmath1.pp svneol=native#text/plain
 tests/test/tmcbool2.pp svneol=native#text/plain
 tests/test/tmmx1.pp svneol=native#text/plain
 tests/test/tmove.pp svneol=native#text/plain
+tests/test/tmsg1.pp svneol=native#text/plain
+tests/test/tmsg2.pp svneol=native#text/plain
+tests/test/tmsg3.pp svneol=native#text/plain
+tests/test/tmsg4.pp svneol=native#text/plain
 tests/test/tmt1.pp svneol=native#text/plain
 tests/test/tobject1.pp svneol=native#text/plain
 tests/test/tobject2.pp svneol=native#text/plain
@@ -7782,6 +7797,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
@@ -7881,6 +7897,10 @@ tests/test/tunroll1.pp svneol=native#text/plain
 tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/tvarset1.pp svneol=native#text/plain
+tests/test/tweaklib1.pp svneol=native#text/plain
+tests/test/tweaklib2.pp svneol=native#text/plain
+tests/test/tweaklib3.pp svneol=native#text/plain
+tests/test/tweaklib4.pp svneol=native#text/plain
 tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
 tests/test/twide3.pp svneol=native#text/plain
@@ -8114,7 +8134,13 @@ tests/webtbf/tw11846c.pp svneol=native#text/plain
 tests/webtbf/tw11848a.pp svneol=native#text/plain
 tests/webtbf/tw11849a.pp svneol=native#text/plain
 tests/webtbf/tw11862a.pp svneol=native#text/plain
+tests/webtbf/tw11970.pp svneol=native#text/plain
+tests/webtbf/tw12075.pp svneol=native#text/plain
 tests/webtbf/tw12329.pp svneol=native#text/plain
+tests/webtbf/tw12365a.cfg svneol=native#text/plain
+tests/webtbf/tw12365a.pp svneol=native#text/plain
+tests/webtbf/tw12365b.cfg svneol=native#text/plain
+tests/webtbf/tw12365b.pp svneol=native#text/plain
 tests/webtbf/tw1238.pp svneol=native#text/plain
 tests/webtbf/tw1251a.pp svneol=native#text/plain
 tests/webtbf/tw1270.pp svneol=native#text/plain
@@ -8551,8 +8577,11 @@ tests/webtbs/tw11568.pp svneol=native#text/plain
 tests/webtbs/tw1157.pp svneol=native#text/plain
 tests/webtbs/tw1157b.pp svneol=native#text/plain
 tests/webtbs/tw11619.pp svneol=native#text/plain
+tests/webtbs/tw11638.pp svneol=native#text/plain
+tests/webtbs/tw11711.pp svneol=native#text/plain
 tests/webtbs/tw11762.pp svneol=native#text/plain
 tests/webtbs/tw11763.pp svneol=native#text/plain
+tests/webtbs/tw11786.pp svneol=native#text/plain
 tests/webtbs/tw1181.pp svneol=native#text/plain
 tests/webtbs/tw11846a.pp svneol=native#text/plain
 tests/webtbs/tw11846b.pp svneol=native#text/plain
@@ -8571,6 +8600,7 @@ tests/webtbs/tw12050a.pp svneol=native#text/plain
 tests/webtbs/tw12050b.pp svneol=native#text/plain
 tests/webtbs/tw12051.pp svneol=native#text/plain
 tests/webtbs/tw1207.pp svneol=native#text/plain
+tests/webtbs/tw12076.pp svneol=native#text/plain
 tests/webtbs/tw12186.pp svneol=native#text/plain
 tests/webtbs/tw12202.pp svneol=native#text/plain
 tests/webtbs/tw12214.pp svneol=native#text/plain
@@ -8578,12 +8608,22 @@ tests/webtbs/tw1222.pp svneol=native#text/plain
 tests/webtbs/tw12224.pp svneol=native#text/plain
 tests/webtbs/tw1223.pp svneol=native#text/plain
 tests/webtbs/tw12233.pp svneol=native#text/plain
+tests/webtbs/tw12237.pp svneol=native#text/plain
 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
 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

.gitignore

@@ -222,20 +222,6 @@ packages/fcl-base/examples/intl/*.s
 packages/fcl-base/examples/intl/fpcmade.*
 packages/fcl-base/examples/intl/units
 packages/fcl-base/examples/units
-packages/fcl-base/src/amiga/*.bak
-packages/fcl-base/src/amiga/*.exe
-packages/fcl-base/src/amiga/*.o
-packages/fcl-base/src/amiga/*.ppu
-packages/fcl-base/src/amiga/*.s
-packages/fcl-base/src/amiga/fpcmade.*
-packages/fcl-base/src/amiga/units
-packages/fcl-base/src/beos/*.bak
-packages/fcl-base/src/beos/*.exe
-packages/fcl-base/src/beos/*.o
-packages/fcl-base/src/beos/*.ppu
-packages/fcl-base/src/beos/*.s
-packages/fcl-base/src/beos/fpcmade.*
-packages/fcl-base/src/beos/units
 packages/fcl-base/src/go32v2/*.bak
 packages/fcl-base/src/go32v2/*.exe
 packages/fcl-base/src/go32v2/*.o

Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/09/27]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22]
 #
 default: help
 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

compiler/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/09/27]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22]
 #
 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
@@ -263,7 +263,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=compiler
-override PACKAGE_VERSION=2.0.0
+override PACKAGE_VERSION=2.2.2
 unexport FPC_VERSION FPC_COMPILERINFO
 CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb
 ALLTARGETS=$(CYCLETARGETS)

compiler/Makefile.fpc

@@ -4,7 +4,7 @@
 
 [package]
 name=compiler
-version=2.0.0
+version=2.2.2
 
 [target]
 programs=pp

compiler/aasmbase.pas

@@ -37,7 +37,7 @@ interface
        ;
 
     type
-       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
+       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL);
 
        TAsmsymtype=(
          AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,

compiler/aasmdata.pas

@@ -145,6 +145,7 @@ interface
         destructor  destroy;override;
         { asmsymbol }
         function  DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
+        function  WeakRefAsmSymbol(const s : string) : TAsmSymbol;
         function  RefAsmSymbol(const s : string) : TAsmSymbol;
         function  GetAsmSymbol(const s : string) : TAsmSymbol;
         { create new assembler label }
@@ -373,7 +374,18 @@ implementation
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE);
+          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE)
+        { one normal reference removes the "weak" character of a symbol }
+        else if (result.bind=AB_WEAK_EXTERNAL) then
+          result.bind:=AB_EXTERNAL;
+      end;
+
+
+    function TAsmData.WeakRefAsmSymbol(const s : string) : TAsmSymbol;
+      begin
+        result:=TAsmSymbol(FAsmSymbolDict.Find(s));
+        if not assigned(result) then
+          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,AT_NONE);
       end;
 
 

compiler/aasmtai.pas

@@ -254,7 +254,7 @@ interface
       TAsmDirective=(
         asd_non_lazy_symbol_pointer,asd_indirect_symbol,asd_lazy_symbol_pointer,
         asd_extern,asd_nasm_import, asd_toc_entry, asd_mod_init_func, asd_mod_term_func,
-        asd_reference,asd_no_dead_strip
+        asd_reference,asd_no_dead_strip,asd_weak_reference
       );
 
     const
@@ -264,7 +264,7 @@ interface
       directivestr : array[TAsmDirective] of string[23]=(
         'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer',
         'extern','nasm_import', 'tc', 'mod_init_func', 'mod_term_func', 'reference',
-        'no_dead_strip'
+        'no_dead_strip','weak_reference'
       );
 
     type

compiler/aggas.pas

@@ -40,12 +40,16 @@ interface
       {# This is a derived class which is used to write
          GAS styled assembler.
       }
+
+      { TGNUAssembler }
+
       TGNUAssembler=class(texternalassembler)
       protected
         function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
         procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
         procedure WriteExtraHeader;virtual;
         procedure WriteInstruction(hp: tai);
+        procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
        public
         function MakeCmdLine: TCmdStr; override;
         procedure WriteTree(p:TAsmList);override;
@@ -75,8 +79,12 @@ interface
       end;
 
 
+      { TAppleGNUAssembler }
+
       TAppleGNUAssembler=class(TGNUAssembler)
+       protected
         function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
+        procedure WriteWeakSymbolDef(s: tasmsymbol); override;
        private
         debugframecount: aint;
        end;
@@ -1082,10 +1090,17 @@ implementation
       end;
 
 
+    procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
+      begin
+        AsmWriteLn(#9'.weak '+s.name);
+      end;
+
+
     procedure TGNUAssembler.WriteAsmList;
     var
       n : string;
       hal : tasmlisttype;
+      i: longint;
     begin
 {$ifdef EXTDEBUG}
       if assigned(current_module.mainsource) then
@@ -1096,7 +1111,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;
@@ -1108,6 +1129,11 @@ implementation
           AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
         end;
 
+      { add weak symbol markers }
+      for i:=0 to current_asmdata.asmsymboldict.count-1 do
+        if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
+          writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
+
       if create_smartlink_sections and
          (target_info.system in systems_darwin) then
         AsmWriteLn(#9'.subsections_via_symbols');
@@ -1184,6 +1210,12 @@ implementation
       end;
 
 
+    procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
+      begin
+        AsmWriteLn(#9'.weak_reference '+s.name);
+      end;
+
+
 {****************************************************************************}
 {                       a.out/GNU Assembler writer                           }
 {****************************************************************************}

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/arm/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;
 
@@ -112,7 +112,7 @@ unit cgcpu;
         { clear out potential overflow bits from 8 or 16 bit operations  }
         { the upper 24/16 bits of a register after an operation          }
         procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
-        function get_darwin_call_stub(const s: string): tasmsymbol;
+        function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
       end;
 
       tcg64farm = class(tcg64f32)
@@ -286,12 +286,15 @@ unit cgcpu;
       end;
 
 
-    procedure tcgarm.a_call_name(list : TAsmList;const s : string);
+    procedure tcgarm.a_call_name(list : TAsmList;const s : string; weak: boolean);
       begin
         if target_info.system<>system_arm_darwin then
-          list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)))
+          if not weak then
+            list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)))
+          else
+            list.concat(taicpu.op_sym(A_BL,current_asmdata.WeakRefAsmSymbol(s)))
         else
-          list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s)));
+          list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
 {
         the compiler does not properly set this flag anymore in pass 1, and
         for now we only need it after pass 2 (I hope) (JM)
@@ -1669,7 +1672,7 @@ unit cgcpu;
         paramanager.freeparaloc(list,paraloc1);
         alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
-        a_call_name(list,'FPC_MOVE');
+        a_call_name(list,'FPC_MOVE',false);
         dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         paraloc3.done;
@@ -1943,7 +1946,7 @@ unit cgcpu;
             internalerror(200409281);
         end;
 
-        a_call_name(list,'FPC_OVERFLOW');
+        a_call_name(list,'FPC_OVERFLOW',false);
         a_label(list,hl);
       end;
 
@@ -2110,7 +2113,7 @@ unit cgcpu;
       end;
 
 
-    function tcgarm.get_darwin_call_stub(const s: string): tasmsymbol;
+    function tcgarm.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
       var
         stubname: string;
         l1: tasmsymbol;
@@ -2128,6 +2131,9 @@ unit cgcpu;
         current_asmdata.asmlists[al_imports].concat(Tai_align.Create(4));
         result := current_asmdata.RefAsmSymbol(stubname);
         current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
+        { register as a weak symbol if necessary }
+        if weak then
+          current_asmdata.weakrefasmsymbol(s);
         current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
         
         if not(cs_create_pic in current_settings.moduleswitches) then

compiler/arm/cpupara.pas

@@ -332,7 +332,9 @@ unit cpupara;
                         { align registers for eabi }
                         if (target_info.abi=abi_eabi) and
                           (paracgsize in [OS_F64,OS_64,OS_S64]) and
-                          (nextintreg in [RS_R1,RS_R3]) then
+                          (nextintreg in [RS_R1,RS_R3]) and
+                          { first location? }
+                          (paralen=8) then
                           inc(nextintreg);
                         { this is not abi compliant
                           why? (FK) }
@@ -386,7 +388,9 @@ unit cpupara;
                         { align stack for eabi }
                         if (target_info.abi=abi_eabi) and
                           (paracgsize in [OS_F64,OS_64,OS_S64]) and
-                          (stack_offset mod 8<>0) then
+                          (stack_offset mod 8<>0) and
+                          { first location? }
+                          (paralen=8) then
                           inc(stack_offset,8-(stack_offset mod 8));
 
                         paraloc^.size:=OS_ADDR;

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/cg64f32.pas

@@ -742,7 +742,7 @@ unit cg64f32;
                  cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);
                end;
              { For all other values we have a range check error }
-             cg.a_call_name(list,'FPC_RANGEERROR');
+             cg.a_call_name(list,'FPC_RANGEERROR',false);
 
              { if the high dword = 0, the low dword can be considered a }
              { simple cardinal                                          }
@@ -779,7 +779,7 @@ unit cg64f32;
                  current_asmdata.getjumplabel(neglabel);
                  cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
 
-                 cg.a_call_name(list,'FPC_RANGEERROR');
+                 cg.a_call_name(list,'FPC_RANGEERROR',false);
 
                  { if we get here, the 64bit value lies between }
                  { longint($80000000) and -1 (JM)               }
@@ -830,7 +830,7 @@ unit cg64f32;
                current_asmdata.getjumplabel(poslabel);
                cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
 
-               cg.a_call_name(list,'FPC_RANGEERROR');
+               cg.a_call_name(list,'FPC_RANGEERROR',false);
                cg.a_label(list,poslabel);
              end;
       end;

compiler/cgobj.pas

@@ -196,7 +196,7 @@ unit cgobj;
              a temp register on most cpu's resulting in conflicts with the
              registers used for the parameters (PFV)
           }
-          procedure a_call_name(list : TAsmList;const s : string);virtual; abstract;
+          procedure a_call_name(list : TAsmList;const s : string; weak: boolean);virtual; abstract;
           procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract;
           procedure a_call_ref(list : TAsmList;ref : treference);virtual; abstract;
           { same as a_call_name, might be overriden on certain architectures to emit
@@ -476,7 +476,7 @@ unit cgobj;
           procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
           procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);virtual;
 
-          function g_indirect_sym_load(list:TAsmList;const symname: string): tregister;virtual;
+          function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;virtual;
           { generate a stub which only purpose is to pass control the given external method,
           setting up any additional environment before doing so (if required).
 
@@ -2534,7 +2534,7 @@ implementation
             LOC_REGISTER,LOC_CREGISTER:
               begin
                 { paramfpu_ref does the check_simpe_location check here if necessary }
-                tg.GetTemp(list,TCGSize2Size[size],tt_normal,ref);
+                tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,ref);
                 a_loadfpu_reg_ref(list,size,size,r,ref);
                 a_paramfpu_ref(list,size,ref,cgpara);
                 tg.Ungettemp(list,ref);
@@ -3072,7 +3072,7 @@ implementation
         paramanager.freeparaloc(list,cgpara2);
         paramanager.freeparaloc(list,cgpara1);
         allocallcpuregisters(list);
-        a_call_name(list,'FPC_SHORTSTR_ASSIGN');
+        a_call_name(list,'FPC_SHORTSTR_ASSIGN',false);
         deallocallcpuregisters(list);
         cgpara3.done;
         cgpara2.done;
@@ -3094,7 +3094,7 @@ implementation
         paramanager.freeparaloc(list,cgpara2);
         paramanager.freeparaloc(list,cgpara1);
         allocallcpuregisters(list);
-        a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE');
+        a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE',false);
         deallocallcpuregisters(list);
         cgpara2.done;
         cgpara1.done;
@@ -3136,7 +3136,7 @@ implementation
               a_param_ref(list,OS_ADDR,ref,cgpara1);
             paramanager.freeparaloc(list,cgpara1);
             allocallcpuregisters(list);
-            a_call_name(list,incrfunc);
+            a_call_name(list,incrfunc,false);
             deallocallcpuregisters(list);
           end
          else
@@ -3149,7 +3149,7 @@ implementation
             paramanager.freeparaloc(list,cgpara1);
             paramanager.freeparaloc(list,cgpara2);
             allocallcpuregisters(list);
-            a_call_name(list,'FPC_ADDREF');
+            a_call_name(list,'FPC_ADDREF',false);
             deallocallcpuregisters(list);
           end;
          cgpara2.done;
@@ -3206,7 +3206,7 @@ implementation
             a_param_reg(list,OS_ADDR,tempreg1,cgpara1);
             paramanager.freeparaloc(list,cgpara1);
             allocallcpuregisters(list);
-            a_call_name(list,decrfunc);
+            a_call_name(list,decrfunc,false);
             deallocallcpuregisters(list);
           end
          else
@@ -3219,7 +3219,7 @@ implementation
             paramanager.freeparaloc(list,cgpara1);
             paramanager.freeparaloc(list,cgpara2);
             allocallcpuregisters(list);
-            a_call_name(list,'FPC_DECREF');
+            a_call_name(list,'FPC_DECREF',false);
             deallocallcpuregisters(list);
          end;
         cgpara2.done;
@@ -3252,7 +3252,7 @@ implementation
               paramanager.freeparaloc(list,cgpara1);
               paramanager.freeparaloc(list,cgpara2);
               allocallcpuregisters(list);
-              a_call_name(list,'FPC_INITIALIZE');
+              a_call_name(list,'FPC_INITIALIZE',false);
               deallocallcpuregisters(list);
            end;
         cgpara1.done;
@@ -3287,7 +3287,7 @@ implementation
               paramanager.freeparaloc(list,cgpara1);
               paramanager.freeparaloc(list,cgpara2);
               allocallcpuregisters(list);
-              a_call_name(list,'FPC_FINALIZE');
+              a_call_name(list,'FPC_FINALIZE',false);
               deallocallcpuregisters(list);
            end;
         cgpara1.done;
@@ -3432,7 +3432,7 @@ implementation
                     { if low(to) > maxlongint also range error }
                     (lto > aintmax) then
                    begin
-                     a_call_name(list,'FPC_RANGEERROR');
+                     a_call_name(list,'FPC_RANGEERROR',false);
                      exit
                    end;
                  { from is signed and to is unsigned -> when looking at to }
@@ -3447,7 +3447,7 @@ implementation
                  if (lfrom > aintmax) or
                     (hto < 0) then
                    begin
-                     a_call_name(list,'FPC_RANGEERROR');
+                     a_call_name(list,'FPC_RANGEERROR',false);
                      exit
                    end;
                  { from is unsigned and to is signed -> when looking at to }
@@ -3472,7 +3472,7 @@ implementation
         else
 {$endif cpu64bitalu}
           a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(int64(hto-lto)),hreg,neglabel);
-        a_call_name(list,'FPC_RANGEERROR');
+        a_call_name(list,'FPC_RANGEERROR',false);
         a_label(list,neglabel);
       end;
 
@@ -3509,7 +3509,7 @@ implementation
            paramanager.allocparaloc(list,cgpara1);
            a_param_const(list,OS_INT,210,cgpara1);
            paramanager.freeparaloc(list,cgpara1);
-           a_call_name(list,'FPC_HANDLEERROR');
+           a_call_name(list,'FPC_HANDLEERROR',false);
            a_label(list,oklabel);
            cgpara1.done;
          end;
@@ -3535,7 +3535,7 @@ implementation
            paramanager.freeparaloc(list,cgpara1);
            paramanager.freeparaloc(list,cgpara2);
            allocallcpuregisters(list);
-           a_call_name(list,'FPC_CHECK_OBJECT_EXT');
+           a_call_name(list,'FPC_CHECK_OBJECT_EXT',false);
            deallocallcpuregisters(list);
          end
         else
@@ -3545,7 +3545,7 @@ implementation
             a_param_reg(list,OS_ADDR,reg,cgpara1);
             paramanager.freeparaloc(list,cgpara1);
             allocallcpuregisters(list);
-            a_call_name(list,'FPC_CHECK_OBJECT');
+            a_call_name(list,'FPC_CHECK_OBJECT',false);
             deallocallcpuregisters(list);
           end;
         cgpara1.done;
@@ -3591,7 +3591,7 @@ implementation
         a_param_reg(list,OS_INT,sizereg,cgpara1);
         paramanager.freeparaloc(list,cgpara1);
         allocallcpuregisters(list);
-        a_call_name(list,'FPC_GETMEM');
+        a_call_name(list,'FPC_GETMEM',false);
         deallocallcpuregisters(list);
         cgpara1.done;
         { return the new address }
@@ -3617,7 +3617,7 @@ implementation
         paramanager.freeparaloc(list,cgpara2);
         paramanager.freeparaloc(list,cgpara1);
         allocallcpuregisters(list);
-        a_call_name(list,'FPC_MOVE');
+        a_call_name(list,'FPC_MOVE',false);
         deallocallcpuregisters(list);
         cgpara3.done;
         cgpara2.done;
@@ -3637,7 +3637,7 @@ implementation
         a_param_loc(list,l,cgpara1);
         paramanager.freeparaloc(list,cgpara1);
         allocallcpuregisters(list);
-        a_call_name(list,'FPC_FREEMEM');
+        a_call_name(list,'FPC_FREEMEM',false);
         deallocallcpuregisters(list);
         cgpara1.done;
       end;
@@ -3670,7 +3670,7 @@ implementation
 
         if size>0 then
           begin
-            tg.GetTemp(list,size,tt_noreuse,current_procinfo.save_regs_ref);
+            tg.GetTemp(list,size,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
             include(current_procinfo.flags,pi_has_saved_regs);
 
             { Copy registers to temp }
@@ -3813,11 +3813,11 @@ implementation
 
     procedure tcg.a_call_name_static(list : TAsmList;const s : string);
       begin
-        a_call_name(list,s);
+        a_call_name(list,s,false);
       end;
 
 
-   function tcg.g_indirect_sym_load(list:TAsmList;const symname: string): tregister;
+   function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;
       var
         l: tasmsymbol;
         ref: treference;
@@ -3834,7 +3834,10 @@ implementation
                 begin
                   l:=current_asmdata.DefineAsmSymbol('L'+symname+'$non_lazy_ptr',AB_LOCAL,AT_DATA);
                   current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0));
-                  current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.RefAsmSymbol(symname)));
+                  if not(weak) then
+                    current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.RefAsmSymbol(symname)))
+                  else
+                    current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.WeakRefAsmSymbol(symname)));
 {$ifdef cpu64bitaddr}
                   current_asmdata.asmlists[al_picdata].concat(tai_const.create_64bit(0));
 {$else cpu64bitaddr}

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/cmsgs.pas

@@ -52,6 +52,7 @@ type
     procedure ClearIdx;
     procedure CreateIdx;
     function  GetPChar(nr:longint):pchar;
+    function  ClearVerbosity(nr:longint):boolean;
     function  Get(nr:longint;const args:array of string):ansistring;
   end;
 
@@ -374,6 +375,33 @@ begin
   GetPChar:=msgidx[nr div 1000]^[nr mod 1000];
 end;
 
+function TMessage.ClearVerbosity(nr:longint):boolean;
+var
+  hp: pchar;
+  i, txtbegin: longint;
+begin
+   result:=false;
+  if ((nr div 1000) < low(msgidx)) or
+     ((nr div 1000) > msgparts) then
+    exit;
+  hp := GetPChar(nr);
+  if (hp=nil) then
+    exit;
+  txtbegin:=-1;
+  for i:=0 to 4 do
+    begin
+      if hp[i]=#0 then
+        exit;
+      if hp[i]='_' then
+        begin
+          txtbegin:=i;
+          break;
+        end;
+    end;
+  for i:=0 to txtbegin-1 do
+    hp[i]:='_';
+  result:=true;
+end;
 
 function TMessage.Get(nr:longint;const args:array of string):ansistring;
 var

compiler/comphook.pas

@@ -90,6 +90,7 @@ type
     ispackage,
     islibrary     : boolean;
   { Settings for the output }
+    showmsgnrs    : boolean;
     verbosity     : longint;
     maxerrorcount : longint;
     errorwarning,
@@ -337,7 +338,8 @@ begin
     end;
 
   { Display line }
-  if ((status.verbosity and (Level and V_LevelMask))=(Level and V_LevelMask)) then
+  if (Level<>V_None) and
+     ((status.verbosity and (Level and V_LevelMask))=(Level and V_LevelMask)) then
    begin
      if status.use_stderr then
       begin
@@ -375,7 +377,8 @@ end;
 function def_CheckVerbosity(v:longint):boolean;
 begin
   result:=status.use_bugreport or
-          ((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask));
+          ((v<>V_None) and
+           ((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask)));
 end;
 
 procedure def_initsymbolinfo;

compiler/dbgbase.pas

@@ -430,7 +430,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
@@ -1974,7 +1975,7 @@ implementation
               current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(int64(sym.value.valueordptr)));
 {$else cpu64bitaddr}
               current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(ord(DW_FORM_data4)));
-              current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(sym.value.valueordptr));
+              current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(longint(sym.value.valueordptr)));
 {$endif cpu64bitaddr}
             end;
           constreal:

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

@@ -127,6 +127,7 @@ interface
         derefmapsize  : longint;  { number of units in the map }
         derefdataintflen : longint;
         derefdata     : tdynamicarray;
+        checkforwarddefs,
         deflist,
         symlist       : TFPObjectList;
         wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
@@ -219,7 +220,7 @@ implementation
       SysUtils,globals,
       verbose,systems,
       scanner,ppu,dbgbase,
-      procinfo;
+      procinfo,symdef;
 
 {$ifdef MEMDEBUG}
     var
@@ -491,6 +492,7 @@ implementation
         deflist:=TFPObjectList.Create(false);
         symlist:=TFPObjectList.Create(false);
         wpoinfo:=nil;
+        checkforwarddefs:=TFPObjectList.Create(false);
         globalsymtable:=nil;
         localsymtable:=nil;
         globalmacrosymtable:=nil;
@@ -552,7 +554,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
@@ -598,6 +603,7 @@ implementation
         deflist.free;
         symlist.free;
         wpoinfo.free;
+        checkforwarddefs.free;
         globalsymtable.free;
         localsymtable.free;
         globalmacrosymtable.free;
@@ -627,7 +633,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
@@ -658,6 +667,8 @@ implementation
         symlist:=TFPObjectList.Create(false);
         wpoinfo.free;
         wpoinfo:=nil;
+        checkforwarddefs.free;
+        checkforwarddefs:=TFPObjectList.Create(false);
         derefdata.free;
         derefdata:=TDynamicArray.Create(1024);
         if assigned(unitmap) then

compiler/fpcdefs.inc

@@ -108,6 +108,10 @@
   {$define cpufpemu}
   {$define cpuneedsdiv32helper}
   {$define cputargethasfixedstack}
+  { inherit FPC_ARMEL? }
+  {$if defined(CPUARMEL) and not(defined(FPC_OARM))}
+    {$define FPC_ARMEL}
+  {$endif}
 {$endif arm}
 
 {$ifdef m68k}

compiler/globals.pas

@@ -165,6 +165,15 @@ interface
         property items[I:longint]:TLinkRec read getlinkrec; default;
       end;
 
+      tpendingstate = record
+        nextverbositystr : string;
+        nextlocalswitches : tlocalswitches;
+        nextverbosityfullswitch: longint;
+        verbosityfullswitched,
+        localswitcheschanged : boolean;
+      end;
+
+
     var
        { specified inputfile }
        inputfilepath     : string;
@@ -259,13 +268,12 @@ interface
        init_settings,
        current_settings   : tsettings;
 
-       nextlocalswitches : tlocalswitches;
-       localswitcheschanged : boolean;
-
+       pendingstate       : tpendingstate;
      { Memory sizes }
        heapsize,
        stacksize,
-       jmp_buf_size : longint;
+       jmp_buf_size,
+       jmp_buf_align : longint;
 
 {$Ifdef EXTDEBUG}
      { parameter switches }

compiler/globtype.pas

@@ -278,7 +278,7 @@ interface
 
        { currently parsed block type }
        tblock_type = (bt_none,
-         bt_general,bt_type,bt_const,bt_except,bt_body,bt_specialize
+         bt_general,bt_type,bt_const,bt_const_type,bt_var,bt_var_type,bt_except,bt_body
        );
 
        { Temp types }

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/i386/cgcpu.pas

@@ -653,7 +653,7 @@ unit cgcpu;
             else
               begin
                 { case 1 }
-                cg.a_call_name(list,procdef.mangledname);
+                cg.a_call_name(list,procdef.mangledname,false);
               end;
             { restore param1 value self to interface }
             g_adjust_self_value(list,procdef,-ioffset);
@@ -693,7 +693,7 @@ unit cgcpu;
                 list.concat(taicpu.op_sym(A_JMP,S_NO,lab))
               end
             else
-              list.concat(taicpu.op_sym(A_JMP,S_NO,get_darwin_call_stub(procdef.mangledname)))
+              list.concat(taicpu.op_sym(A_JMP,S_NO,get_darwin_call_stub(procdef.mangledname,false)))
           end;
 
         List.concat(Tai_symbol_end.Createname(labelname));

compiler/i386/i386nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-1379;
+1380;

compiler/i386/i386tab.inc

@@ -2936,10 +2936,17 @@
   (
     opcode  : A_MOV;
     ops     : 2;
-    optypes : (ot_reg_ax or ot_bits32,ot_mem_offs,ot_none);
-    code    : #213#193#1#161#29;
+    optypes : (ot_reg_ax,ot_mem_offs,ot_none);
+    code    : #212#193#1#161#29;
     flags   : if_8086 or if_sm or if_nox86_64
   ),
+  (
+    opcode  : A_MOV;
+    ops     : 2;
+    optypes : (ot_reg_eax,ot_mem_offs,ot_none);
+    code    : #213#193#1#161#29;
+    flags   : if_386 or if_sm or if_nox86_64
+  ),
   (
     opcode  : A_MOV;
     ops     : 2;
@@ -6346,7 +6353,7 @@
     opcode  : A_TEST;
     ops     : 2;
     optypes : (ot_regmem or ot_bits8,ot_reg8,ot_none);
-    code    : #193#211#1#132#72;
+    code    : #193#211#1#132#65;
     flags   : if_8086 or if_sm
   ),
   (

compiler/i386/n386add.pas

@@ -30,9 +30,11 @@ interface
 
     type
        ti386addnode = class(tx86addnode)
+         function use_generic_mul32to64: boolean; override;
+         procedure second_addordinal; override;
          procedure second_add64bit;override;
          procedure second_cmp64bit;override;
-         procedure second_mul;override;
+         procedure second_mul(unsigned: boolean);
        end;
 
   implementation
@@ -46,6 +48,29 @@ interface
       ncon,nset,cgutils,tgobj,
       cga,ncgutil,cgobj,cg64f32,cgx86;
 
+{*****************************************************************************
+                                use_generic_mul32to64
+*****************************************************************************}
+
+    function ti386addnode.use_generic_mul32to64: boolean;
+    begin
+      result := False;
+    end;
+
+    { handles all unsigned multiplications, and 32->64 bit signed ones.
+      32bit-only signed mul is handled by generic codegen }
+    procedure ti386addnode.second_addordinal;
+    var
+      unsigned: boolean;
+    begin
+      unsigned:=not(is_signed(left.resultdef)) or
+                not(is_signed(right.resultdef));
+      if (nodetype=muln) and (unsigned or is_64bit(resultdef)) then
+        second_mul(unsigned)
+      else
+        inherited second_addordinal;
+    end;
+
 {*****************************************************************************
                                 Add64bit
 *****************************************************************************}
@@ -173,7 +198,7 @@ interface
                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4)
               else
                 cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
               cg.a_label(current_asmdata.CurrAsmList,hl4);
             end;
          end;
@@ -343,20 +368,24 @@ interface
                                 x86 MUL
 *****************************************************************************}
 
-    procedure ti386addnode.second_mul;
+    procedure ti386addnode.second_mul(unsigned: boolean);
 
     var reg:Tregister;
         ref:Treference;
         use_ref:boolean;
         hl4 : tasmlabel;
 
+    const
+      asmops: array[boolean] of tasmop = (A_IMUL, A_MUL);
+
     begin
       pass_left_right;
 
       {The location.register will be filled in later (JM)}
       location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
       { Mul supports registers and references, so if not register/reference,
-        load the location into a register}
+        load the location into a register.
+        The variant of IMUL which is capable of doing 32->64 bits has the same restrictions. }
       use_ref:=false;
       if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
         reg:=left.location.register
@@ -379,22 +408,36 @@ interface
       {Also allocate EDX, since it is also modified by a mul (JM).}
       cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
       if use_ref then
-        emit_ref(A_MUL,S_L,ref)
+        emit_ref(asmops[unsigned],S_L,ref)
       else
-        emit_reg(A_MUL,S_L,reg);
-      if cs_check_overflow in current_settings.localswitches  then
-       begin
-         current_asmdata.getjumplabel(hl4);
-         cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
-         cg.a_label(current_asmdata.CurrAsmList,hl4);
-       end;
+        emit_reg(asmops[unsigned],S_L,reg);
+      if (cs_check_overflow in current_settings.localswitches) and
+        { 32->64 bit cannot overflow }
+        (not is_64bit(resultdef)) then
+        begin
+          current_asmdata.getjumplabel(hl4);
+          cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4);
+          cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
+          cg.a_label(current_asmdata.CurrAsmList,hl4);
+        end;
       {Free EAX,EDX}
       cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-      cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
-      {Allocate a new register and store the result in EAX in it.}
-      location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-      cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EAX,location.register);
+      if is_64bit(resultdef) then
+      begin
+        {Allocate a couple of registers and store EDX:EAX into it}
+        location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+        cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, NR_EDX, location.register64.reghi);
+        cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+        location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+        cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, NR_EAX, location.register64.reglo);
+      end
+      else
+      begin
+        {Allocate a new register and store the result in EAX in it.}
+        location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+        cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EAX,location.register);
+      end;
       location_freetemp(current_asmdata.CurrAsmList,left.location);
       location_freetemp(current_asmdata.CurrAsmList,right.location);
     end;

compiler/msg/errore.msg

@@ -39,6 +39,7 @@
 #   c_   conditional
 #   d_   debug message
 #   x_   executable informations
+#   o_   normal (e.g., "press enter to continue")
 #
 
 #
@@ -365,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
 #
 # Parser
 #
-# 03247 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
@@ -1164,7 +1165,17 @@ parser_e_cant_export_var_different_name=03247_E_Variables cannot be exported wit
 % is exported inside the \var{exports} statement of a library.
 % In that case, you have to specify the export name at the point where the
 % variable is declared, using the \var{export} and \var{alias} directives.
-
+parser_e_weak_external_not_supported=03248_E_Weak external symbols are not supported for the current target
+% A "weak external" symbol is a symbol which may or may not exist at (either static
+% or dynamic) link time. This concept may not be available (or implemented yet)
+% on the current cpu/OS target.
+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
@@ -1318,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,
@@ -1628,7 +1639,6 @@ sym_w_experimental_symbol=05063_W_Symbol "$1" is experimental
 sym_w_forward_not_resolved=05064_W_Forward declaration "$1" not resolved, assumed external
 % This happens if you declare a function in the \var{interface} of a unit in macpas mode,
 % but do not implement it.
-% \end{itemize}
 % \end{description}
 #
 # Codegenerator
@@ -2419,13 +2429,13 @@ option_target_is_already_set=11011_W_Target is already set to: $1
 option_no_shared_lib_under_dos=11012_W_Shared libs not supported on DOS platform, reverting to static
 % If you specify \var{-CD} for the \dos platform, this message is displayed.
 % The compiler supports only static libraries under \dos.
-option_too_many_ifdef=11013_F_too many IF(N)DEFs
+option_too_many_ifdef=11013_F_In options file $1 at line $2 too many \var{\#IF(N)DEFs} encountered
 % The \var{\#IF(N)DEF} statements in the options file are not balanced with
 % the \var{\#ENDIF} statements.
-option_too_many_endif=11014_F_too many ENDIFs
+option_too_many_endif=11014_F_In options file $1 at line $2 unexpected \var{\#ENDIFs} encountered
 % The \var{\#IF(N)DEF} statements in the options file are not balanced with
 % the \var{\#ENDIF} statements.
-option_too_less_endif=11015_F_open conditional at the end of the file
+option_too_less_endif=11015_F_Open conditional at the end of the options file
 % The \var{\#IF(N)DEF} statements in the options file are not balanced with
 % the \var{\#ENDIF} statements.
 option_no_debug_support=11016_W_Debug information generation is not supported by this executable
@@ -2459,7 +2469,7 @@ option_using_env=11027_T_Reading options from environment $1
 % Options are also read from this environment string.
 option_handling_option=11028_D_Handling option "$1"
 % Debug info that an option is found and will be handled.
-option_help_press_enter=11029__*** press enter ***
+option_help_press_enter=11029_O_*** press enter ***
 % Message shown when help is shown page per page. When pressing the ENTER
 % Key, the next page of help is shown. If you press q and then ENTER, the
 % compiler exits.
@@ -2491,6 +2501,8 @@ option_confict_asm_debug=11041_W_Assembler output selected "$1" cannot generate
 option_ppc386_deprecated=11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead
 % Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform
 % system the naming makes no sense anymore. Please continue to use fpc.cfg instead.
+option_else_without_if=11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \var{\#IF(N)DEF} found
+% An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement.
 %\end{description}
 # EndOfTeX
 
@@ -2836,7 +2848,8 @@ S*2Tlinux_Linux
 **2*_a : Show everything             x : Executable info (Win32 only)
 **2*_b : Write file names messages with full path
 **2*_v : Write fpcdebug.txt with     p : Write tree.log with parse tree
-**2*_    lots of debugging info
+**2*_    lots of debugging info      q : Show message numbers
+**2*_m<x>,<y> : Don't show messages numbered <x> and <y>
 3*1W<x>_Target-specific options (targets)
 A*1W<x>_Target-specific options (targets)
 P*1W<x>_Target-specific options (targets)

compiler/nadd.pas

@@ -774,11 +774,10 @@ implementation
            end;
 
 
-         { Kylix allows enum+ordconstn in an enum declaration (blocktype
-           is bt_type), we need to do the conversion here before the
-           constant folding }
+         { Kylix allows enum+ordconstn in an enum type declaration, we need to do
+           the conversion here before the constant folding }
          if (m_delphi in current_settings.modeswitches) and
-            (blocktype=bt_type) then
+            (blocktype in [bt_type,bt_const_type,bt_var_type]) then
           begin
             if (left.resultdef.typ=enumdef) and
                (right.resultdef.typ=orddef) then
@@ -1124,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

@@ -1810,6 +1810,15 @@ implementation
             exit;
           end;
 
+        { if the result is the same as the self parameter (in case of objects),
+          we can't optimise. We have to check this explicitly becaise
+          hidden parameters such as self have not yet been inserted at this
+          point
+        }
+        if assigned(methodpointer) and
+           realassignmenttarget.isequal(methodpointer.actualtargetnode) then
+          exit;
+
         { when we substitute a function result inside an inlined function,
           we may take the address of this function result. Therefore the
           substituted function result may not be in a register, as we cannot
@@ -2220,6 +2229,7 @@ implementation
         paraidx,
         cand_cnt : integer;
         i : longint;
+        ignorevisibility,
         is_const : boolean;
         statements : tstatementnode;
         converted_result_data : ttempcreatenode;
@@ -2315,9 +2325,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
@@ -2464,7 +2475,7 @@ implementation
 
           { handle predefined procedures }
           is_const:=(po_internconst in procdefinition.procoptions) and
-                    ((block_type in [bt_const,bt_type]) or
+                    ((block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
                      (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
           if (procdefinition.proccalloption=pocall_internproc) or is_const then
            begin
@@ -2875,7 +2886,7 @@ implementation
          if assigned(callcleanupblock) then
            firstpass(callcleanupblock);
 
-         if not (block_type in [bt_const,bt_type]) then
+         if not (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) then
            include(current_procinfo.flags,pi_do_call);
 
          { order parameters }

compiler/ncgbas.pas

@@ -429,7 +429,7 @@ interface
         else
           begin
             location_reset(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.typedef));
-            tg.GetTemp(current_asmdata.CurrAsmList,size,tempinfo^.temptype,tempinfo^.location.reference);
+            tg.GetTemp(current_asmdata.CurrAsmList,size,tempinfo^.typedef.alignment,tempinfo^.temptype,tempinfo^.location.reference);
           end;
         include(tempinfo^.flags,ti_valid);
       end;

compiler/ncgcal.pas

@@ -556,7 +556,7 @@ implementation
                     structs with up to 16 bytes are returned in registers }
                   if cgsize in [OS_128,OS_S128] then
                     begin
-                      tg.GetTemp(current_asmdata.CurrAsmList,16,tt_normal,ref);
+                      tg.GetTemp(current_asmdata.CurrAsmList,16,8,tt_normal,ref);
                       location_reset(location,LOC_REFERENCE,OS_NO);
                       location.reference:=ref;
                       cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_64,OS_64,procdefinition.funcretloc[callerside].register,ref);
@@ -1023,9 +1023,9 @@ implementation
                         extra_interrupt_code;
                       extra_call_code;
                       if (name_to_call='') then
-                        cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname)
+                        cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions)
                       else
-                        cg.a_call_name(current_asmdata.CurrAsmList,name_to_call);
+                        cg.a_call_name(current_asmdata.CurrAsmList,name_to_call,po_weakexternal in procdefinition.procoptions);
                       extra_post_call_code;
                     end;
                end;
@@ -1112,7 +1112,8 @@ implementation
            end;
 
 {$if defined(x86) or defined(arm)}
-         if procdefinition.proccalloption=pocall_safecall then
+         if (procdefinition.proccalloption=pocall_safecall) and
+            (target_info.system in system_all_windows) then
            begin
 {$ifdef x86_64}
              cgpara.init;
@@ -1121,7 +1122,7 @@ implementation
              cgpara.done;
 {$endif x86_64}
              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-             cg.a_call_name(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK');
+             cg.a_call_name(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK',false);
              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
            end;
 {$endif}
@@ -1159,7 +1160,7 @@ implementation
             not(po_virtualmethod in procdefinition.procoptions) then
            begin
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
            end;
       end;

compiler/ncgcnv.pas

@@ -243,7 +243,7 @@ interface
          case tstringdef(resultdef).stringtype of
            st_shortstring :
              begin
-               tg.GetTemp(current_asmdata.CurrAsmList,256,tt_normal,location.reference);
+               tg.GetTemp(current_asmdata.CurrAsmList,256,1,tt_normal,location.reference);
                cg.a_load_loc_ref(current_asmdata.CurrAsmList,left.location.size,left.location,
                  location.reference);
                location_freetemp(current_asmdata.CurrAsmList,left.location);
@@ -272,7 +272,7 @@ interface
              if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
                location_force_fpureg(current_asmdata.CurrAsmList,left.location,false);
              { round them down to the proper precision }
-             tg.gettemp(current_asmdata.currasmlist,resultdef.size,tt_normal,tr);
+             tg.gettemp(current_asmdata.currasmlist,resultdef.size,resultdef.alignment,tt_normal,tr);
              cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,tr);
              location_reset(left.location,LOC_REFERENCE,location.size);
              left.location.reference:=tr;
@@ -368,7 +368,7 @@ interface
     var r:Treference;
 
     begin
-      tg.gettemp(current_asmdata.currasmlist,2*sizeof(puint),tt_normal,r);
+      tg.gettemp(current_asmdata.currasmlist,2*sizeof(puint),sizeof(puint),tt_normal,r);
       location_reset(location,LOC_REFERENCE,OS_NO);
       location.reference:=r;
       cg.a_load_const_ref(current_asmdata.currasmlist,OS_ADDR,0,r);

compiler/ncgflw.pas

@@ -977,14 +977,14 @@ implementation
               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc3);
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RAISEEXCEPTION');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RAISEEXCEPTION',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
            end
          else
            begin
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
            end;
          paraloc1.done;
@@ -1008,7 +1008,7 @@ implementation
         paraloc1 : tcgpara;
       begin
          cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK');
+         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK',false);
          cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
          paraloc1.init;
          paramanager.getintparaloc(pocall_default,1,paraloc1);
@@ -1016,7 +1016,7 @@ implementation
          cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
          paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
          cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION');
+         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
          cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
          paraloc1.done;
       end;
@@ -1130,7 +1130,7 @@ implementation
               cg.a_param_const(current_asmdata.CurrAsmList,OS_ADDR,-1,paraloc1);
               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               paraloc1.done;
 
@@ -1152,7 +1152,7 @@ implementation
               free_exception(current_asmdata.CurrAsmList,destroytemps,0,doobjectdestroy,false);
 
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
 
               paraloc1.init;
@@ -1161,12 +1161,12 @@ implementation
               cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               paraloc1.done;
               { we don't need to restore esi here because reraise never }
               { returns                                                 }
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
 
               cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy);
               cleanupobjectstack;
@@ -1175,7 +1175,7 @@ implementation
            end
          else
            begin
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
               exceptflowcontrol:=flowcontrol;
            end;
 
@@ -1186,7 +1186,7 @@ implementation
               { we must also destroy the address frame which guards }
               { exception object                                    }
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cleanupobjectstack;
@@ -1199,7 +1199,7 @@ implementation
               { we must also destroy the address frame which guards }
               { exception object                                    }
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cleanupobjectstack;
@@ -1212,7 +1212,7 @@ implementation
               { we must also destroy the address frame which guards }
               { exception object                                    }
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cleanupobjectstack;
@@ -1224,7 +1224,7 @@ implementation
               { do some magic for exit in the try block }
               cg.a_label(current_asmdata.CurrAsmList,exittrylabel);
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
@@ -1234,7 +1234,7 @@ implementation
            begin
               cg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
@@ -1244,7 +1244,7 @@ implementation
            begin
               cg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
@@ -1302,7 +1302,7 @@ implementation
          cg.a_paramaddr_ref(current_asmdata.CurrAsmList,href2,paraloc1);
          paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
          cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES');
+         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES',false);
          cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
 
          { is it this catch? No. go to next onlabel }
@@ -1323,7 +1323,7 @@ implementation
            end
          else
            begin
-             tg.GetTemp(current_asmdata.CurrAsmList,sizeof(pint),tt_normal,exceptref);
+             tg.GetTemp(current_asmdata.CurrAsmList,sizeof(pint),sizeof(pint),tt_normal,exceptref);
              cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptref);
            end;
 
@@ -1360,18 +1360,18 @@ implementation
          free_exception(current_asmdata.CurrAsmList,excepttemps,0,doobjectdestroy,false);
 
          cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK');
+         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK',false);
          cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
          paramanager.getintparaloc(pocall_default,1,paraloc1);
          paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
          cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
          paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
          cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION');
+         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
          cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
          { we don't need to store/restore registers here because reraise never
            returns                                                             }
-         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
+         cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
 
          cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy);
          cleanupobjectstack;
@@ -1525,15 +1525,15 @@ implementation
                 (current_procinfo.procdef.proccalloption=pocall_safecall) then
                begin
                  { Remove and destroy the last exception object }
-                 cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK');
-                 cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION');
+                 cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK',false);
+                 cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
                  { Set return value of safecall procedure to indicate exception.       }
                  { Exception will be raised after procedure exit based on return value }
                  cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_ADDR,aint($8000FFFF),NR_FUNCTION_RETURN_REG);
                end
              else
 {$endif}
-               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
+               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
            end
          else
            begin
@@ -1562,7 +1562,7 @@ implementation
                   cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldContinueLabel);
                end;
              cg.a_label(current_asmdata.CurrAsmList,reraiselabel);
-             cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
+             cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
              { do some magic for exit,break,continue in the try block }
              if fc_exit in tryflowcontrol then
                begin

compiler/ncginl.pas

@@ -231,7 +231,7 @@ implementation
        paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc3);
        paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc4);
        cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-       cg.a_call_name(current_asmdata.CurrAsmList,'FPC_ASSERT');
+       cg.a_call_name(current_asmdata.CurrAsmList,'FPC_ASSERT',false);
        cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
        location_freetemp(current_asmdata.CurrAsmList,hp3.location);
        location_freetemp(current_asmdata.CurrAsmList,hp2.location);

compiler/ncgld.pas

@@ -270,7 +270,8 @@ implementation
                 gvs:=tstaticvarsym(symtableentry);
                 if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then
                   begin
-                    location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,tstaticvarsym(symtableentry).mangledname);
+                    location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,tstaticvarsym(symtableentry).mangledname,
+                      vo_is_weak_external in gvs.varoptions);
                     if (location.reference.base <> NR_NO) then
                       exit;
                   end;
@@ -279,7 +280,10 @@ implementation
                 { DLL variable }
                   begin
                     hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                    location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname);
+                    if not(vo_is_weak_external in gvs.varoptions) then
+                      location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname)
+                    else
+                      location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(tstaticvarsym(symtableentry).mangledname);
                     cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,location.reference,hregister);
                     reference_reset_base(location.reference,hregister,0);
                   end
@@ -290,7 +294,10 @@ implementation
                      if (tf_section_threadvars in target_info.flags) then
                        begin
                          if gvs.localloc.loc=LOC_INVALID then
-                           reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
+                           if not(vo_is_weak_external in gvs.varoptions) then
+                             reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
+                           else
+                             reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0)
                          else
                            location:=gvs.localloc;
 {$ifdef i386}
@@ -324,7 +331,10 @@ implementation
                          cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
                          cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,hregister,norelocatelab);
                          { don't save the allocated register else the result will be destroyed later }
-                         reference_reset_symbol(href,current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname),0);
+                         if not(vo_is_weak_external in gvs.varoptions) then
+                           reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
+                         else
+                           reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0);
                          paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
                          cg.a_param_ref(current_asmdata.CurrAsmList,OS_32,href,paraloc1);
                          paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
@@ -342,7 +352,10 @@ implementation
                            layout of a threadvar is (4 bytes pointer):
                              0 - Threadvar index
                              4 - Threadvar value in single threading }
-                         reference_reset_symbol(href,current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname),sizeof(pint));
+                         if not(vo_is_weak_external in gvs.varoptions) then
+                           reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),sizeof(pint))
+                         else
+                           reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),sizeof(pint));
                          cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister);
                          cg.a_label(current_asmdata.CurrAsmList,endrelocatelab);
                          location.reference.base:=hregister;
@@ -352,7 +365,10 @@ implementation
                  else
                    begin
                      if gvs.localloc.loc=LOC_INVALID then
-                       reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
+                       if not(vo_is_weak_external in gvs.varoptions) then
+                         reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
+                       else
+                         reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0)
                      else
                        location:=gvs.localloc;
                    end;
@@ -416,7 +432,7 @@ implementation
                       {$else}
                          internalerror(20020520);
                       {$endif} {$endif}
-                      tg.GetTemp(current_asmdata.CurrAsmList,2*sizeof(pint),tt_normal,location.reference);
+                      tg.GetTemp(current_asmdata.CurrAsmList,2*sizeof(pint),sizeof(pint),tt_normal,location.reference);
                       secondpass(left);
 
                       { load class instance/classrefdef address }
@@ -482,14 +498,22 @@ implementation
                     begin
                        pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]);
                        if (po_external in pd.procoptions) then
-                         location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,pd.mangledname);
+                         location.reference.base :=
+                            cg.g_indirect_sym_load(current_asmdata.CurrAsmList,pd.mangledname,
+                                                   po_weakexternal in pd.procoptions);
                        {!!!!! Be aware, work on virtual methods too }
                        if (location.reference.base = NR_NO) then
-                         location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname);
+                         if not(po_weakexternal in pd.procoptions) then
+                           location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname)
+                         else
+                           location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(procdef.mangledname);
                     end;
                end;
             labelsym :
-              location.reference.symbol:=tcglabelnode((tlabelsym(symtableentry).code)).getasmlabel;
+              if assigned(tlabelsym(symtableentry).asmblocklabel) then
+                location.reference.symbol:=tlabelsym(symtableentry).asmblocklabel
+              else
+                location.reference.symbol:=tcglabelnode((tlabelsym(symtableentry).code)).getasmlabel;
             else internalerror(200510032);
          end;
       end;
@@ -736,7 +760,7 @@ implementation
                             { convert an extended into a double/single, since sse   }
                             { doesn't support extended)                             }
                             r:=cg.getfpuregister(current_asmdata.CurrAsmList,right.location.size);
-                            tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,tt_normal,href);
+                            tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,left.resultdef.alignment,tt_normal,href);
                             cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,right.location.size,right.location.size,right.location.reference,r);
                             cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,r,href);
                             if releaseright then
@@ -813,7 +837,7 @@ implementation
                         begin
                           { perform size conversion if needed (the mm-code cannot convert an   }
                           { extended into a double/single, since sse doesn't support extended) }
-                          tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,tt_normal,href);
+                          tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,left.resultdef.alignment,tt_normal,href);
                           cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,href);
                           location_reset(right.location,LOC_REFERENCE,left.location.size);
                           right.location.reference:=href;
@@ -930,31 +954,38 @@ implementation
         hp    : tarrayconstructornode;
         href  : treference;
         lt    : tdef;
-        vaddr : boolean;
-        vtype : longint;
-        freetemp,
-        dovariant : boolean;
-        elesize : longint;
-        tmpreg  : tregister;
         paraloc : tcgparalocation;
         otlabel,
         oflabel : tasmlabel;
+        vtype : longint;
+        elesize,
+        elealign : longint;
+        tmpreg  : tregister;
+        vaddr : boolean;
+        freetemp,
+        dovariant : boolean;
       begin
         if is_packed_array(resultdef) then
           internalerror(200608042);
         dovariant:=(nf_forcevaria in flags) or is_variant_array(resultdef);
         if dovariant then
-          elesize:=sizeof(pint)+sizeof(pint)
+          begin
+            elesize:=sizeof(pint)+sizeof(pint);
+            elealign:=sizeof(pint);
+          end
         else
-          elesize:=tarraydef(resultdef).elesize;
+          begin
+            elesize:=tarraydef(resultdef).elesize;
+            elealign:=tarraydef(resultdef).elementdef.alignment;
+          end;
         location_reset(location,LOC_CREFERENCE,OS_NO);
         fillchar(paraloc,sizeof(paraloc),0);
         { Allocate always a temp, also if no elements are required, to
           be sure that location is valid (PFV) }
          if tarraydef(resultdef).highrange=-1 then
-           tg.GetTemp(current_asmdata.CurrAsmList,elesize,tt_normal,location.reference)
+           tg.GetTemp(current_asmdata.CurrAsmList,elesize,elealign,tt_normal,location.reference)
          else
-           tg.GetTemp(current_asmdata.CurrAsmList,(tarraydef(resultdef).highrange+1)*elesize,tt_normal,location.reference);
+           tg.GetTemp(current_asmdata.CurrAsmList,(tarraydef(resultdef).highrange+1)*elesize,resultdef.alignment,tt_normal,location.reference);
          href:=location.reference;
         { Process nodes in array constructor }
         hp:=self;

compiler/ncgmat.pas

@@ -149,7 +149,7 @@ implementation
         { get a temporary memory reference to store the floating
           point value
         }
-        tg.gettemp(current_asmdata.CurrAsmList,tcgsize2size[_size],tt_normal,href);
+        tg.gettemp(current_asmdata.CurrAsmList,tcgsize2size[_size],tcgsize2size[_size],tt_normal,href);
         { store the floating point value in the temporary memory area }
         cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,_size,_size,r,href);
         { only single and double ieee are supported, for little endian
@@ -193,7 +193,7 @@ implementation
               location.register64.reglo,tr);
             current_asmdata.getjumplabel(hl);
             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,tr,hl);
-            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
+            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
             cg.a_label(current_asmdata.CurrAsmList,hl);
           end;
       end;
@@ -244,7 +244,7 @@ implementation
           begin
             current_asmdata.getjumplabel(hl);
             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_SINT,OC_NE,low(aint),location.register,hl);
-            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
+            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
             cg.a_label(current_asmdata.CurrAsmList,hl);
           end;
       end;
@@ -371,7 +371,7 @@ implementation
                   paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
                   cg.a_param_const(current_asmdata.CurrAsmList,OS_S32,200,paraloc1);
                   paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
-                  cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR');
+                  cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR',false);
                   paraloc1.done;
                   cg.a_label(current_asmdata.CurrAsmList,hl);
                   if nodetype = modn then

compiler/ncgmem.pas

@@ -228,7 +228,7 @@ implementation
             paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
             paraloc1.done;
             cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER');
+            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
             cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
           end;
       end;
@@ -283,7 +283,7 @@ implementation
                 cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
                 paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
                 cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER');
+                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
                 cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               end;
            end
@@ -302,7 +302,7 @@ implementation
                 cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
                 paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
                 cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER');
+                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
                 cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
               end;
            end
@@ -585,7 +585,7 @@ implementation
                cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_LT,0,hreg,poslabel);
                cg.a_cmp_loc_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_BE,hightree.location,hreg,neglabel);
                cg.a_label(current_asmdata.CurrAsmList,poslabel);
-               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RANGEERROR');
+               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RANGEERROR',false);
                cg.a_label(current_asmdata.CurrAsmList,neglabel);
                { release hightree }
                hightree.free;
@@ -603,7 +603,7 @@ implementation
                paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
                paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
                cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DYNARRAY_RANGECHECK');
+               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DYNARRAY_RANGECHECK',false);
                cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
             end
          else
@@ -685,7 +685,7 @@ implementation
                    cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,location.reference.base,paraloc1);
                    paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
                    cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-                   cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_CHECKZERO');
+                   cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_CHECKZERO',false);
                    cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
                 end;
 
@@ -795,7 +795,7 @@ implementation
                               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
                               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
                               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-                              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK');
+                              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK',false);
                               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
                            end;
 
@@ -963,7 +963,7 @@ implementation
                               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
                               paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
                               cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-                              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK');
+                              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK',false);
                               cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
                            end;
                          st_shortstring:

compiler/ncgopt.pas

@@ -90,7 +90,7 @@ begin
   if not(tg.istemp(left.location.reference) and
          (tg.sizeoftemp(current_asmdata.CurrAsmList,left.location.reference) = 256)) then
     begin
-       tg.Gettemp(current_asmdata.CurrAsmList,256,tt_normal,href);
+       tg.Gettemp(current_asmdata.CurrAsmList,256,1,tt_normal,href);
        cg.g_copyshortstring(current_asmdata.CurrAsmList,left.location.reference,href,255);
        location_freetemp(current_asmdata.CurrAsmList,left.location);
        { return temp reference }

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/ncgutil.pas

@@ -361,10 +361,11 @@ implementation
           begin
             srsym:=search_system_type('JMP_BUF');
             jmp_buf_size:=srsym.typedef.size;
+            jmp_buf_align:=srsym.typedef.alignment;
           end;
-        tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,t.envbuf);
-        tg.GetTemp(list,jmp_buf_size,tt_persistent,t.jmpbuf);
-        tg.GetTemp(list,sizeof(pint),tt_persistent,t.reasonbuf);
+        tg.GetTemp(list,EXCEPT_BUF_SIZE,sizeof(pint),tt_persistent,t.envbuf);
+        tg.GetTemp(list,jmp_buf_size,jmp_buf_align,tt_persistent,t.jmpbuf);
+        tg.GetTemp(list,sizeof(pint),sizeof(pint),tt_persistent,t.reasonbuf);
       end;
 
 
@@ -397,7 +398,7 @@ implementation
         paramanager.freeparaloc(list,paraloc2);
         paramanager.freeparaloc(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
         cg.deallocallcpuregisters(list);
 
         paramanager.getintparaloc(pocall_default,1,paraloc1);
@@ -405,7 +406,7 @@ implementation
         cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
         paramanager.freeparaloc(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_SETJMP');
+        cg.a_call_name(list,'FPC_SETJMP',false);
         cg.deallocallcpuregisters(list);
         cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
 
@@ -421,7 +422,7 @@ implementation
     procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
      begin
          cg.allocallcpuregisters(list);
-         cg.a_call_name(list,'FPC_POPADDRSTACK');
+         cg.a_call_name(list,'FPC_POPADDRSTACK',false);
          cg.deallocallcpuregisters(list);
 
          if not onlyfree then
@@ -682,7 +683,7 @@ implementation
             { if it's in an mm register, store to memory first }
             if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
               begin
-                tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
+                tg.GetTemp(list,tcgsize2size[l.size],tcgsize2size[l.size],tt_normal,href);
                 cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar);
                 location_reset(l,LOC_REFERENCE,l.size);
                 l.reference:=href;
@@ -707,7 +708,7 @@ implementation
             { if it's in an fpu register, store to memory first }
             if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
               begin
-                tg.GetTemp(list,tcgsize2size[l.size],tt_normal,href);
+                tg.GetTemp(list,tcgsize2size[l.size],tcgsize2size[l.size],tt_normal,href);
                 cg.a_loadfpu_reg_ref(list,l.size,l.size,l.register,href);
                 location_reset(l,LOC_REFERENCE,l.size);
                 l.reference:=href;
@@ -771,7 +772,7 @@ implementation
           LOC_FPUREGISTER,
           LOC_CFPUREGISTER :
             begin
-              tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
+              tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
               cg.a_loadfpu_reg_ref(list,l.size,l.size,l.register,r);
               location_reset(l,LOC_REFERENCE,l.size);
               l.reference:=r;
@@ -779,7 +780,7 @@ implementation
           LOC_MMREGISTER,
           LOC_CMMREGISTER:
             begin
-              tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
+              tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
               cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
               location_reset(l,LOC_REFERENCE,l.size);
               l.reference:=r;
@@ -788,7 +789,7 @@ implementation
           LOC_REGISTER,
           LOC_CREGISTER :
             begin
-              tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
+              tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
 {$ifndef cpu64bitalu}
               if l.size in [OS_64,OS_S64] then
                 cg64.a_load64_loc_ref(list,l,r)
@@ -803,7 +804,7 @@ implementation
           LOC_SUBSETREF,
           LOC_CSUBSETREF:
             begin
-              tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
+              tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
               cg.a_load_loc_ref(list,l.size,l,r);
               location_reset(l,LOC_REFERENCE,l.size);
               l.reference:=r;
@@ -1828,7 +1829,7 @@ implementation
                   { Arm and Sparc passes floats in int registers, when loading to fpu register
                     we need a temp }
                   sizeleft := TCGSize2Size[currpara.initialloc.size];
-                  tg.GetTemp(list,sizeleft,tt_normal,tempref);
+                  tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref);
                   href:=tempref;
                   while assigned(paraloc) do
                     begin
@@ -1986,7 +1987,7 @@ implementation
          begin
            { initialize units }
            cg.allocallcpuregisters(list);
-           cg.a_call_name(list,'FPC_INITIALIZEUNITS');
+           cg.a_call_name(list,'FPC_INITIALIZEUNITS',false);
            cg.deallocallcpuregisters(list);
          end;
 
@@ -2006,7 +2007,7 @@ implementation
         { call __EXIT for main program }
         if (not DLLsource) and
            (current_procinfo.procdef.proctypeoption=potype_proginit) then
-          cg.a_call_name(list,'FPC_DO_EXIT');
+          cg.a_call_name(list,'FPC_DO_EXIT',false);
       end;
 
 
@@ -2186,7 +2187,7 @@ implementation
         paramanager.freeparaloc(list,paraloc1);
         { Call the helper }
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_STACKCHECK');
+        cg.a_call_name(list,'FPC_STACKCHECK',false);
         cg.deallocallcpuregisters(list);
         paraloc1.done;
       end;

compiler/ncnv.pas

@@ -54,6 +54,7 @@ interface
           function simplify:tnode; override;
           procedure mark_write;override;
           function docompare(p: tnode) : boolean; override;
+          function retains_value_location:boolean;
           function assign_allowed:boolean;
           procedure second_call_helper(c : tconverttype);
        private
@@ -192,6 +193,7 @@ interface
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function dogetcopy: tnode;override;
+          function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           call: tnode;
        end;
@@ -1594,8 +1596,7 @@ implementation
       begin
         result:=self;
         while (result.nodetype=typeconvn) and
-              (nf_absolute in result.flags) and
-              (resultdef.size=left.resultdef.size) do
+              ttypeconvnode(result).retains_value_location do
           result:=ttypeconvnode(result).left;
       end;
 
@@ -2345,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
@@ -2497,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;
@@ -2930,7 +2929,7 @@ implementation
       end;
 
 
-    function ttypeconvnode.assign_allowed:boolean;
+    function ttypeconvnode.retains_value_location:boolean;
       begin
         result:=(convtype=tc_equal) or
                 { typecasting from void is always allowed }
@@ -2950,12 +2949,19 @@ implementation
                 ((convtype in [tc_int_2_bool,tc_bool_2_int,tc_bool_2_bool]) and
                  (nf_explicit in flags) and
                  (resultdef.size=left.resultdef.size));
+      end;
+
+
+    function ttypeconvnode.assign_allowed:boolean;
+      begin
+        result:=retains_value_location;
 
         { When using only a part of the value it can't be in a register since
           that will load the value in a new register first }
         { the same goes for changing the sign of equal-sized values which
           are smaller than an entire register }
-        if (resultdef.size<left.resultdef.size) or
+        if result and
+           (resultdef.size<left.resultdef.size) or
            ((resultdef.size=left.resultdef.size) and
             (left.resultdef.size<sizeof(aint)) and
             (is_signed(resultdef) xor is_signed(left.resultdef))) then
@@ -3357,6 +3363,14 @@ implementation
       end;
 
 
+    function tasnode.docompare(p: tnode): boolean;
+      begin
+        result:=
+          inherited docompare(p) and
+          tasnode(p).call.isequal(call);
+      end;
+
+
     function tasnode.pass_1 : tnode;
       var
         procname: string;

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/nmem.pas

@@ -47,6 +47,7 @@ tloadvmtaddrnode = class(tunarynode)
           procedure derefimpl;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
+          function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
        end;
        tloadparentfpnodeclass = class of tloadparentfpnode;
@@ -62,6 +63,7 @@ tloadvmtaddrnode = class(tunarynode)
           procedure mark_write;override;
           procedure buildderefimpl;override;
           procedure derefimpl;override;
+          function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
@@ -220,6 +222,14 @@ implementation
       end;
 
 
+    function tloadparentfpnode.docompare(p: tnode): boolean;
+      begin
+        result:=
+          inherited docompare(p) and
+          (tloadparentfpnode(p).parentpd=parentpd);
+      end;
+
+
     function tloadparentfpnode.dogetcopy : tnode;
       var
          p : tloadparentfpnode;
@@ -328,11 +338,17 @@ implementation
       end;
 
 
-    function taddrnode.dogetcopy : tnode;
+    function taddrnode.docompare(p: tnode): boolean;
+      begin
+        result:=
+          inherited docompare(p) and
+          (taddrnode(p).getprocvardef=getprocvardef);
+      end;
 
+
+    function taddrnode.dogetcopy : tnode;
       var
          p : taddrnode;
-
       begin
          p:=taddrnode(inherited dogetcopy);
          p.getprocvardef:=getprocvardef;

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);
@@ -136,28 +117,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
 *****************************************************************************}
@@ -166,281 +125,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,
@@ -667,16 +544,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
@@ -692,6 +589,8 @@ implementation
             { Allocate interface tables }
             intf_allocate_vtbls;
           end;
+
+        current_objectdef:=old_current_objectdef;
       end;
 
 
@@ -1012,7 +911,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;
@@ -1030,7 +929,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);
 
@@ -1093,8 +992,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);
@@ -1114,8 +1013,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)));
@@ -1295,7 +1194,8 @@ implementation
 
     procedure TVMTWriter.writevirtualmethods(List:TAsmList);
       var
-         pd : tprocdef;
+         vmtpd : tprocdef;
+         vmtentry : pvmtentry;
          i  : longint;
          procname : string;
 {$ifdef vtentry}
@@ -1306,15 +1206,17 @@ 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 if not wpoinfomanager.optimized_name_for_vmt(_class,pd,procname) then
-             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));

compiler/node.pas

@@ -298,6 +298,7 @@ interface
          resultdefderef : tderef;
          fileinfo      : tfileposinfo;
          localswitches : tlocalswitches;
+         verbosity     : longint;
          optinfo : poptinfo;
          constructor create(t:tnodetype);
          { this constructor is only for creating copies of class }
@@ -466,7 +467,7 @@ interface
 implementation
 
     uses
-       cutils,verbose,ppu,
+       cutils,verbose,ppu,comphook,
        symconst,
        nutils,nflw,
        defutil;
@@ -695,6 +696,7 @@ implementation
          { save local info }
          fileinfo:=current_filepos;
          localswitches:=current_settings.localswitches;
+         verbosity:=status.verbosity;
          resultdef:=nil;
          flags:=[];
       end;
@@ -712,6 +714,7 @@ implementation
         blocktype:=tblock_type(ppufile.getbyte);
         ppufile.getposinfo(fileinfo);
         ppufile.getsmallset(localswitches);
+        verbosity:=ppufile.getlongint;
         ppufile.getderef(resultdefderef);
         ppufile.getsmallset(flags);
         { updated by firstpass }
@@ -726,6 +729,7 @@ implementation
         ppufile.putbyte(byte(block_type));
         ppufile.putposinfo(fileinfo);
         ppufile.putsmallset(localswitches);
+        ppufile.putlongint(verbosity);
         ppufile.putderef(resultdefderef);
         ppufile.putsmallset(flags);
       end;
@@ -887,6 +891,7 @@ implementation
          p.resultdef:=resultdef;
          p.fileinfo:=fileinfo;
          p.localswitches:=localswitches;
+         p.verbosity:=verbosity;
 {         p.list:=list; }
          result:=p;
       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,
@@ -798,13 +798,15 @@ implementation
                         { operation (add, sub, or, and }
                         inc(result);
                         { left expression }
-                        inc(result,node_complexity(tbinarynode(p).left));
+                        inc(result,node_complexity(tcallparanode(tunarynode(p).left).left));
                         if (result >= NODE_COMPLEXITY_INF) then
                           begin
                             result := NODE_COMPLEXITY_INF;
                             exit;
                           end;
-                        p := tbinarynode(p).right;
+                        p:=tcallparanode(tunarynode(p).left).right;
+                        if assigned(p) then
+                          p:=tcallparanode(p).left;
                       end;
                     else
                       begin

compiler/options.pas

@@ -1661,12 +1661,13 @@ procedure Toption.Interpret_file(const filename : string);
   end;
 
 const
-  maxlevel=16;
+  maxlevel = 15;
 var
   f     : text;
   s, tmp,
   opts  : string;
-  skip  : array[0..maxlevel-1] of boolean;
+  skip  : array[0..maxlevel] of boolean;
+  line,
   level : longint;
   option_read : boolean;
 begin
@@ -1695,9 +1696,11 @@ begin
   Message1(option_start_reading_configfile,filename);
   fillchar(skip,sizeof(skip),0);
   level:=0;
+  line:=0;
   while not eof(f) do
    begin
      readln(f,opts);
+     inc(line);
      RemoveSep(opts);
      if (opts<>'') and (opts[1]<>';') then
       begin
@@ -1719,7 +1722,7 @@ begin
                RemoveSep(opts);
                if Level>=maxlevel then
                 begin
-                  Message(option_too_many_ifdef);
+                  Message2(option_too_many_ifdef,filename,tostr(line));
                   stopOptions(1);
                 end;
                inc(Level);
@@ -1731,7 +1734,7 @@ begin
                RemoveSep(opts);
                if Level>=maxlevel then
                 begin
-                  Message(option_too_many_ifdef);
+                  Message2(option_too_many_ifdef,filename,tostr(line));
                   stopOptions(1);
                 end;
                inc(Level);
@@ -1739,14 +1742,22 @@ begin
              end
            else
             if (s='ELSE') then
-             skip[level]:=skip[level-1] or (not skip[level])
+              begin
+                if Level=0 then
+                  begin
+                    Message2(option_else_without_if,filename,tostr(line));
+                    stopOptions(1);
+                  end
+                else
+                  skip[level]:=skip[level-1] or (not skip[level])
+              end
            else
             if (s='ENDIF') then
              begin
                skip[level]:=false;
                if Level=0 then
                 begin
-                  Message(option_too_many_endif);
+                  Message2(option_too_many_endif,filename,tostr(line));
                   stopOptions(1);
                 end;
                dec(level);

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/paramgr.pas

@@ -340,7 +340,7 @@ implementation
                 newparaloc^.register:=cg.getmmregister(list,paraloc^.size);
               LOC_REFERENCE :
                 begin
-                  tg.gettemp(list,len,tt_persistent,href);
+                  tg.gettemp(list,len,cgpara.alignment,tt_persistent,href);
                   newparaloc^.reference.index:=href.base;
                   newparaloc^.reference.offset:=href.offset;
                 end;

compiler/parser.pas

@@ -41,8 +41,8 @@ implementation
       fksysutl,
 {$ENDIF}
       cutils,cclasses,
-      globtype,version,tokens,systems,globals,verbose,
-      symbase,symtable,symsym,
+      globtype,version,tokens,systems,globals,verbose,switches,
+      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
@@ -309,11 +316,7 @@ implementation
             oldparse_only:=parse_only;
           { save akt... state }
           { handle the postponed case first }
-           if localswitcheschanged then
-             begin
-               current_settings.localswitches:=nextlocalswitches;
-               localswitcheschanged:=false;
-             end;
+            flushpendingswitchesstate;
             oldcurrent_filepos:=current_filepos;
             old_settings:=current_settings;
           end;

compiler/pass_1.pas

@@ -41,7 +41,7 @@ interface
 implementation
 
     uses
-      globtype,systems,cclasses,
+      globtype,comphook,systems,cclasses,
       cutils,globals,
       procinfo,
       cgbase,symdef
@@ -61,6 +61,7 @@ implementation
       var
          oldcodegenerror  : boolean;
          oldlocalswitches : tlocalswitches;
+         oldverbosity     : longint;
          oldpos    : tfileposinfo;
          hp        : tnode;
       begin
@@ -69,9 +70,11 @@ implementation
            oldcodegenerror:=codegenerror;
            oldpos:=current_filepos;
            oldlocalswitches:=current_settings.localswitches;
+           oldverbosity:=status.verbosity;
            codegenerror:=false;
            current_filepos:=p.fileinfo;
            current_settings.localswitches:=p.localswitches;
+           status.verbosity:=p.verbosity;
            hp:=p.pass_typecheck;
            { should the node be replaced? }
            if assigned(hp) then
@@ -84,6 +87,7 @@ implementation
             end;
            current_settings.localswitches:=oldlocalswitches;
            current_filepos:=oldpos;
+           status.verbosity:=oldverbosity;
            if codegenerror then
             begin
               include(p.flags,nf_error);
@@ -115,6 +119,7 @@ implementation
          oldcodegenerror  : boolean;
          oldlocalswitches : tlocalswitches;
          oldpos    : tfileposinfo;
+         oldverbosity: longint;
          hp : tnode;
       begin
          if (nf_pass1_done in p.flags) then
@@ -124,17 +129,17 @@ implementation
               oldcodegenerror:=codegenerror;
               oldpos:=current_filepos;
               oldlocalswitches:=current_settings.localswitches;
+              oldverbosity:=status.verbosity;
               codegenerror:=false;
               current_filepos:=p.fileinfo;
               current_settings.localswitches:=p.localswitches;
+              status.verbosity:=p.verbosity;
               { checks make always a call }
               if ([cs_check_range,cs_check_overflow,cs_check_stack] * current_settings.localswitches <> []) then
                 include(current_procinfo.flags,pi_do_call);
               { determine the resultdef if not done }
               if (p.resultdef=nil) then
                begin
-                 current_filepos:=p.fileinfo;
-                 current_settings.localswitches:=p.localswitches;
                  hp:=p.pass_typecheck;
                  { should the node be replaced? }
                  if assigned(hp) then
@@ -152,15 +157,11 @@ implementation
                     if p.resultdef=nil then
                      p.resultdef:=generrordef;
                   end;
-                 current_settings.localswitches:=oldlocalswitches;
-                 current_filepos:=oldpos;
                  codegenerror:=codegenerror or oldcodegenerror;
                end;
               if not(nf_error in p.flags) then
                begin
                  { first pass }
-                 current_filepos:=p.fileinfo;
-                 current_settings.localswitches:=p.localswitches;
                  hp:=p.pass_1;
                  { should the node be replaced? }
                  if assigned(hp) then
@@ -197,6 +198,7 @@ implementation
               codegenerror:=codegenerror or oldcodegenerror;
               current_settings.localswitches:=oldlocalswitches;
               current_filepos:=oldpos;
+              status.verbosity:=oldverbosity;
            end
          else
            codegenerror:=true;

compiler/pdecl.pas

@@ -194,7 +194,7 @@ implementation
                 begin
                    { set the blocktype first so a consume also supports a
                      caret, to support const s : ^string = nil }
-                   block_type:=bt_type;
+                   block_type:=bt_const_type;
                    consume(_COLON);
                    read_anon_type(hdef,false);
                    block_type:=bt_const;
@@ -302,6 +302,7 @@ implementation
          hdef     : tdef;
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
+         objecttype : tobjecttyp;
          isgeneric,
          isunique,
          istyperenaming : boolean;
@@ -311,7 +312,6 @@ implementation
       begin
          old_block_type:=block_type;
          block_type:=bt_type;
-         typecanbeforward:=true;
          repeat
            defpos:=current_tokenpos;
            istyperenaming:=false;
@@ -366,11 +366,22 @@ implementation
                     is_class_or_interface_or_dispinterface(ttypesym(sym).typedef) and
                     (oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then
                   begin
-                    { we can ignore the result   }
-                    { the definition is modified }
-                    object_dec(orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef));
-                    { since the definition is modified, there may be new forwarddefs }
-                    symtablestack.top.checkforwardtype(sym);
+                    case token of
+                      _CLASS :
+                        objecttype:=odt_class;
+                      _INTERFACE :
+                        if current_settings.interfacetype=it_interfacecom then
+                          objecttype:=odt_interfacecom
+                        else
+                          objecttype:=odt_interfacecorba;
+                      _DISPINTERFACE :
+                        objecttype:=odt_dispinterface;
+                      else
+                        internalerror(200811072);
+                    end;
+                    consume(token);
+                    { we can ignore the result, the definition is modified }
+                    object_dec(objecttype,orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef));
                     newtype:=ttypesym(sym);
                     hdef:=newtype.typedef;
                   end
@@ -498,8 +509,7 @@ implementation
            if assigned(generictypelist) then
              generictypelist.free;
          until token<>_ID;
-         typecanbeforward:=false;
-         tstoredsymtable(symtablestack.top).resolve_forward_types;
+         resolve_forward_types;
          block_type:=old_block_type;
       end;
 

compiler/pdecobj.pas

@@ -27,19 +27,19 @@ interface
 
     uses
       cclasses,
-      globtype,symtype,symdef;
+      globtype,symconst,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(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
 
     uses
       cutils,
       globals,verbose,systems,tokens,
-      symconst,symbase,symsym,symtable,
+      symbase,symsym,symtable,
       node,nld,nmem,ncon,ncnv,ncal,
-      scanner,
+      fmodule,scanner,
       pbase,pexpr,pdecsub,pdecvar,ptype,pdecl
       ;
 
@@ -50,454 +50,318 @@ implementation
       current_procinfo = 'error';
 
 
-    function object_dec(const n : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
-    { this function parses an object or class declaration }
+    function constructor_head:tprocdef;
       var
-         there_is_a_destructor : boolean;
-         classtype : tobjecttyp;
-         pcrd      : tclassrefdef;
-         hdef      : tdef;
-         old_object_option : tsymoptions;
-         oldparse_only : boolean;
-         storetypecanbeforward : boolean;
-
-
-      function constructor_head:tprocdef;
-        var
-          pd : tprocdef;
-        begin
-           consume(_CONSTRUCTOR);
-           { must be at same level as in implementation }
-           parse_proc_head(aktobjectdef,potype_constructor,pd);
-           if not assigned(pd) then
-             begin
-               consume(_SEMICOLON);
-               exit;
-             end;
-           if (cs_constructor_name in current_settings.globalswitches) and
-              (pd.procsym.name<>'INIT') then
-             Message(parser_e_constructorname_must_be_init);
-           consume(_SEMICOLON);
-           include(aktobjectdef.objectoptions,oo_has_constructor);
-           { Set return type, class constructors return the
-             created instance, object constructors return boolean }
-           if is_class(pd._class) then
-             pd.returndef:=pd._class
-           else
+        pd : tprocdef;
+      begin
+        result:=nil;
+        consume(_CONSTRUCTOR);
+        { must be at same level as in implementation }
+        parse_proc_head(current_objectdef,potype_constructor,pd);
+        if not assigned(pd) then
+          begin
+            consume(_SEMICOLON);
+            exit;
+          end;
+        if (cs_constructor_name in current_settings.globalswitches) and
+           (pd.procsym.name<>'INIT') then
+          Message(parser_e_constructorname_must_be_init);
+        consume(_SEMICOLON);
+        include(current_objectdef.objectoptions,oo_has_constructor);
+        { Set return type, class constructors return the
+          created instance, object constructors return boolean }
+        if is_class(pd._class) then
+          pd.returndef:=pd._class
+        else
 {$ifdef CPU64bitaddr}
-             pd.returndef:=bool64type;
+          pd.returndef:=bool64type;
 {$else CPU64bitaddr}
-             pd.returndef:=bool32type;
+          pd.returndef:=bool32type;
 {$endif CPU64bitaddr}
-           constructor_head:=pd;
-        end;
+        result:=pd;
+      end;
 
 
-      procedure property_dec;
-        var
-          p : tpropertysym;
-        begin
-           { check for a class }
-           if not((is_class_or_interface_or_dispinterface(aktobjectdef)) or
-              (not(m_tp7 in current_settings.modeswitches) and (is_object(aktobjectdef)))) then
-             Message(parser_e_syntax_error);
-           consume(_PROPERTY);
-           p:=read_property_dec(aktobjectdef);
-           consume(_SEMICOLON);
-           if try_to_consume(_DEFAULT) then
-             begin
-               if oo_has_default_property in aktobjectdef.objectoptions then
-                 message(parser_e_only_one_default_property);
-               include(aktobjectdef.objectoptions,oo_has_default_property);
-               include(p.propoptions,ppo_defaultproperty);
-               if not(ppo_hasparameters in p.propoptions) then
-                 message(parser_e_property_need_paras);
-               consume(_SEMICOLON);
-             end;
-           { hint directives, these can be separated by semicolons here,
-             that needs to be handled here with a loop (PFV) }
-           while try_consume_hintdirective(p.symoptions) do
-             Consume(_SEMICOLON);
-        end;
+    procedure property_dec;
+      var
+        p : tpropertysym;
+      begin
+        { check for a class }
+        if not((is_class_or_interface_or_dispinterface(current_objectdef)) or
+           (not(m_tp7 in current_settings.modeswitches) and (is_object(current_objectdef)))) then
+          Message(parser_e_syntax_error);
+        consume(_PROPERTY);
+        p:=read_property_dec(current_objectdef);
+        consume(_SEMICOLON);
+        if try_to_consume(_DEFAULT) then
+          begin
+            if oo_has_default_property in current_objectdef.objectoptions then
+              message(parser_e_only_one_default_property);
+            include(current_objectdef.objectoptions,oo_has_default_property);
+            include(p.propoptions,ppo_defaultproperty);
+            if not(ppo_hasparameters in p.propoptions) then
+              message(parser_e_property_need_paras);
+            consume(_SEMICOLON);
+          end;
+        { hint directives, these can be separated by semicolons here,
+          that needs to be handled here with a loop (PFV) }
+        while try_consume_hintdirective(p.symoptions) do
+          Consume(_SEMICOLON);
+      end;
 
 
-      function destructor_head:tprocdef;
-        var
-          pd : tprocdef;
-        begin
-           consume(_DESTRUCTOR);
-           parse_proc_head(aktobjectdef,potype_destructor,pd);
-           if not assigned(pd) then
-             begin
-               consume(_SEMICOLON);
-               exit;
-             end;
-           if (cs_constructor_name in current_settings.globalswitches) and
-              (pd.procsym.name<>'DONE') then
-             Message(parser_e_destructorname_must_be_done);
-           if not(pd.maxparacount=0) and
-              (m_fpc in current_settings.modeswitches) then
-             Message(parser_e_no_paras_for_destructor);
-           consume(_SEMICOLON);
-           include(aktobjectdef.objectoptions,oo_has_destructor);
-           { no return value }
-           pd.returndef:=voidtype;
-           destructor_head:=pd;
-        end;
+    function destructor_head:tprocdef;
+      var
+        pd : tprocdef;
+      begin
+        result:=nil;
+        consume(_DESTRUCTOR);
+        parse_proc_head(current_objectdef,potype_destructor,pd);
+        if not assigned(pd) then
+          begin
+            consume(_SEMICOLON);
+            exit;
+          end;
+        if (cs_constructor_name in current_settings.globalswitches) and
+           (pd.procsym.name<>'DONE') then
+          Message(parser_e_destructorname_must_be_done);
+        if not(pd.maxparacount=0) and
+           (m_fpc in current_settings.modeswitches) then
+          Message(parser_e_no_paras_for_destructor);
+        consume(_SEMICOLON);
+        include(current_objectdef.objectoptions,oo_has_destructor);
+        { no return value }
+        pd.returndef:=voidtype;
+        result:=pd;
+      end;
 
-      procedure setclassattributes;
 
-        begin
-           { publishable }
-           if classtype in [odt_interfacecom,odt_class] then
-             begin
-                aktobjectdef.objecttype:=classtype;
-                { set published flag in $M+ mode or it is inherited }
-                if (cs_generate_rtti in current_settings.localswitches) or
-                    (assigned(aktobjectdef.childof) and
-                     (oo_can_have_published in aktobjectdef.childof.objectoptions)) then
-                  include(aktobjectdef.objectoptions,oo_can_have_published);
-                { in "publishable" classes the default access type is published, this is
-                  done separate from above if-statement because the option can be
-                  inherited from the forward class definition }
-                if (oo_can_have_published in aktobjectdef.objectoptions) then
-                  current_object_option:=[sp_published];
-             end;
-        end;
+    procedure setinterfacemethodoptions;
+      var
+        i   : longint;
+        def : tdef;
+      begin
+        include(current_objectdef.objectoptions,oo_has_virtual);
+        for i:=0 to current_objectdef.symtable.DefList.count-1 do
+          begin
+            def:=tdef(current_objectdef.symtable.DefList[i]);
+            if assigned(def) and
+               (def.typ=procdef) then
+              begin
+                include(tprocdef(def).procoptions,po_virtualmethod);
+                tprocdef(def).forwarddef:=false;
+              end;
+          end;
+      end;
 
 
-      procedure setinterfacemethodoptions;
+    procedure handleImplementedInterface(intfdef : tobjectdef);
+      begin
+        if not is_interface(intfdef) then
+          begin
+             Message1(type_e_interface_type_expected,intfdef.typename);
+             exit;
+          end;
+        if current_objectdef.find_implemented_interface(intfdef)<>nil then
+          Message1(sym_e_duplicate_id,intfdef.objname^)
+        else
+          begin
+            { allocate and prepare the GUID only if the class
+              implements some interfaces. }
+            if current_objectdef.ImplementedInterfaces.count = 0 then
+              current_objectdef.prepareguid;
+            current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
+          end;
+      end;
 
-        var
-          i   : longint;
-          def : tdef;
-        begin
-          include(aktobjectdef.objectoptions,oo_has_virtual);
-          for i:=0 to aktobjectdef.symtable.DefList.count-1 do
-            begin
-              def:=tdef(aktobjectdef.symtable.DefList[i]);
-              if assigned(def) and
-                 (def.typ=procdef) then
-                begin
-                  include(tprocdef(def).procoptions,po_virtualmethod);
-                  tprocdef(def).forwarddef:=false;
-                end;
-            end;
-        end;
 
-      function readobjecttype : boolean;
+    procedure readImplementedInterfaces;
+      var
+        hdef : tdef;
+      begin
+        while try_to_consume(_COMMA) do
+          begin
+             id_type(hdef,false);
+             if (hdef.typ<>objectdef) then
+               begin
+                  Message1(type_e_interface_type_expected,hdef.typename);
+                  continue;
+               end;
+             handleImplementedInterface(tobjectdef(hdef));
+          end;
+      end;
 
-        begin
-           readobjecttype:=true;
-           { distinguish classes and objects }
-           case token of
-              _OBJECT:
-                begin
-                   classtype:=odt_object;
-                   consume(_OBJECT)
-                end;
-              _CPPCLASS:
-                begin
-                   classtype:=odt_cppclass;
-                   consume(_CPPCLASS);
-                end;
-              _DISPINTERFACE:
-                begin
-                   { need extra check here since interface is a keyword
-                     in all pascal modes }
-                   if not(m_class in current_settings.modeswitches) then
-                     Message(parser_f_need_objfpc_or_delphi_mode);
-                   classtype:=odt_dispinterface;
-                   consume(_DISPINTERFACE);
-                   { no forward declaration }
-                   if not(assigned(fd)) and (token=_SEMICOLON) then
-                     begin
-                       { also anonym objects aren't allow (o : object a : longint; end;) }
-                       if n='' then
-                         Message(parser_f_no_anonym_objects);
-                       aktobjectdef:=tobjectdef.create(classtype,n,nil);
-                       include(aktobjectdef.objectoptions,oo_is_forward);
-                       object_dec:=aktobjectdef;
-                       typecanbeforward:=storetypecanbeforward;
-                       readobjecttype:=false;
-                       exit;
-                     end;
-                end;
-              _INTERFACE:
-                begin
-                   { need extra check here since interface is a keyword
-                     in all pascal modes }
-                   if not(m_class in current_settings.modeswitches) then
-                     Message(parser_f_need_objfpc_or_delphi_mode);
-                   if current_settings.interfacetype=it_interfacecom then
-                     classtype:=odt_interfacecom
-                   else {it_interfacecorba}
-                     classtype:=odt_interfacecorba;
-                   consume(_INTERFACE);
-                   { forward declaration }
-                   if not(assigned(fd)) and (token=_SEMICOLON) then
-                     begin
-                       { also anonym objects aren't allow (o : object a : longint; end;) }
-                       if n='' then
-                         Message(parser_f_no_anonym_objects);
-                       aktobjectdef:=tobjectdef.create(classtype,n,nil);
-                       if (cs_compilesystem in current_settings.moduleswitches) and
-                          (classtype=odt_interfacecom) and (upper(n)='IUNKNOWN') then
-                         interface_iunknown:=aktobjectdef;
-                       include(aktobjectdef.objectoptions,oo_is_forward);
-                       if (cs_generate_rtti in current_settings.localswitches) and
-                          (classtype=odt_interfacecom) then
-                         include(aktobjectdef.objectoptions,oo_can_have_published);
-                       object_dec:=aktobjectdef;
-                       typecanbeforward:=storetypecanbeforward;
-                       readobjecttype:=false;
-                       exit;
-                     end;
-                end;
-              _CLASS:
-                begin
-                   classtype:=odt_class;
-                   consume(_CLASS);
-                   if not(assigned(fd)) and
-                      (token=_OF) and
-                      { Delphi only allows class of in type blocks.
-                        Note that when parsing the type of a variable declaration
-                        the blocktype is bt_type so the check for typecanbeforward
-                        is also necessary (PFV) }
-                      (((block_type=bt_type) and typecanbeforward) or
-                       not(m_delphi in current_settings.modeswitches)) then
-                     begin
-                        { a hack, but it's easy to handle
-                          class reference type }
-                        consume(_OF);
-                        single_type(hdef,typecanbeforward);
-
-                        { accept hp1, if is a forward def or a class }
-                        if (hdef.typ=forwarddef) or
-                           is_class(hdef) then
-                          begin
-                             pcrd:=tclassrefdef.create(hdef);
-                             object_dec:=pcrd;
-                          end
-                        else
-                          begin
-                             object_dec:=generrordef;
-                             Message1(type_e_class_type_expected,generrordef.typename);
-                          end;
-                        typecanbeforward:=storetypecanbeforward;
-                        readobjecttype:=false;
-                        exit;
-                     end
-                   { forward class }
-                   else if not(assigned(fd)) and (token=_SEMICOLON) then
-                     begin
-                        { also anonym objects aren't allow (o : object a : longint; end;) }
-                        if n='' then
-                          Message(parser_f_no_anonym_objects);
-                        aktobjectdef:=tobjectdef.create(odt_class,n,nil);
-                        if (cs_compilesystem in current_settings.moduleswitches) and (upper(n)='TOBJECT') then
-                          class_tobject:=aktobjectdef;
-                        aktobjectdef.objecttype:=odt_class;
-                        include(aktobjectdef.objectoptions,oo_is_forward);
-                        if (cs_generate_rtti in current_settings.localswitches) then
-                          include(aktobjectdef.objectoptions,oo_can_have_published);
-                        { all classes must have a vmt !!  at offset zero }
-                        if not(oo_has_vmt in aktobjectdef.objectoptions) then
-                          aktobjectdef.insertvmt;
-                        object_dec:=aktobjectdef;
-                        typecanbeforward:=storetypecanbeforward;
-                        readobjecttype:=false;
-                        exit;
-                     end;
-                end;
-              else
-                begin
-                   classtype:=odt_class; { this is error but try to recover }
-                   consume(_OBJECT);
-                end;
-           end;
-        end;
 
-      procedure handleImplementedInterface(intfdef : tobjectdef);
+    procedure readinterfaceiid;
+      var
+        p : tnode;
+        valid : boolean;
+      begin
+        p:=comp_expr(true);
+        if p.nodetype=stringconstn then
+          begin
+            stringdispose(current_objectdef.iidstr);
+            current_objectdef.iidstr:=stringdup(strpas(tstringconstnode(p).value_str));
+            valid:=string2guid(current_objectdef.iidstr^,current_objectdef.iidguid^);
+            if (current_objectdef.objecttype in [odt_interfacecom,odt_dispinterface]) and
+               not assigned(current_objectdef.iidguid) and
+               not valid then
+              Message(parser_e_improper_guid_syntax);
+            include(current_objectdef.objectoptions,oo_has_valid_guid);
+          end
+        else
+          Message(parser_e_illegal_expression);
+        p.free;
+      end;
 
-        begin
-            if not is_interface(intfdef) then
+
+    procedure parse_parent_classes;
+      var
+        intfchildof,
+        childof : tobjectdef;
+        hdef : tdef;
+        hasparentdefined : boolean;
+      begin
+        childof:=nil;
+        intfchildof:=nil;
+        hasparentdefined:=false;
+
+        { reads the parent class }
+        if try_to_consume(_LKLAMMER) then
+          begin
+            { use single_type instead of id_type for specialize support }
+            single_type(hdef,false);
+            if (not assigned(hdef)) or
+               (hdef.typ<>objectdef) then
               begin
-                 Message1(type_e_interface_type_expected,intfdef.typename);
-                 exit;
-              end;
-            if aktobjectdef.find_implemented_interface(intfdef)<>nil then
-              Message1(sym_e_duplicate_id,intfdef.objname^)
+                if assigned(hdef) then
+                  Message1(type_e_class_type_expected,hdef.typename);
+              end
             else
               begin
-                { allocate and prepare the GUID only if the class
-                  implements some interfaces. }
-                if aktobjectdef.ImplementedInterfaces.count = 0 then
-                  aktobjectdef.prepareguid;
-                aktobjectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
+                childof:=tobjectdef(hdef);
+                { a mix of class, interfaces, objects and cppclasses
+                  isn't allowed }
+                case current_objectdef.objecttype of
+                   odt_class:
+                     if not(is_class(childof)) then
+                       begin
+                          if is_interface(childof) then
+                            begin
+                               { we insert the interface after the child
+                                 is set, see below
+                               }
+                               intfchildof:=childof;
+                               childof:=class_tobject;
+                            end
+                          else
+                            Message(parser_e_mix_of_classes_and_objects);
+                       end;
+                   odt_interfacecorba,
+                   odt_interfacecom:
+                     begin
+                       if not(is_interface(childof)) then
+                         Message(parser_e_mix_of_classes_and_objects);
+                       current_objectdef.objecttype:=childof.objecttype;
+                       current_objectdef.objecttype:=current_objectdef.objecttype;
+                     end;
+                   odt_cppclass:
+                     if not(is_cppclass(childof)) then
+                       Message(parser_e_mix_of_classes_and_objects);
+                   odt_object:
+                     if not(is_object(childof)) then
+                       Message(parser_e_mix_of_classes_and_objects);
+                   odt_dispinterface:
+                     Message(parser_e_dispinterface_cant_have_parent);
+                end;
               end;
-        end;
+            hasparentdefined:=true;
+          end;
 
-      procedure readImplementedInterfaces;
-        var
-          hdef : tdef;
-        begin
-          while try_to_consume(_COMMA) do
-            begin
-               id_type(hdef,false);
-               if (hdef.typ<>objectdef) then
-                 begin
-                    Message1(type_e_interface_type_expected,hdef.typename);
-                    continue;
-                 end;
-               handleImplementedInterface(tobjectdef(hdef));
-            end;
-        end;
+        { no generic as parents }
+        if assigned(childof) and
+           (df_generic in childof.defoptions) then
+          begin
+            Message(parser_e_no_generics_as_types);
+            childof:=nil;
+          end;
 
-      procedure readinterfaceiid;
-        var
-          p : tnode;
-          valid : boolean;
-        begin
-          p:=comp_expr(true);
-          if p.nodetype=stringconstn then
-            begin
-              stringdispose(aktobjectdef.iidstr);
-              aktobjectdef.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
-              p.free;
-              valid:=string2guid(aktobjectdef.iidstr^,aktobjectdef.iidguid^);
-              if (classtype in [odt_interfacecom,odt_dispinterface]) and not assigned(aktobjectdef.iidguid) and not valid then
-                Message(parser_e_improper_guid_syntax);
-              include(aktobjectdef.objectoptions,oo_has_valid_guid);
-            end
-          else
-            begin
-              p.free;
-              Message(parser_e_illegal_expression);
+        { if no parent class, then a class get tobject as parent }
+        if not assigned(childof) then
+          begin
+            case current_objectdef.objecttype of
+              odt_class:
+                if current_objectdef<>class_tobject then
+                  childof:=class_tobject;
+              odt_interfacecom:
+                if current_objectdef<>interface_iunknown then
+                  childof:=interface_iunknown;
             end;
-        end;
+          end;
 
+        if assigned(childof) then
+          begin
+            { Forbid not completly defined objects to be used as parents. This will
+              also prevent circular loops of classes, because we set the forward flag
+              at the start of the new definition and will reset it below after the
+              parent has been set }
+            if not(oo_is_forward in childof.objectoptions) then
+              current_objectdef.set_parent(childof)
+            else
+              Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
+          end;
 
-      procedure readparentclasses;
-        var
-           intfchildof,
-           childof : tobjectdef;
-           hdef : tdef;
-           hasparentdefined : boolean;
-        begin
-          childof:=nil;
-          intfchildof:=nil;
-          hasparentdefined:=false;
+        { remove forward flag, is resolved }
+        exclude(current_objectdef.objectoptions,oo_is_forward);
 
-          { reads the parent class }
-          if try_to_consume(_LKLAMMER) then
-            begin
-              { use single_type instead of id_type for specialize support }
-              single_type(hdef,false);
-              if (not assigned(hdef)) or
-                 (hdef.typ<>objectdef) then
-                begin
-                  if assigned(hdef) then
-                    Message1(type_e_class_type_expected,hdef.typename);
-                end
-              else
-                begin
-                  childof:=tobjectdef(hdef);
-                  { a mix of class, interfaces, objects and cppclasses
-                    isn't allowed }
-                  case classtype of
-                     odt_class:
-                       if not(is_class(childof)) then
-                         begin
-                            if is_interface(childof) then
-                              begin
-                                 { we insert the interface after the child
-                                   is set, see below
-                                 }
-                                 intfchildof:=childof;
-                                 childof:=class_tobject;
-                              end
-                            else
-                              Message(parser_e_mix_of_classes_and_objects);
-                         end;
-                     odt_interfacecorba,
-                     odt_interfacecom:
-                       begin
-                         if not(is_interface(childof)) then
-                           Message(parser_e_mix_of_classes_and_objects);
-                         classtype:=childof.objecttype;
-                         aktobjectdef.objecttype:=classtype;
-                       end;
-                     odt_cppclass:
-                       if not(is_cppclass(childof)) then
-                         Message(parser_e_mix_of_classes_and_objects);
-                     odt_object:
-                       if not(is_object(childof)) then
-                         Message(parser_e_mix_of_classes_and_objects);
-                     odt_dispinterface:
-                       Message(parser_e_dispinterface_cant_have_parent);
-                  end;
-                end;
-              hasparentdefined:=true;
-            end;
+        if hasparentdefined then
+          begin
+            if current_objectdef.objecttype=odt_class then
+              begin
+                if assigned(intfchildof) then
+                  handleImplementedInterface(intfchildof);
+                readImplementedInterfaces;
+              end;
+            consume(_RKLAMMER);
+          end;
+      end;
 
-          { no generic as parents }
-          if assigned(childof) and
-             (df_generic in childof.defoptions) then
-            begin
-              Message(parser_e_no_generics_as_types);
-              childof:=nil;
-            end;
 
-          { if no parent class, then a class get tobject as parent }
-          if not assigned(childof) then
-            begin
-              case classtype of
-                odt_class:
-                  if aktobjectdef<>class_tobject then
-                    childof:=class_tobject;
-                odt_interfacecom:
-                  if aktobjectdef<>interface_iunknown then
-                    childof:=interface_iunknown;
-              end;
-            end;
+    procedure parse_guid;
+      begin
+        { read GUID }
+        if (current_objectdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) and
+           try_to_consume(_LECKKLAMMER) then
+          begin
+            readinterfaceiid;
+            consume(_RECKKLAMMER);
+          end
+        else if (current_objectdef.objecttype=odt_dispinterface) then
+          message(parser_e_dispinterface_needs_a_guid);
+      end;
 
-          if assigned(childof) then
-            begin
-              { Forbid not completly defined objects to be used as parents. This will
-                also prevent circular loops of classes, because we set the forward flag
-                at the start of the new definition and will reset it below after the
-                parent has been set }
-              if not(oo_is_forward in childof.objectoptions) then
-                aktobjectdef.set_parent(childof)
-              else
-                Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
-            end;
 
-          { remove forward flag, is resolved }
-          exclude(aktobjectdef.objectoptions,oo_is_forward);
+    procedure insert_generic_parameter_types(genericdef:tstoreddef;genericlist:TFPObjectList);
+      var
+        i : longint;
+        generictype : ttypesym;
+      begin
+        current_objectdef.genericdef:=genericdef;
+        if not assigned(genericlist) then
+          exit;
+        for i:=0 to genericlist.count-1 do
+          begin
+            generictype:=ttypesym(genericlist[i]);
+            if generictype.typedef.typ=undefineddef then
+              include(current_objectdef.defoptions,df_generic)
+            else
+              include(current_objectdef.defoptions,df_specialization);
+            symtablestack.top.insert(generictype);
+          end;
+       end;
 
-          if hasparentdefined then
-            begin
-              if aktobjectdef.objecttype=odt_class then
-                begin
-                  if assigned(intfchildof) then
-                    handleImplementedInterface(intfchildof);
-                  readImplementedInterfaces;
-                end;
-              consume(_RKLAMMER);
-            end;
 
-          { read GUID }
-          if (classtype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) and
-             try_to_consume(_LECKKLAMMER) then
-            begin
-              readinterfaceiid;
-              consume(_RECKKLAMMER);
-            end
-          else if (classtype=odt_dispinterface) then
-            message(parser_e_dispinterface_needs_a_guid);
-        end;
+    procedure parse_object_members;
 
         procedure chkcpp(pd:tprocdef);
         begin
@@ -508,341 +372,366 @@ implementation
             end;
         end;
 
+        procedure maybe_parse_hint_directives(pd:tprocdef);
+        var
+          dummysymoptions : tsymoptions;
+        begin
+          dummysymoptions:=[];
+          while try_consume_hintdirective(dummysymoptions) do
+            Consume(_SEMICOLON);
+          if assigned(pd) then
+            pd.symoptions:=pd.symoptions+dummysymoptions;
+        end;
+
       var
         pd : tprocdef;
-        dummysymoptions : tsymoptions;
-        i : longint;
-        generictype : ttypesym;
-        current_blocktype : tblock_type;
-        oldaktobjectdef : tobjectdef;
+        has_destructor,
+        oldparse_only,
         old_parse_generic : boolean;
+        object_member_blocktype : tblock_type;
       begin
-         old_object_option:=current_object_option;
-         oldaktobjectdef:=aktobjectdef;
-         old_parse_generic:=parse_generic;
-
-         { objects and class types can't be declared local }
-         if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable]) and
-            not assigned(genericlist) then
-           Message(parser_e_no_local_objects);
-
-         storetypecanbeforward:=typecanbeforward;
-         { for tp7 don't allow forward types }
-         if (m_tp7 in current_settings.modeswitches) then
-           typecanbeforward:=false;
-
-         if not(readobjecttype) then
-           exit;
-
-         if assigned(fd) then
-           aktobjectdef:=fd
-         else
-           begin
-             { anonym objects aren't allow (o : object a : longint; end;) }
-             if n='' then
-               Message(parser_f_no_anonym_objects);
-             aktobjectdef:=tobjectdef.create(classtype,n,nil);
-             { include forward flag, it'll be removed after the parent class have been
-               added. This is to prevent circular childof loops }
-             include(aktobjectdef.objectoptions,oo_is_forward);
-           end;
-
-         { read list of parent classes }
-         readparentclasses;
-
-         { default access is public }
-         there_is_a_destructor:=false;
-         current_object_option:=[sp_public];
-
-         { set class flags and inherits published }
-         setclassattributes;
-
-         symtablestack.push(aktobjectdef.symtable);
-         testcurobject:=1;
-
-         { add generic type parameters }
-         aktobjectdef.genericdef:=genericdef;
-         if assigned(genericlist) then
-           begin
-             for i:=0 to genericlist.count-1 do
-               begin
-                 generictype:=ttypesym(genericlist[i]);
-                 if generictype.typedef.typ=undefineddef then
-                   begin
-                     include(aktobjectdef.defoptions,df_generic);
-                     parse_generic:=true;
-                   end
-                 else
-                   include(aktobjectdef.defoptions,df_specialization);
-                 symtablestack.top.insert(generictype);
-               end;
-           end;
-
-         { short class declaration ? }
-         if (classtype<>odt_class) or (token<>_SEMICOLON) then
-          begin
-            { Parse componenten }
-            current_blocktype:=bt_general;
-            repeat
-              case token of
-                _TYPE :
-                  begin
-                    if ([df_generic,df_specialization]*aktobjectdef.defoptions)=[] then
-                      Message(parser_e_type_and_var_only_in_generics);
-                     consume(_TYPE);
-                     current_blocktype:=bt_type;
-                  end;
-                _VAR :
-                  begin
-                    if ([df_generic,df_specialization]*aktobjectdef.defoptions)=[] then
-                      Message(parser_e_type_and_var_only_in_generics);
-                    consume(_VAR);
-                    current_blocktype:=bt_general;
-                  end;
-                _ID :
-                  begin
-                    case idtoken of
-                      _PRIVATE :
-                        begin
-                          if is_interface(aktobjectdef) then
-                             Message(parser_e_no_access_specifier_in_interfaces);
-                           consume(_PRIVATE);
-                           current_object_option:=[sp_private];
-                           include(aktobjectdef.objectoptions,oo_has_private);
-                         end;
-                       _PROTECTED :
-                         begin
-                           if is_interface(aktobjectdef) then
-                             Message(parser_e_no_access_specifier_in_interfaces);
-                           consume(_PROTECTED);
-                           current_object_option:=[sp_protected];
-                           include(aktobjectdef.objectoptions,oo_has_protected);
-                         end;
-                       _PUBLIC :
-                         begin
-                           if is_interface(aktobjectdef) then
-                             Message(parser_e_no_access_specifier_in_interfaces);
-                           consume(_PUBLIC);
-                           current_object_option:=[sp_public];
-                         end;
-                       _PUBLISHED :
-                         begin
-                           { we've to check for a pushlished section in non-  }
-                           { publishable classes later, if a real declaration }
-                           { this is the way, delphi does it                  }
-                           if is_interface(aktobjectdef) then
-                             Message(parser_e_no_access_specifier_in_interfaces);
-                           consume(_PUBLISHED);
-                           current_object_option:=[sp_published];
-                         end;
-                       _STRICT :
-                         begin
-                           if is_interface(aktobjectdef) then
-                              Message(parser_e_no_access_specifier_in_interfaces);
-                            consume(_STRICT);
-                            if token=_ID then
-                              begin
-                                case idtoken of
-                                  _PRIVATE:
-                                    begin
-                                      consume(_PRIVATE);
-                                      current_object_option:=[sp_strictprivate];
-                                      include(aktobjectdef.objectoptions,oo_has_strictprivate);
-                                    end;
-                                  _PROTECTED:
-                                    begin
-                                      consume(_PROTECTED);
-                                      current_object_option:=[sp_strictprotected];
-                                      include(aktobjectdef.objectoptions,oo_has_strictprotected);
-                                    end;
-                                  else
-                                    message(parser_e_protected_or_private_expected);
+        { empty class declaration ? }
+        if (current_objectdef.objecttype=odt_class) and
+           (token=_SEMICOLON) then
+          exit;
+
+        old_parse_generic:=parse_generic;
+
+        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_objectdef.symtable.currentvisibility:=vis_published
+        else
+          current_objectdef.symtable.currentvisibility:=vis_public;
+        testcurobject:=1;
+        has_destructor:=false;
+        object_member_blocktype:=bt_general;
+        repeat
+          case token of
+            _TYPE :
+              begin
+                if ([df_generic,df_specialization]*current_objectdef.defoptions)=[] then
+                  Message(parser_e_type_and_var_only_in_generics);
+                 consume(_TYPE);
+                 object_member_blocktype:=bt_type;
+              end;
+            _VAR :
+              begin
+                if ([df_generic,df_specialization]*current_objectdef.defoptions)=[] then
+                  Message(parser_e_type_and_var_only_in_generics);
+                consume(_VAR);
+                object_member_blocktype:=bt_general;
+              end;
+            _ID :
+              begin
+                case idtoken of
+                  _PRIVATE :
+                    begin
+                      if is_interface(current_objectdef) then
+                         Message(parser_e_no_access_specifier_in_interfaces);
+                       consume(_PRIVATE);
+                       current_objectdef.symtable.currentvisibility:=vis_private;
+                       include(current_objectdef.objectoptions,oo_has_private);
+                     end;
+                   _PROTECTED :
+                     begin
+                       if is_interface(current_objectdef) then
+                         Message(parser_e_no_access_specifier_in_interfaces);
+                       consume(_PROTECTED);
+                       current_objectdef.symtable.currentvisibility:=vis_protected;
+                       include(current_objectdef.objectoptions,oo_has_protected);
+                     end;
+                   _PUBLIC :
+                     begin
+                       if is_interface(current_objectdef) then
+                         Message(parser_e_no_access_specifier_in_interfaces);
+                       consume(_PUBLIC);
+                       current_objectdef.symtable.currentvisibility:=vis_public;
+                     end;
+                   _PUBLISHED :
+                     begin
+                       { we've to check for a pushlished section in non-  }
+                       { publishable classes later, if a real declaration }
+                       { this is the way, delphi does it                  }
+                       if is_interface(current_objectdef) then
+                         Message(parser_e_no_access_specifier_in_interfaces);
+                       consume(_PUBLISHED);
+                       current_objectdef.symtable.currentvisibility:=vis_published;
+                     end;
+                   _STRICT :
+                     begin
+                       if is_interface(current_objectdef) then
+                          Message(parser_e_no_access_specifier_in_interfaces);
+                        consume(_STRICT);
+                        if token=_ID then
+                          begin
+                            case idtoken of
+                              _PRIVATE:
+                                begin
+                                  consume(_PRIVATE);
+                                  current_objectdef.symtable.currentvisibility:=vis_strictprivate;
+                                  include(current_objectdef.objectoptions,oo_has_strictprivate);
                                 end;
-                              end
-                            else
-                              message(parser_e_protected_or_private_expected);
-                          end;
+                              _PROTECTED:
+                                begin
+                                  consume(_PROTECTED);
+                                  current_objectdef.symtable.currentvisibility:=vis_strictprotected;
+                                  include(current_objectdef.objectoptions,oo_has_strictprotected);
+                                end;
+                              else
+                                message(parser_e_protected_or_private_expected);
+                            end;
+                          end
                         else
+                          message(parser_e_protected_or_private_expected);
+                      end;
+                    else
+                      begin
+                        if object_member_blocktype=bt_general then
                           begin
-                            if current_blocktype=bt_general then
-                              begin
-                                if is_interface(aktobjectdef) then
-                                  Message(parser_e_no_vars_in_interfaces);
-
-                                if (sp_published in current_object_option) and
-                                  not(oo_can_have_published in aktobjectdef.objectoptions) then
-                                  Message(parser_e_cant_have_published);
-
-                                read_record_fields([vd_object])
-                              end
-                            else
-                              types_dec;
-                          end;
-                    end;
-                  end;
-                _PROPERTY :
+                            if is_interface(current_objectdef) then
+                              Message(parser_e_no_vars_in_interfaces);
+
+                            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])
+                          end
+                        else
+                          types_dec;
+                      end;
+                end;
+              end;
+            _PROPERTY :
+              begin
+                property_dec;
+              end;
+            _PROCEDURE,
+            _FUNCTION,
+            _CLASS :
+              begin
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
+                   not(oo_can_have_published in current_objectdef.objectoptions) then
+                  Message(parser_e_cant_have_published);
+
+                oldparse_only:=parse_only;
+                parse_only:=true;
+                pd:=parse_proc_dec(current_objectdef);
+
+                { this is for error recovery as well as forward }
+                { interface mappings, i.e. mapping to a method  }
+                { which isn't declared yet                      }
+                if assigned(pd) then
                   begin
-                    property_dec;
+                    parse_object_proc_directives(pd);
+
+                    { all Macintosh Object Pascal methods are virtual.  }
+                    { this can't be a class method, because macpas mode }
+                    { has no m_class                                    }
+                    if (m_mac in current_settings.modeswitches) then
+                      include(pd.procoptions,po_virtualmethod);
+
+                    handle_calling_convention(pd);
+
+                    { add definition to procsym }
+                    proc_add_definition(pd);
+
+                    { add procdef options to objectdef options }
+                    if (po_msgint in pd.procoptions) then
+                      include(current_objectdef.objectoptions,oo_has_msgint);
+                    if (po_msgstr in pd.procoptions) then
+                      include(current_objectdef.objectoptions,oo_has_msgstr);
+                    if (po_virtualmethod in pd.procoptions) then
+                      include(current_objectdef.objectoptions,oo_has_virtual);
+
+                    chkcpp(pd);
                   end;
-                _PROCEDURE,
-                _FUNCTION,
-                _CLASS :
-                  begin
-                    if (sp_published in current_object_option) and
-                       not(oo_can_have_published in aktobjectdef.objectoptions) then
-                      Message(parser_e_cant_have_published);
-
-                    oldparse_only:=parse_only;
-                    parse_only:=true;
-                    pd:=parse_proc_dec(aktobjectdef);
-
-                    { this is for error recovery as well as forward }
-                    { interface mappings, i.e. mapping to a method  }
-                    { which isn't declared yet                      }
-                    if assigned(pd) then
-                     begin
-                       parse_object_proc_directives(pd);
 
-                       { all Macintosh Object Pascal methods are virtual.  }
-                       { this can't be a class method, because macpas mode }
-                       { has no m_class                                    }
-                       if (m_mac in current_settings.modeswitches) then
-                         include(pd.procoptions,po_virtualmethod);
+                maybe_parse_hint_directives(pd);
 
-                       handle_calling_convention(pd);
+                parse_only:=oldparse_only;
+              end;
+            _CONSTRUCTOR :
+              begin
+                if (current_objectdef.symtable.currentvisibility=vis_published) and
+                  not(oo_can_have_published in current_objectdef.objectoptions) then
+                  Message(parser_e_cant_have_published);
 
-                       { add definition to procsym }
-                       proc_add_definition(pd);
+                if not(current_objectdef.symtable.currentvisibility in [vis_public,vis_published]) then
+                  Message(parser_w_constructor_should_be_public);
 
-                       { add procdef options to objectdef options }
-                       if (po_msgint in pd.procoptions) then
-                        include(aktobjectdef.objectoptions,oo_has_msgint);
-                       if (po_msgstr in pd.procoptions) then
-                         include(aktobjectdef.objectoptions,oo_has_msgstr);
-                       if (po_virtualmethod in pd.procoptions) then
-                         include(aktobjectdef.objectoptions,oo_has_virtual);
+                if is_interface(current_objectdef) then
+                  Message(parser_e_no_con_des_in_interfaces);
 
-                       chkcpp(pd);
-                     end;
+                oldparse_only:=parse_only;
+                parse_only:=true;
+                pd:=constructor_head;
+                parse_object_proc_directives(pd);
+                handle_calling_convention(pd);
 
-                    { Support hint directives }
-                    dummysymoptions:=[];
-                    while try_consume_hintdirective(dummysymoptions) do
-                      Consume(_SEMICOLON);
-                    if assigned(pd) then
-                      pd.symoptions:=pd.symoptions+dummysymoptions;
+                { add definition to procsym }
+                proc_add_definition(pd);
 
-                    parse_only:=oldparse_only;
-                  end;
-                _CONSTRUCTOR :
-                  begin
-                    if (sp_published in current_object_option) and
-                      not(oo_can_have_published in aktobjectdef.objectoptions) then
-                      Message(parser_e_cant_have_published);
+                { add procdef options to objectdef options }
+                if (po_virtualmethod in pd.procoptions) then
+                  include(current_objectdef.objectoptions,oo_has_virtual);
+                chkcpp(pd);
+                maybe_parse_hint_directives(pd);
 
-                    if not(sp_public in current_object_option) and
-                       not(sp_published in current_object_option) then
-                      Message(parser_w_constructor_should_be_public);
+                parse_only:=oldparse_only;
+              end;
+            _DESTRUCTOR :
+              begin
+                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 is_interface(aktobjectdef) then
-                      Message(parser_e_no_con_des_in_interfaces);
+                if has_destructor then
+                  Message(parser_n_only_one_destructor);
+                has_destructor:=true;
 
-                    oldparse_only:=parse_only;
-                    parse_only:=true;
-                    pd:=constructor_head;
-                    parse_object_proc_directives(pd);
-                    handle_calling_convention(pd);
+                if is_interface(current_objectdef) then
+                  Message(parser_e_no_con_des_in_interfaces);
 
-                    { add definition to procsym }
-                    proc_add_definition(pd);
+                if (current_objectdef.symtable.currentvisibility<>vis_public) then
+                  Message(parser_w_destructor_should_be_public);
 
-                    { add procdef options to objectdef options }
-                    if (po_virtualmethod in pd.procoptions) then
-                      include(aktobjectdef.objectoptions,oo_has_virtual);
-                    chkcpp(pd);
+                oldparse_only:=parse_only;
+                parse_only:=true;
+                pd:=destructor_head;
+                parse_object_proc_directives(pd);
+                handle_calling_convention(pd);
 
-                    { Support hint directives }
-                    dummysymoptions:=[];
-                    while try_consume_hintdirective(dummysymoptions) do
-                      Consume(_SEMICOLON);
-                    if assigned(pd) then
-                      pd.symoptions:=pd.symoptions+dummysymoptions;
+                { add definition to procsym }
+                proc_add_definition(pd);
 
-                    parse_only:=oldparse_only;
-                  end;
-                _DESTRUCTOR :
-                  begin
-                    if (sp_published in current_object_option) and
-                      not(oo_can_have_published in aktobjectdef.objectoptions) then
-                      Message(parser_e_cant_have_published);
+                { add procdef options to objectdef options }
+                if (po_virtualmethod in pd.procoptions) then
+                  include(current_objectdef.objectoptions,oo_has_virtual);
+
+                chkcpp(pd);
+                maybe_parse_hint_directives(pd);
+
+                parse_only:=oldparse_only;
+              end;
+            _END :
+              begin
+                consume(_END);
+                break;
+              end;
+            else
+              consume(_ID); { Give a ident expected message, like tp7 }
+          end;
+        until false;
 
-                    if there_is_a_destructor then
-                      Message(parser_n_only_one_destructor);
+        { restore }
+        testcurobject:=0;
+        parse_generic:=old_parse_generic;
+      end;
 
-                    if is_interface(aktobjectdef) then
-                      Message(parser_e_no_con_des_in_interfaces);
 
-                    if not(sp_public in current_object_option) then
-                      Message(parser_w_destructor_should_be_public);
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
+      var
+        old_current_objectdef : tobjectdef;
+      begin
+        old_current_objectdef:=current_objectdef;
 
-                    there_is_a_destructor:=true;
-                    oldparse_only:=parse_only;
-                    parse_only:=true;
-                    pd:=destructor_head;
-                    parse_object_proc_directives(pd);
-                    handle_calling_convention(pd);
+        current_objectdef:=nil;
 
-                    { add definition to procsym }
-                    proc_add_definition(pd);
+        { objects and class types can't be declared local }
+        if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable]) and
+           not assigned(genericlist) then
+          Message(parser_e_no_local_objects);
 
-                    { add procdef options to objectdef options }
-                    if (po_virtualmethod in pd.procoptions) then
-                      include(aktobjectdef.objectoptions,oo_has_virtual);
+        { reuse forward objectdef? }
+        if assigned(fd) then
+          begin
+            if fd.objecttype<>objecttype then
+              begin
+                Message(parser_e_forward_mismatch);
+                { recover }
+                current_objectdef:=tobjectdef.create(current_objectdef.objecttype,n,nil);
+                include(current_objectdef.objectoptions,oo_is_forward);
+              end
+            else
+              current_objectdef:=fd
+          end
+        else
+          begin
+            { anonym objects aren't allow (o : object a : longint; end;) }
+            if n='' then
+              Message(parser_f_no_anonym_objects);
 
-                    chkcpp(pd);
+            { create new class }
+            current_objectdef:=tobjectdef.create(objecttype,n,nil);
 
-                    { Support hint directives }
-                    dummysymoptions:=[];
-                    while try_consume_hintdirective(dummysymoptions) do
-                      Consume(_SEMICOLON);
-                    if assigned(pd) then
-                      pd.symoptions:=pd.symoptions+dummysymoptions;
+            { include always the forward flag, it'll be removed after the parent class have been
+              added. This is to prevent circular childof loops }
+            include(current_objectdef.objectoptions,oo_is_forward);
 
-                    parse_only:=oldparse_only;
-                  end;
-                _END :
-                  begin
-                    consume(_END);
-                    break;
-                  end;
-                else
-                  consume(_ID); { Give a ident expected message, like tp7 }
+            if (cs_compilesystem in current_settings.moduleswitches) then
+              begin
+                case current_objectdef.objecttype of
+                  odt_interfacecom :
+                    if (current_objectdef.objname^='IUNKNOWN') then
+                      interface_iunknown:=current_objectdef;
+                  odt_class :
+                    if (current_objectdef.objname^='TOBJECT') then
+                      class_tobject:=current_objectdef;
+                end;
               end;
-            until false;
           end;
 
-         { generate vmt space if needed }
-         if not(oo_has_vmt in aktobjectdef.objectoptions) and
-            (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktobjectdef.objectoptions<>[]) or
-             (classtype in [odt_class])
-            ) then
-           aktobjectdef.insertvmt;
+        { set published flag in $M+ mode, it can also be inherited and will
+          be added when the parent class set with tobjectdef.set_parent (PFV) }
+        if (cs_generate_rtti in current_settings.localswitches) and
+           (current_objectdef.objecttype in [odt_interfacecom,odt_class]) then
+          include(current_objectdef.objectoptions,oo_can_have_published);
+
+        { forward def? }
+        if not assigned(fd) and
+           (token=_SEMICOLON) then
+          begin
+            { add to the list of definitions to check that the forward
+              is resolved. this is required for delphi mode }
+            current_module.checkforwarddefs.add(current_objectdef);
+          end
+        else
+          begin
+            { parse list of parent classes }
+            parse_parent_classes;
+
+            { parse optional GUID for interfaces }
+            parse_guid;
+
+            { parse and insert object members }
+            symtablestack.push(current_objectdef.symtable);
+            insert_generic_parameter_types(genericdef,genericlist);
+            parse_object_members;
+            symtablestack.pop(current_objectdef.symtable);
+          end;
+
+        { generate vmt space if needed }
+        if not(oo_has_vmt in current_objectdef.objectoptions) and
+           (
+            ([oo_has_virtual,oo_has_constructor,oo_has_destructor]*current_objectdef.objectoptions<>[]) or
+            (current_objectdef.objecttype in [odt_class])
+           ) then
+          current_objectdef.insertvmt;
 
-         if is_interface(aktobjectdef) then
-           setinterfacemethodoptions;
+        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^);
 
-         { remove symtable from stack }
-         symtablestack.pop(aktobjectdef.symtable);
+        if is_interface(current_objectdef) then
+          setinterfacemethodoptions;
 
-         { return defined objectdef }
-         result:=aktobjectdef;
+        { return defined objectdef }
+        result:=current_objectdef;
 
-         { restore old state }
-         aktobjectdef:=oldaktobjectdef;
-         testcurobject:=0;
-         typecanbeforward:=storetypecanbeforward;
-         parse_generic:=old_parse_generic;
-         current_object_option:=old_object_option;
+        { restore old state }
+        current_objectdef:=old_current_objectdef;
       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,10 +399,8 @@ implementation
         sc:=TFPObjectList.create(false);
         defaultrequired:=false;
         paranr:=0;
-        { the variables are always public }
-        current_object_option:=[sp_public];
         inc(testcurobject);
-        block_type:=bt_type;
+        block_type:=bt_var;
         repeat
           parseprocvar:=pv_none;
           if try_to_consume(_VAR) then
@@ -467,8 +458,10 @@ implementation
                parse_parameter_dec(pv);
              if parseprocvar=pv_func then
               begin
+                block_type:=bt_var_type;
                 consume(_COLON);
                 single_type(pv.returndef,false);
+                block_type:=bt_var;
               end;
              hdef:=pv;
              { possible proc directives }
@@ -517,7 +510,11 @@ implementation
                 if try_to_consume(_TYPE) then
                   hdef:=ctypedformaltype
                 else
-                  single_type(hdef,false);
+                  begin
+                    block_type:=bt_var_type;
+                    single_type(hdef,false);
+                    block_type:=bt_var;
+                  end;
 
                 { open string ? }
                 if (varspez in [vs_out,vs_var]) and
@@ -612,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;
@@ -867,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
@@ -1064,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
@@ -1609,6 +1607,15 @@ begin
 end;
 
 
+procedure pd_weakexternal(pd:tabstractprocdef);
+begin
+  if not(target_info.system in system_weak_linking) then
+    message(parser_e_weak_external_not_supported)
+  else
+    pd_external(pd);
+end;
+
+
 type
    pd_handler=procedure(pd:tabstractprocdef);
    proc_dir_rec=record
@@ -1623,7 +1630,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=39;
+  num_proc_directives=40;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -1985,6 +1992,19 @@ const
       mutexclpocall : [];
       mutexclpotype : [potype_constructor,potype_destructor];
       mutexclpo     : [po_interrupt]
+    ),(
+      idtok:_WEAKEXTERNAL;
+      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject];
+      handler  : @pd_weakexternal;
+      pocall   : pocall_none;
+      { mark it both external and weak external, so we don't have to
+        adapt all code for external symbols to also check for weak external
+      }
+      pooption : [po_external,po_weakexternal];
+      mutexclpocall : [pocall_internproc,pocall_syscall];
+      { allowed for external cpp classes }
+      mutexclpotype : [{potype_constructor,potype_destructor}];
+      mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
     )
    );
 
@@ -2247,9 +2267,9 @@ const
                     if s<>'' then
                       begin
                         { Replace ? and @ in import name }
-                        { these replaces broke existing code on i386-win32 at least, while fixed 
+                        { these replaces broke existing code on i386-win32 at least, while fixed
                           bug 8391 on arm-wince so limit this to arm-wince (KB) }
-                        if target_info.system in [system_arm_wince] then 
+                        if target_info.system in [system_arm_wince] then
                           begin
                             Replace(s,'?','__q$$');
                             Replace(s,'@','__a$$');
@@ -2415,7 +2435,7 @@ const
              because a constant/default value follows }
            if res then
             begin
-              if (block_type in [bt_const,bt_type]) and
+              if (block_type=bt_const_type) and
                  (token=_EQUAL) then
                break;
               { support procedure proc;stdcall export; }

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
@@ -770,6 +776,7 @@ implementation
       is_dll,
       is_cdecl,
       is_external_var,
+      is_weak_external,
       is_public_var  : boolean;
       dll_name,
       C_name      : string;
@@ -811,7 +818,9 @@ implementation
         end;
 
       { external }
-      if try_to_consume(_EXTERNAL) then
+      is_weak_external:=try_to_consume(_WEAKEXTERNAL);
+      if is_weak_external or
+         try_to_consume(_EXTERNAL) then
         begin
           is_external_var:=true;
           if not is_cdecl then
@@ -870,6 +879,12 @@ implementation
           if vo_is_typed_const in vs.varoptions then
             Message(parser_e_initialized_not_for_external);
           include(vs.varoptions,vo_is_external);
+          if (is_weak_external) then
+            begin
+              if not(target_info.system in system_weak_linking) then
+                message(parser_e_weak_external_not_supported);
+              include(vs.varoptions,vo_is_weak_external);
+            end;
           vs.varregable := vr_none;
           if is_dll then
             current_module.AddExternalImport(dll_name,C_Name,0,true,false)
@@ -1048,15 +1063,11 @@ 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_type;
+         block_type:=bt_var;
          { Force an expected ID error message }
          if not (token in [_ID,_CASE,_END]) then
            consume(_ID);
@@ -1089,6 +1100,9 @@ implementation
                  end;
                consume(_ID);
              until not try_to_consume(_COMMA);
+
+             { read variable type def }
+             block_type:=bt_var_type;
              consume(_COLON);
 
 {$ifdef gpc_mode}
@@ -1098,13 +1112,13 @@ implementation
                read_gpc_name(sc);
 {$endif}
 
-             { read variable type def }
              read_anon_type(hdef,false);
              for i:=0 to sc.count-1 do
                begin
                  vs:=tabstractvarsym(sc[i]);
                  vs.vardef:=hdef;
                end;
+             block_type:=bt_var;
 
              { Process procvar directives }
              if maybe_parse_proc_directives(hdef) then
@@ -1118,7 +1132,7 @@ implementation
                end;
 
              { Check for EXTERNAL etc directives before a semicolon }
-             if (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
+             if (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) then
                begin
                  read_public_and_external_sc(sc);
                  allowdefaultvalue:=false;
@@ -1175,7 +1189,7 @@ implementation
              { Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set}
              if (
                  (
-                  (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) and
+                  (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
                   (m_cvar_support in current_settings.modeswitches)
                  ) or
                  (
@@ -1199,7 +1213,6 @@ implementation
                end;
            end;
          block_type:=old_block_type;
-         current_object_option:=old_current_object_option;
          { free the list }
          sc.free;
       end;
@@ -1209,8 +1222,6 @@ implementation
       var
          sc : TFPObjectList;
          i  : longint;
-         old_block_type : tblock_type;
-         old_current_object_option : tsymoptions;
          hs,sorg : string;
          hdef,casetype : tdef;
          { maxsize contains the max. size of a variant }
@@ -1225,6 +1236,7 @@ implementation
          vs    : tabstractvarsym;
          srsym : tsym;
          srsymtable : TSymtable;
+         visibility : tvisibility;
          recst : tabstractrecordsymtable;
          unionsymtable : trecordsymtable;
          offset : longint;
@@ -1240,12 +1252,6 @@ implementation
 {$if defined(powerpc) or defined(powerpc64)}
          is_first_field := 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];
-         old_block_type:=block_type;
-         block_type:=bt_type;
          { Force an expected ID error message }
          if not (token in [_ID,_CASE,_END]) then
           consume(_ID);
@@ -1255,6 +1261,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
@@ -1361,26 +1368,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 }
@@ -1388,13 +1388,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 }
@@ -1420,7 +1416,7 @@ implementation
               if assigned(fieldvs) then
                 begin
                   fieldvs.vardef:=casetype;
-                  recst.addfield(fieldvs);
+                  recst.addfield(fieldvs,recst.currentvisibility);
                 end;
               if not(is_ordinal(casetype))
 {$ifndef cpu64bitaddr}
@@ -1510,8 +1506,6 @@ implementation
               trecordsymtable(recst).insertunionst(Unionsymtable,offset);
               uniondef.owner.deletedef(uniondef);
            end;
-         block_type:=old_block_type;
-         current_object_option:=old_current_object_option;
          { free the list }
          sc.free;
 {$ifdef powerpc}

compiler/pexports.pas

@@ -204,7 +204,8 @@ implementation
                         exportprocsym(srsym,hpname,index,options);
                       end
                   end
-                else
+                { can also be errorsym }
+                else if (srsym.typ=staticvarsym) then
                   begin
                     if ((options and eo_name)=0) then
                       { for "cvar" }

compiler/pexpr.pas

@@ -1399,8 +1399,7 @@ implementation
                        if (hdef=cvarianttype) and
                           not(cs_compilesystem in current_settings.moduleswitches) then
                          current_module.flags:=current_module.flags or uf_uses_variants;
-                       if (block_type<>bt_specialize) and
-                          try_to_consume(_LKLAMMER) then
+                       if try_to_consume(_LKLAMMER) then
                         begin
                           p1:=comp_expr(true);
                           consume(_RKLAMMER);
@@ -1411,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);
@@ -1486,7 +1484,7 @@ implementation
                                 { For a type block we simply return only
                                   the type. For all other blocks we return
                                   a loadvmt node }
-                                if not(block_type in [bt_type,bt_specialize]) then
+                                if not(block_type in [bt_type,bt_const_type,bt_var_type]) then
                                   p1:=cloadvmtaddrnode.create(p1);
                               end;
                            end
@@ -2160,9 +2158,8 @@ implementation
            again:=true;
            { Handle references to self }
            if (idtoken=_SELF) and
-              not(block_type in [bt_const,bt_type]) and
-              assigned(current_procinfo) and
-              assigned(current_procinfo.procdef._class) then
+              not(block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) and
+              assigned(current_objectdef) then
              begin
                p1:=load_self_node;
                consume(_ID);
@@ -2199,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
@@ -2219,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
@@ -2227,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

@@ -1158,15 +1158,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;
@@ -1244,10 +1241,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);
 
@@ -1719,7 +1713,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;
@@ -2090,7 +2083,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/powerpc/cgcpu.pas

@@ -45,7 +45,7 @@ unit cgcpu;
         procedure a_param_ref(list : TAsmList;size : tcgsize;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_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
@@ -248,19 +248,23 @@ const
 
 
     { calling a procedure by name }
-    procedure tcgppc.a_call_name(list : TAsmList;const s : string);
+    procedure tcgppc.a_call_name(list : TAsmList;const s : string; weak: boolean);
       begin
          { MacOS: The linker on MacOS (PPCLink) inserts a call to glue code,
            if it is a cross-TOC call. If so, it also replaces the NOP
            with some restore code.}
          if (target_info.system <> system_powerpc_darwin) then
            begin
+             if not(weak) then
+               list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)))
+             else
+               list.concat(taicpu.op_sym(A_BL,current_asmdata.WeakRefAsmSymbol(s)));
              list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)));
              if target_info.system=system_powerpc_macos then
                list.concat(taicpu.op_none(A_NOP));
            end
          else
-           list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s)));
+           list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
 {
        the compiler does not properly set this flag anymore in pass 1, and
        for now we only need it after pass 2 (I hope) (JM)
@@ -782,7 +786,7 @@ const
         p : taicpu;
       begin
          if (target_info.system = system_powerpc_darwin) then
-           p := taicpu.op_sym(A_B,get_darwin_call_stub(s))
+           p := taicpu.op_sym(A_B,get_darwin_call_stub(s,false))
         else
           p := taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s));
         p.is_jmp := true;

compiler/powerpc/nppcadd.pas

@@ -952,7 +952,7 @@ interface
                       { g_overflowcheck generates a OC_AE instead of OC_EQ :/ }
                       current_asmdata.getjumplabel(hl);
                       tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,OC_EQ,hl);
-                      cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
+                      cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
                       cg.a_label(current_asmdata.CurrAsmList,hl);
                     end;
                 end;

compiler/powerpc/nppccnv.pas

@@ -144,7 +144,7 @@ implementation
         { stw R3,disp+4(R1)   # store lower half            }
         { lfd FR1,disp(R1)    # float load double of value  }
         { fsub FR1,FR1,FR2    # subtract 0x4330000000000000 }
-        tg.Gettemp(current_asmdata.CurrAsmList,8,tt_normal,ref);
+        tg.Gettemp(current_asmdata.CurrAsmList,8,8,tt_normal,ref);
 
         signed := is_signed(left.resultdef);
 

compiler/powerpc/nppcmat.pas

@@ -358,7 +358,7 @@ end;
           begin
             current_asmdata.getjumplabel(hl);
             current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl));
-            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO');
+            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false);
             cg.a_label(current_asmdata.CurrAsmList,hl);
           end;
         { unsigned division/module can only overflow in case of division by zero }

compiler/powerpc64/cgcpu.pas

@@ -45,7 +45,7 @@ type
     procedure a_param_ref(list: TAsmList; size: tcgsize; 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_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a:
@@ -128,7 +128,7 @@ type
      if includeCall is true, the method is marked as having a call, not if false. This
      option is particularly useful to prevent generation of a larger stack frame for the
      register save and restore helper functions. }
-    procedure a_call_name_direct(list: TAsmList; s: string; prependDot : boolean;
+    procedure a_call_name_direct(list: TAsmList; s: string; weak: boolean; prependDot : boolean;
       addNOP : boolean; includeCall : boolean = true);
 
     procedure a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean);
@@ -505,23 +505,26 @@ end;
 
 { calling a procedure by name }
 
-procedure tcgppc.a_call_name(list: TAsmList; const s: string);
+procedure tcgppc.a_call_name(list: TAsmList; const s: string; weak: boolean);
 begin
     if (target_info.system <> system_powerpc64_darwin) then
-      a_call_name_direct(list, s, false, true)
+      a_call_name_direct(list, s, weak, false, true)
     else
       begin
-        list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s)));
+        list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
         include(current_procinfo.flags,pi_do_call);
       end;
 end;
 
 
-procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; prependDot : boolean; addNOP : boolean; includeCall : boolean);
+procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; weak: boolean; prependDot : boolean; addNOP : boolean; includeCall : boolean);
 begin
   if (prependDot) then
     s := '.' + s;
-  list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(s)));
+  if not(weak) then
+    list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(s)))
+  else
+    list.concat(taicpu.op_sym(A_BL, current_asmdata.WeakRefAsmSymbol(s)));
   if (addNOP) then
     list.concat(taicpu.op_none(A_NOP));
 
@@ -569,7 +572,7 @@ begin
     in R11 }
     a_reg_alloc(list, NR_R11);
     a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
-    a_call_name_direct(list, '.ptrgl', false, false);
+    a_call_name_direct(list, '.ptrgl', false, false, false);
     a_reg_dealloc(list, NR_R11);
   end;
 
@@ -1234,7 +1237,7 @@ var
 begin
   if (target_info.system = system_powerpc64_darwin) then
     begin
-      p := taicpu.op_sym(A_B,get_darwin_call_stub(s));
+      p := taicpu.op_sym(A_B,get_darwin_call_stub(s,false));
       p.is_jmp := true;
       list.concat(p)
     end
@@ -1378,7 +1381,7 @@ procedure tcgppc.g_profilecode(list: TAsmList);
 begin
   current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_savepara), list);
 
-  a_call_name_direct(list, '_mcount', false, true);
+  a_call_name_direct(list, '_mcount', false, false, true);
 
   current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_restorepara), list);
 end;
@@ -1416,12 +1419,12 @@ var
       mayNeedLRStore := false;
       if ((fprcount > 0) and (gprcount > 0)) then begin
         a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
-        a_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false, false);
-        a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false);
+        a_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false, false, false);
+        a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false, false);
       end else if (gprcount > 0) then
-        a_call_name_direct(list, '_savegpr0_' + intToStr(32-gprcount), false, false, false)
+        a_call_name_direct(list, '_savegpr0_' + intToStr(32-gprcount), false, false, false, false)
       else if (fprcount > 0) then
-        a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false)
+        a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false, false)
       else
         mayNeedLRStore := true;
     end else begin
@@ -1553,7 +1556,7 @@ var
       needsExitCode := false;
       if ((fprcount > 0) and (gprcount > 0)) then begin
         a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
-        a_call_name_direct(list, '_restgpr1_' + intToStr(32-gprcount), false, false, false);
+        a_call_name_direct(list, '_restgpr1_' + intToStr(32-gprcount), false, false, false, false);
         a_jmp_name_direct(list, '_restfpr_' + intToStr(32-fprcount), false);
       end else if (gprcount > 0) then
         a_jmp_name_direct(list, '_restgpr0_' + intToStr(32-gprcount), false)

compiler/powerpc64/nppcadd.pas

@@ -346,7 +346,7 @@ begin
             { g_overflowcheck generates a OC_AE instead of OC_EQ :/ }
             current_asmdata.getjumplabel(hl);
             tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList, OC_EQ, hl);
-            cg.a_call_name(current_asmdata.CurrAsmList, 'FPC_OVERFLOW');
+            cg.a_call_name(current_asmdata.CurrAsmList, 'FPC_OVERFLOW',false);
             cg.a_label(current_asmdata.CurrAsmList, hl);
           end;
       end;

compiler/powerpc64/nppccnv.pas

@@ -125,7 +125,7 @@ begin
   { fcfid frD,frD # point integer (no round) }
   { fmadd frD,frC,frT1,frD # (2^32)*high + low }
   { # (only add can round) }
-  tg.Gettemp(current_asmdata.CurrAsmList, 8, tt_normal, disp);
+  tg.Gettemp(current_asmdata.CurrAsmList, 8, 8, tt_normal, disp);
 
   { do the signed case for everything but 64 bit unsigned integers }
   signed := (left.location.size <> OS_64);
@@ -143,7 +143,7 @@ begin
       internalerror(200110011);
 
     // allocate second temp memory
-    tg.Gettemp(current_asmdata.CurrAsmList, 8, tt_normal, disp2);
+    tg.Gettemp(current_asmdata.CurrAsmList, 8, 8, tt_normal, disp2);
   end;
 
   if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then

compiler/powerpc64/nppcmat.pas

@@ -241,7 +241,7 @@ begin
   if right.nodetype <> ordconstn then begin
     current_asmdata.getjumplabel(hl);
     current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl));
-    cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO');
+    cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false);
     cg.a_label(current_asmdata.CurrAsmList,hl);
   end;
   { unsigned division/module can only overflow in case of division by zero

compiler/pp.lpi

@@ -1,8 +1,8 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="\"/>
-    <Version Value="5"/>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
     <General>
       <Flags>
         <MainUnitHasUsesSectionForAllUnits Value="False"/>
@@ -11,7 +11,6 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
       <TargetFileExt Value=".exe"/>
       <Title Value="pp"/>
     </General>
@@ -26,33 +25,41 @@
         <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"/>
         <UnitName Value="pp"/>
       </Unit0>
       <Unit1>
-        <Filename Value="x86\aasmcpu.pas"/>
+        <Filename Value="x86/aasmcpu.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="aasmcpu"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="wpo.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="wpo"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="optdead.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="optdead"/>
+      </Unit3>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
-    <PathDelim Value="\"/>
+    <Version Value="8"/>
     <Target>
-      <Filename Value="i386\pp"/>
+      <Filename Value="i386/pp"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="i386\"/>
-      <OtherUnitFiles Value="i386\;x86\;systems\"/>
-      <UnitOutputDirectory Value="i386\lazbuild"/>
+      <IncludeFiles Value="i386/"/>
+      <OtherUnitFiles Value="i386/;x86/;systems/"/>
+      <UnitOutputDirectory Value="i386/lazbuild"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
-        <D2Extensions Value="False"/>
         <CStyleOperator Value="False"/>
         <AllowLabel Value="False"/>
         <CPPInline Value="False"/>
@@ -72,8 +79,7 @@
       <ConfigFile>
         <StopAfterErrCount Value="50"/>
       </ConfigFile>
-      <CustomOptions Value="-di386
-"/>
+      <CustomOptions Value="-di386 -dgdb -ap"/>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>

compiler/pp.pas

@@ -39,6 +39,9 @@ program pp;
                       MMX instructions
   EXTERN_MSG          Don't compile the msgfiles in the compiler, always
                       use external messagefiles, default for TP
+  FPC_ARMEL           create an arm eabi compiler
+  FPC_OARM            create an arm oabi compiler, only needed when the host
+                      compiler is ARMEL
   -----------------------------------------------------------------
   cpuflags            The target processor has status flags (on by default)
   cpufpemu            The target compiler will also support emitting software

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/ppcgen/cgppc.pas

@@ -64,7 +64,7 @@ unit cgppc;
 
         procedure g_maybe_got_init(list: TAsmList); override;
        protected
-        function  get_darwin_call_stub(const s: string): tasmsymbol;
+        function  get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
         procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
         { Make sure ref is a valid reference for the PowerPC and sets the }
         { base to the value of the index if (base = R_NO).                }
@@ -243,7 +243,7 @@ unit cgppc;
       end;
 
 
-    function tcgppcgen.get_darwin_call_stub(const s: string): tasmsymbol;
+    function tcgppcgen.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
       var
         stubname: string;
         instr: taicpu;
@@ -273,6 +273,9 @@ unit cgppc;
         current_asmdata.asmlists[al_imports].concat(Tai_align.Create(stubalign));
         result := current_asmdata.RefAsmSymbol(stubname);
         current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
+        { register as a weak symbol if necessary }
+        if weak then
+          current_asmdata.weakrefasmsymbol(s);
         current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
         l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
         reference_reset_symbol(href,l1,0);
@@ -599,7 +602,7 @@ unit cgppc;
         end
       else
         a_jmp_cond(list,OC_AE,hl);
-      a_call_name(list,'FPC_OVERFLOW');
+      a_call_name(list,'FPC_OVERFLOW',false);
       a_label(list,hl);
     end;
 
@@ -616,7 +619,7 @@ unit cgppc;
           paramanager.freeparaloc(list,paraloc1);
           paraloc1.done;
           allocallcpuregisters(list);
-          a_call_name(list,'mcount');
+          a_call_name(list,'mcount',false);
           deallocallcpuregisters(list);
           a_reg_dealloc(list,NR_R0);
         end;
@@ -724,7 +727,7 @@ unit cgppc;
           case target_info.system of
             system_powerpc_darwin,
             system_powerpc64_darwin:
-              list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname)));
+              list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false)));
             system_powerpc64_linux:
               {$note ts:todo add GOT change?? - think not needed :) }
               list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
@@ -777,14 +780,14 @@ unit cgppc;
         if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and
            assigned(ref.symbol) and
            not assigned(ref.relsymbol) and
-           ((ref.symbol.bind = AB_EXTERNAL) or
+           ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
             (cs_create_pic in current_settings.moduleswitches))then
           begin
-            if (ref.symbol.bind = AB_EXTERNAL) or
+            if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
                ((cs_create_pic in current_settings.moduleswitches) and
                 (ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
               begin
-                tmpreg := g_indirect_sym_load(list,ref.symbol.name);
+                tmpreg := g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL);
                 ref.symbol:=nil;
               end
             else

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
@@ -1063,6 +1072,7 @@ implementation
 {$if defined(x86) or defined(arm)}
             { Set return value of safecall procedure if implicit try/finally blocks are disabled }
             if not (cs_implicit_exceptions in current_settings.moduleswitches) and
+               (target_info.system in system_all_windows) and
                (procdef.proccalloption=pocall_safecall) then
               cg.a_load_const_reg(aktproccode,OS_ADDR,0,NR_FUNCTION_RETURN_REG);
 {$endif}
@@ -1138,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;
 
 
@@ -1265,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;}
@@ -1346,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
@@ -1382,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;
 
 
@@ -1525,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
@@ -1585,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);
@@ -1666,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;
 
@@ -1863,7 +1874,7 @@ implementation
                        current_filepos:=oldcurrent_filepos;
                      end
                    else
-                     MessagePos1(tprocdef(tprocdef(hp).genericdef).fileinfo,sym_e_forward_not_resolved,tprocdef(tprocdef(hp).genericdef).fullprocname(false));
+                     MessagePos1(tprocdef(hp).fileinfo,sym_e_forward_not_resolved,tprocdef(hp).fullprocname(false));
                  end;
              end;
           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/ptconst.pas

@@ -1371,7 +1371,7 @@ implementation
         if (
             (
              (token = _ID) and
-             (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) and
+             (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
              (m_cvar_support in current_settings.modeswitches)
             ) or
             (

compiler/ptype.pas

@@ -29,15 +29,13 @@ interface
        globtype,cclasses,
        symtype,symdef,symbase;
 
-    const
-       { forward types should only be possible inside a TYPE statement }
-       typecanbeforward : boolean = false;
-
     var
        { hack, which allows to use the current parsed }
        { object type as function argument type  }
        testcurobject : byte;
 
+    procedure resolve_forward_types;
+
     { reads a type identifier }
     procedure id_type(var def : tdef;isforwarddef:boolean);
 
@@ -77,6 +75,72 @@ implementation
        pbase,pexpr,pdecsub,pdecvar,pdecobj;
 
 
+    procedure resolve_forward_types;
+      var
+        i: longint;
+        hpd,
+        def : tdef;
+        srsym  : tsym;
+        srsymtable : TSymtable;
+        hs : string;
+      begin
+        for i:=0 to current_module.checkforwarddefs.Count-1 do
+          begin
+            def:=tdef(current_module.checkforwarddefs[i]);
+            case def.typ of
+              pointerdef,
+              classrefdef :
+                begin
+                  { classrefdef inherits from pointerdef }
+                  hpd:=tabstractpointerdef(def).pointeddef;
+                  { still a forward def ? }
+                  if hpd.typ=forwarddef then
+                   begin
+                     { try to resolve the forward }
+                     if not assigned(tforwarddef(hpd).tosymname) then
+                       internalerror(200211201);
+                     hs:=tforwarddef(hpd).tosymname^;
+                     searchsym(upper(hs),srsym,srsymtable);
+                     { we don't need the forwarddef anymore, dispose it }
+                     hpd.free;
+                     tabstractpointerdef(def).pointeddef:=nil; { if error occurs }
+                     { was a type sym found ? }
+                     if assigned(srsym) and
+                        (srsym.typ=typesym) then
+                      begin
+                        tabstractpointerdef(def).pointeddef:=ttypesym(srsym).typedef;
+                        { avoid wrong unused warnings web bug 801 PM }
+                        inc(ttypesym(srsym).refs);
+                        { we need a class type for classrefdef }
+                        if (def.typ=classrefdef) and
+                           not(is_class(ttypesym(srsym).typedef)) then
+                          MessagePos1(tsym(srsym).fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename);
+                      end
+                     else
+                      begin
+                        Message1(sym_e_forward_type_not_resolved,hs);
+                        { try to recover }
+                        tabstractpointerdef(def).pointeddef:=generrordef;
+                      end;
+                   end;
+                end;
+              objectdef :
+                begin
+                  { give an error as the implementation may follow in an
+                    other type block which is allowed by FPC modes }
+                  if not(m_fpc in current_settings.modeswitches) and
+                     (oo_is_forward in tobjectdef(def).objectoptions) then
+                    MessagePos1(def.typesym.fileinfo,type_e_type_is_not_completly_defined,def.typename);
+                 end;
+              else
+                internalerror(200811071);
+            end;
+          end;
+        current_module.checkforwarddefs.clear;
+      end;
+
+
+
     procedure generate_specialization(var tt:tdef);
       var
         st  : TSymtable;
@@ -86,7 +150,6 @@ implementation
         err : boolean;
         i   : longint;
         sym : tsym;
-        old_block_type : tblock_type;
         genericdef : tstoreddef;
         generictype : ttypesym;
         generictypelist : TFPObjectList;
@@ -132,8 +195,6 @@ implementation
           end;
 
         consume(_LSHARPBRACKET);
-        old_block_type:=block_type;
-        block_type:=bt_specialize;
         { Parse generic parameters, for each undefineddef in the symtable of
           the genericdef we need to have a new def }
         err:=false;
@@ -187,9 +248,9 @@ implementation
           consume(_RSHARPBRACKET);
 
         { Special case if we are referencing the current defined object }
-        if assigned(aktobjectdef) and
-           (aktobjectdef.objname^=uspecializename) then
-          tt:=aktobjectdef;
+        if assigned(current_objectdef) and
+           (current_objectdef.objname^=uspecializename) then
+          tt:=current_objectdef;
 
         { for units specializations can already be needed in the interface, therefor we
           will use the global symtable. Programs don't have a globalsymtable and there we
@@ -271,7 +332,6 @@ implementation
 
         generictypelist.free;
         consume(_RSHARPBRACKET);
-        block_type:=old_block_type;
       end;
 
 
@@ -293,15 +353,15 @@ implementation
          { use of current parsed object:
             - classes can be used also in classes
             - objects can be parameters }
-         if assigned(aktobjectdef) and
-            (aktobjectdef.objname^=pattern) and
+         if assigned(current_objectdef) and
+            (current_objectdef.objname^=pattern) and
             (
              (testcurobject=2) or
-             is_class_or_interface(aktobjectdef)
+             is_class_or_interface(current_objectdef)
             )then
            begin
              consume(_ID);
-             def:=aktobjectdef;
+             def:=current_objectdef;
              exit;
            end;
          { Use the special searchsym_type that ignores records,objects and
@@ -325,10 +385,10 @@ implementation
          { are we parsing a possible forward def ? }
          if isforwarddef and
             not(is_unit_specific) then
-          begin
-            def:=tforwarddef.create(s,pos);
-            exit;
-          end;
+           begin
+             def:=tforwarddef.create(sorg,pos);
+             exit;
+           end;
          { unknown sym ? }
          if not assigned(srsym) then
           begin
@@ -432,11 +492,8 @@ implementation
 
     { reads a record declaration }
     function record_dec : tdef;
-
       var
          recst : trecordsymtable;
-         storetypecanbeforward : boolean;
-         old_object_option : tsymoptions;
       begin
          { create recdef }
          recst:=trecordsymtable.create(current_settings.packrecords);
@@ -445,16 +502,8 @@ implementation
          symtablestack.push(recst);
          { parse record }
          consume(_RECORD);
-         old_object_option:=current_object_option;
-         current_object_option:=[sp_public];
-         storetypecanbeforward:=typecanbeforward;
-         { for tp7 don't allow forward types }
-         if m_tp7 in current_settings.modeswitches then
-           typecanbeforward:=false;
          read_record_fields([vd_record]);
          consume(_END);
-         typecanbeforward:=storetypecanbeforward;
-         current_object_option:=old_object_option;
          { make the record size aligned }
          recst.addalignmentpadding;
          { restore symtable stack }
@@ -489,15 +538,15 @@ implementation
               - classes can be used also in classes
               - objects can be parameters }
            if (token=_ID) and
-              assigned(aktobjectdef) and
-              (aktobjectdef.objname^=pattern) and
+              assigned(current_objectdef) and
+              (current_objectdef.objname^=pattern) and
               (
                (testcurobject=2) or
-               is_class_or_interface(aktobjectdef)
+               is_class_or_interface(current_objectdef)
               )then
              begin
                consume(_ID);
-               def:=aktobjectdef;
+               def:=current_objectdef;
                exit;
              end;
            { Generate a specialization? }
@@ -768,6 +817,7 @@ implementation
 
       var
         p  : tnode;
+        hdef : tdef;
         pd : tabstractprocdef;
         is_func,
         enumdupmsg, first : boolean;
@@ -852,8 +902,10 @@ implementation
            _CARET:
               begin
                 consume(_CARET);
-                single_type(tt2,typecanbeforward);
+                single_type(tt2,(block_type=bt_type));
                 def:=tpointerdef.create(tt2);
+                if tt2.typ=forwarddef then
+                  current_module.checkforwarddefs.add(def);
               end;
             _RECORD:
               begin
@@ -878,20 +930,79 @@ implementation
                       current_settings.packrecords:=1
                     else
                       current_settings.packrecords:=bit_alignment;
-                    if token in [_CLASS,_OBJECT] then
-                      def:=object_dec(name,genericdef,genericlist,nil)
-                    else
-                      def:=record_dec;
+                    case token of
+                      _CLASS :
+                        begin
+                          consume(_CLASS);
+                          def:=object_dec(odt_class,name,genericdef,genericlist,nil);
+                        end;
+                      _OBJECT :
+                        begin
+                          consume(_OBJECT);
+                          def:=object_dec(odt_object,name,genericdef,genericlist,nil);
+                        end;
+                      else
+                        def:=record_dec;
+                    end;
                     current_settings.packrecords:=oldpackrecords;
                   end;
               end;
-            _DISPINTERFACE,
-            _CLASS,
-            _CPPCLASS,
-            _INTERFACE,
-            _OBJECT:
+            _DISPINTERFACE :
+              begin
+                { need extra check here since interface is a keyword
+                  in all pascal modes }
+                if not(m_class in current_settings.modeswitches) then
+                  Message(parser_f_need_objfpc_or_delphi_mode);
+                consume(token);
+                def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil);
+              end;
+            _CLASS :
               begin
-                def:=object_dec(name,genericdef,genericlist,nil);
+                consume(token);
+                { Delphi only allows class of in type blocks }
+                if (token=_OF) and
+                   (
+                    not(m_delphi in current_settings.modeswitches) or
+                    (block_type=bt_type)
+                   ) then
+                  begin
+                    consume(_OF);
+                    single_type(hdef,(block_type=bt_type));
+                    if is_class(hdef) then
+                      def:=tclassrefdef.create(hdef)
+                    else
+                      if hdef.typ=forwarddef then
+                        begin
+                          def:=tclassrefdef.create(hdef);
+                          current_module.checkforwarddefs.add(def);
+                        end
+                    else
+                      Message1(type_e_class_type_expected,hdef.typename);
+                  end
+                else
+                  def:=object_dec(odt_class,name,genericdef,genericlist,nil);
+              end;
+            _CPPCLASS :
+              begin
+                consume(token);
+                def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil);
+              end;
+            _INTERFACE :
+              begin
+                { need extra check here since interface is a keyword
+                  in all pascal modes }
+                if not(m_class in current_settings.modeswitches) then
+                  Message(parser_f_need_objfpc_or_delphi_mode);
+                consume(token);
+                if current_settings.interfacetype=it_interfacecom then
+                  def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil)
+                else {it_interfacecorba}
+                  def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil);
+              end;
+            _OBJECT :
+              begin
+                consume(token);
+                def:=object_dec(odt_object,name,genericdef,genericlist,nil);
               end;
             _PROCEDURE,
             _FUNCTION:

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/rgobj.pas

@@ -1718,6 +1718,7 @@ unit rgobj;
         spill_temps : ^Tspill_temp_list;
         supreg : tsuperregister;
         templist : TAsmList;
+        size: ptrint;
       begin
         spill_registers:=false;
         live_registers.clear;
@@ -1739,9 +1740,10 @@ unit rgobj;
               {Get a temp for the spilled register, the size must at least equal a complete register,
                take also care of the fact that subreg can be larger than a single register like doubles
                that occupy 2 registers }
+              size:=max(tcgsize2size[reg_cgsize(newreg(regtype,t,R_SUBWHOLE))],
+                             tcgsize2size[reg_cgsize(newreg(regtype,t,reginfo[t].subreg))]);
               tg.gettemp(templist,
-                         max(tcgsize2size[reg_cgsize(newreg(regtype,t,R_SUBWHOLE))],
-                             tcgsize2size[reg_cgsize(newreg(regtype,t,reginfo[t].subreg))]),
+                         size,size,
                          tt_noreuse,spill_temps^[t]);
             end;
         list.insertlistafter(headertai,templist);

compiler/scandir.pas

@@ -41,11 +41,17 @@ implementation
       rabase;
 
     const
-      localswitchesstackmax = 20;
+      switchesstatestackmax = 20;
+
+    type
+      tsavedswitchesstate = record
+        localsw: tlocalswitches;
+        verbosity: longint;
+      end;
 
     var
-      localswitchesstack: array[0..localswitchesstackmax] of tlocalswitches;
-      localswitchesstackpos: Integer;
+      switchesstatestack: array[0..switchesstatestackmax] of tsavedswitchesstate;
+      switchesstatestackpos: Integer;
 
 {*****************************************************************************
                                     Helpers
@@ -68,7 +74,7 @@ implementation
       begin
       { support ON/OFF }
         state:=current_scanner.ReadState;
-        SetVerbosity(flag+state);
+        recordpendingverbosityswitch(flag,state);
       end;
 
 
@@ -93,15 +99,7 @@ implementation
       begin
         state:=current_scanner.readstate;
         if (sw<>cs_localnone) and (state in ['-','+']) then
-         begin
-           if not localswitcheschanged then
-             nextlocalswitches:=current_settings.localswitches;
-           if state='-' then
-            exclude(nextlocalswitches,sw)
-           else
-            include(nextlocalswitches,sw);
-           localswitcheschanged:=true;
-         end;
+          recordpendinglocalswitch(sw,state);
       end;
 
     procedure do_localswitchdefault(sw:tlocalswitch);
@@ -110,23 +108,7 @@ implementation
       begin
         state:=current_scanner.readstatedefault;
         if (sw<>cs_localnone) and (state in ['-','+','*']) then
-         begin
-           if not localswitcheschanged then
-             nextlocalswitches:=current_settings.localswitches;
-           if state='-' then
-            exclude(nextlocalswitches,sw)
-           else
-            if state='+' then
-             include(nextlocalswitches,sw)
-            else
-             begin
-              if sw in init_settings.localswitches then
-               include(nextlocalswitches,sw)
-              else
-               exclude(nextlocalswitches,sw);
-             end;
-           localswitcheschanged:=true;
-         end;
+          recordpendinglocalswitch(sw,state);
       end;
 
 
@@ -945,16 +927,12 @@ implementation
     procedure dir_pop;
 
     begin
-      if localswitchesstackpos < 1 then
+      if switchesstatestackpos < 1 then
         Message(scan_e_too_many_pop);
 
-      if not localswitcheschanged then
-        nextlocalswitches:=current_settings.localswitches;
-
-      Dec(localswitchesstackpos);
-      nextlocalswitches:= localswitchesstack[localswitchesstackpos];
-
-      localswitcheschanged:=true;
+      Dec(switchesstatestackpos);
+      recordpendinglocalfullswitch(switchesstatestack[switchesstatestackpos].localsw);
+      recordpendingverbosityfullswitch(switchesstatestack[switchesstatestackpos].verbosity);
     end;
 
     procedure dir_profile;
@@ -970,17 +948,14 @@ implementation
     procedure dir_push;
 
     begin
-      if localswitchesstackpos > localswitchesstackmax then
+      if switchesstatestackpos > switchesstatestackmax then
         Message(scan_e_too_many_push);
 
-      if localswitcheschanged then
-        begin
-          current_settings.localswitches:=nextlocalswitches;
-          localswitcheschanged:=false;
-        end;
+      flushpendingswitchesstate;
 
-      localswitchesstack[localswitchesstackpos]:= current_settings.localswitches;
-      Inc(localswitchesstackpos);
+      switchesstatestack[switchesstatestackpos].localsw:= current_settings.localswitches;
+      switchesstatestack[switchesstatestackpos].verbosity:=status.verbosity;
+      Inc(switchesstatestackpos);
     end;
 
     procedure dir_rangechecks;
@@ -1434,5 +1409,5 @@ implementation
       end;
 
 begin
-  localswitchesstackpos:= 0;
+  switchesstatestackpos:= 0;
 end.

compiler/scanner.pas

@@ -332,11 +332,7 @@ implementation
         if b then
          begin
            { resolve all postponed switch changes }
-           if localswitcheschanged then
-             begin
-               current_settings.localswitches:=nextlocalswitches;
-               localswitcheschanged:=false;
-             end;
+           flushpendingswitchesstate;
 
            HandleModeSwitches(changeinit);
 
@@ -526,11 +522,7 @@ implementation
 
     procedure dir_ifopt;
       begin
-        if localswitcheschanged then
-          begin
-            current_settings.localswitches:=nextlocalswitches;
-            localswitcheschanged:=false;
-          end;
+        flushpendingswitchesstate;
         current_scanner.ifpreprocstack(pp_ifopt,@opt_check,scan_c_ifopt_found);
       end;
 
@@ -3200,11 +3192,7 @@ In case not, the value returned can be arbitrary.
       label
          exit_label;
       begin
-        if localswitcheschanged then
-          begin
-            current_settings.localswitches:=nextlocalswitches;
-            localswitcheschanged:=false;
-          end;
+        flushpendingswitchesstate;
 
         { record tokens? }
         if allowrecordtoken and
@@ -3627,7 +3615,7 @@ In case not, the value returned can be arbitrary.
                   begin
                     readchar;
                     c:=upcase(c);
-                    if (block_type in [bt_type,bt_specialize]) or
+                    if (block_type in [bt_type,bt_const_type,bt_var_type]) or
                        (lasttoken=_ID) or (lasttoken=_NIL) or (lasttoken=_OPERATOR) or
                        (lasttoken=_RKLAMMER) or (lasttoken=_RECKKLAMMER) or (lasttoken=_CARET) then
                      begin
@@ -3867,7 +3855,7 @@ In case not, the value returned can be arbitrary.
              '>' :
                begin
                  readchar;
-                 if (block_type in [bt_type,bt_specialize]) then
+                 if (block_type in [bt_type,bt_var_type,bt_const_type]) then
                    token:=_RSHARPBRACKET
                  else
                    begin
@@ -3899,7 +3887,7 @@ In case not, the value returned can be arbitrary.
              '<' :
                begin
                  readchar;
-                 if (block_type in [bt_type,bt_specialize]) then
+                 if (block_type in [bt_type,bt_var_type,bt_const_type]) then
                    token:=_LSHARPBRACKET
                  else
                    begin

compiler/sparc/cgcpu.pas

@@ -51,7 +51,7 @@ interface
         procedure a_paramaddr_ref(list:TAsmList;const r:TReference;const paraloc:TCGPara);override;
         procedure a_paramfpu_reg(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara);override;
         procedure a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : 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;
         { General purpose instructions }
         procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
@@ -423,16 +423,19 @@ implementation
       var
         href : treference;
       begin
-        tg.GetTemp(list,TCGSize2Size[size],tt_normal,href);
+        tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,href);
         a_loadfpu_reg_ref(list,size,size,r,href);
         a_paramfpu_ref(list,size,href,paraloc);
         tg.Ungettemp(list,href);
       end;
 
 
-    procedure TCgSparc.a_call_name(list:TAsmList;const s:string);
+    procedure TCgSparc.a_call_name(list:TAsmList;const s:string; weak: boolean);
       begin
-        list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)));
+        if not weak then
+          list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)))
+        else
+          list.concat(taicpu.op_sym(A_CALL,current_asmdata.WeakRefAsmSymbol(s)));
         { Delay slot }
         list.concat(taicpu.op_none(A_NOP));
       end;
@@ -1034,7 +1037,7 @@ implementation
             internalerror(200409281);
         end;
 
-        a_call_name(list,'FPC_OVERFLOW');
+        a_call_name(list,'FPC_OVERFLOW',false);
         a_label(list,hl);
       end;
 
@@ -1146,7 +1149,7 @@ implementation
         paramanager.freeparaloc(list,paraloc1);
         alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
-        a_call_name(list,'FPC_MOVE');
+        a_call_name(list,'FPC_MOVE',false);
         dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
         dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
         paraloc3.done;

compiler/switches.pas

@@ -25,14 +25,23 @@ unit switches;
 
 interface
 
+uses
+  globtype;
+
 procedure HandleSwitch(switch,state:char);
 function CheckSwitch(switch,state:char):boolean;
 
+procedure recordpendingverbosityswitch(sw: char; state: char);
+procedure recordpendinglocalswitch(sw: tlocalswitch; state: char);
+procedure recordpendinglocalfullswitch(const switches: tlocalswitches);
+procedure recordpendingverbosityfullswitch(verbosity: longint);
+procedure flushpendingswitchesstate;
 
 implementation
 uses
-  globtype,systems,cpuinfo,
-  globals,verbose,fmodule;
+  systems,cpuinfo,
+  globals,verbose,comphook,
+  fmodule;
 
 {****************************************************************************
                           Main Switches Parsing
@@ -149,15 +158,7 @@ begin
        unsupportedsw :
          Message1(scan_w_unsupported_switch,'$'+switch);
        localsw :
-         begin
-           if not localswitcheschanged then
-             nextlocalswitches:=current_settings.localswitches;
-           if state='+' then
-            include(nextlocalswitches,tlocalswitch(setsw))
-           else
-            exclude(nextlocalswitches,tlocalswitch(setsw));
-           localswitcheschanged:=true;
-         end;
+         recordpendinglocalswitch(tlocalswitch(setsw),state);
        modulesw :
          begin
            if current_module.in_global then
@@ -256,4 +257,64 @@ begin
 end;
 
 
+procedure recordpendingverbosityswitch(sw: char; state: char);
+  begin
+    pendingstate.nextverbositystr:=pendingstate.nextverbositystr+sw+state;
+  end;
+
+
+procedure recordpendinglocalswitch(sw: tlocalswitch; state: char);
+  begin
+    if not pendingstate.localswitcheschanged then
+       pendingstate.nextlocalswitches:=current_settings.localswitches;
+    if state='-' then
+      exclude(pendingstate.nextlocalswitches,sw)
+    else if state='+' then
+      include(pendingstate.nextlocalswitches,sw)
+    else { state = '*' }
+      begin
+        if sw in init_settings.localswitches then
+         include(pendingstate.nextlocalswitches,sw)
+        else
+         exclude(pendingstate.nextlocalswitches,sw);
+      end;
+    pendingstate.localswitcheschanged:=true;
+  end;
+
+
+procedure recordpendinglocalfullswitch(const switches: tlocalswitches);
+  begin
+    pendingstate.nextlocalswitches:=switches;
+    pendingstate.localswitcheschanged:=true;
+  end;
+
+
+procedure recordpendingverbosityfullswitch(verbosity: longint);
+  begin
+    pendingstate.nextverbositystr:='';
+    pendingstate.nextverbosityfullswitch:=verbosity;
+    pendingstate.verbosityfullswitched:=true;
+  end;
+
+
+procedure flushpendingswitchesstate;
+  begin
+    if pendingstate.localswitcheschanged then
+      begin
+        current_settings.localswitches:=pendingstate.nextlocalswitches;
+        pendingstate.localswitcheschanged:=false;
+      end;
+    if pendingstate.verbosityfullswitched then
+      begin
+        status.verbosity:=pendingstate.nextverbosityfullswitch;
+        pendingstate.verbosityfullswitched:=false;
+      end;
+    if pendingstate.nextverbositystr<>'' then
+      begin
+        setverbosity(pendingstate.nextverbositystr);
+        pendingstate.nextverbositystr:='';
+      end;
+  end;
+
+
 end.

compiler/symbase.pas

@@ -87,8 +87,6 @@ interface
 ************************************************}
 
        TSymtable = class
-       protected
-          forwardchecksyms : TFPObjectList;
        public
           name      : pshortstring;
           realname  : pshortstring;
@@ -97,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;
@@ -106,7 +105,6 @@ interface
           function  getcopy:TSymtable;
           procedure clear;virtual;
           function  checkduplicate(var s:THashedIDString;sym:TSymEntry):boolean;virtual;
-          procedure checkforwardtype(sym:TSymEntry);
           procedure insert(sym:TSymEntry;checkdup:boolean=true);virtual;
           procedure Delete(sym:TSymEntry);virtual;
           function  Find(const s:TIDString) : TSymEntry;
@@ -222,9 +220,8 @@ implementation
          defowner:=nil;
          DefList:=TFPObjectList.Create(true);
          SymList:=TFPHashObjectList.Create(true);
-         { the syms are owned by symlist, so don't free }
-         forwardchecksyms:=TFPObjectList.Create(false);
          refcount:=1;
+         currentvisibility:=vis_public;
       end;
 
 
@@ -238,7 +235,6 @@ implementation
         { SymList can already be disposed or set to nil for withsymtable, }
         { but in that case Free does nothing                              }
         SymList.Free;
-        forwardchecksyms.free;
         stringdispose(name);
         stringdispose(realname);
       end;
@@ -269,7 +265,6 @@ implementation
       var
         i : integer;
       begin
-         forwardchecksyms.clear;
          SymList.Clear;
          { Prevent recursive calls between TDef.destroy and TSymtable.Remove }
          if DefList.OwnsObjects then
@@ -287,12 +282,6 @@ implementation
       end;
 
 
-    procedure TSymtable.checkforwardtype(sym:TSymEntry);
-      begin
-        forwardchecksyms.add(sym);
-      end;
-
-
     procedure TSymtable.insert(sym:TSymEntry;checkdup:boolean=true);
       var
         hashedid : THashedIDString;

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
   );
@@ -266,7 +270,9 @@ type
     po_has_importdll,
     po_has_importname,
     po_kylixlocal,
-    po_dispid
+    po_dispid,
+    { weakly linked (i.e., may or may not exist at run time) }
+    po_weakexternal
   );
   tprocoptions=set of tprocoption;
 
@@ -353,7 +359,8 @@ type
     vo_is_typed_const,
     vo_is_range_check,
     vo_is_overflow_check,
-    vo_is_typinfo_para
+    vo_is_typinfo_para,
+    vo_is_weak_external
   );
   tvaroptions=set of tvaroption;
 
@@ -476,7 +483,8 @@ type
 
 const
    inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has_protected,
-                oo_has_strictprotected,oo_has_strictprivate,oo_has_constructor,oo_has_destructor];
+                oo_has_strictprotected,oo_has_strictprivate,oo_has_constructor,oo_has_destructor,
+                oo_can_have_published];
    clearstack_pocalls = [
      pocall_cdecl,pocall_cppdecl,pocall_syscall,pocall_mwpascal
    ];
@@ -502,6 +510,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

@@ -221,6 +221,14 @@ interface
          function  IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean;
        end;
 
+       { tvmtentry }
+       tvmtentry = record
+         procdef      : tprocdef;
+         procdefderef : tderef;
+         visibility   : tvisibility;
+       end;
+       pvmtentry = ^tvmtentry;
+
        { tobjectdef }
 
        tvmcallstatic = (vmcs_default, vmcs_yes, vmcs_no);
@@ -241,7 +249,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;
           vmcallstaticinfo : pmvcallstaticinfo;
           vmt_offset     : longint;
           objecttype     : tobjecttyp;
@@ -263,6 +271,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;
@@ -444,6 +454,7 @@ interface
             EXTDEBUG has fileinfo in tdef (PFV) }
           fileinfo : tfileposinfo;
 {$endif}
+          visibility : tvisibility;
           symoptions : tsymoptions;
           { symbol owning this definition }
           procsym : tsym;
@@ -503,7 +514,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 }
@@ -578,10 +588,8 @@ interface
           function  is_publishable : boolean;override;
        end;
 
-       Tdefmatch=(dm_exact,dm_equal,dm_convertl1);
-
     var
-       aktobjectdef : tobjectdef;  { used for private functions check !! }
+       current_objectdef : tobjectdef;  { used for private functions check !! }
 
     { default types }
        generrordef,              { error in definition }
@@ -2808,19 +2816,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
@@ -2931,6 +2937,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 }
@@ -3067,6 +3074,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 }
@@ -3207,60 +3215,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
@@ -3705,7 +3659,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));
@@ -3728,6 +3682,7 @@ implementation
          vmtentrycount  : longint;
          d : tderef;
          ImplIntf : TImplementedInterface;
+         vmtentry : pvmtentry;
       begin
          inherited ppuload(objectdef,ppufile);
          objecttype:=tobjecttyp(ppufile.getbyte);
@@ -3738,7 +3693,6 @@ implementation
          tObjectSymtable(symtable).fieldalignment:=ppufile.getbyte;
          tObjectSymtable(symtable).recordalignment:=ppufile.getbyte;
          vmt_offset:=ppufile.getlongint;
-         vmtentries:=nil;
          ppufile.getderef(childofderef);
          ppufile.getsmallset(objectoptions);
 
@@ -3751,6 +3705,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
@@ -3820,6 +3786,7 @@ implementation
            end;
          if assigned(vmtentries) then
            begin
+             resetvmtentries;
              vmtentries.free;
              vmtentries:=nil;
            end;
@@ -3861,8 +3828,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;
 
@@ -3870,6 +3837,7 @@ implementation
     procedure tobjectdef.ppuwrite(ppufile:tcompilerppufile);
       var
          i : longint;
+         vmtentry : pvmtentry;
          ImplIntf : TImplementedInterface;
       begin
          inherited ppuwrite(ppufile);
@@ -3887,6 +3855,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);
@@ -3920,20 +3897,21 @@ implementation
 
     function tobjectdef.GetTypeName:string;
       begin
-        if (self <> aktobjectdef) 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);
@@ -3942,6 +3920,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
@@ -3960,6 +3944,7 @@ implementation
     procedure tobjectdef.deref;
       var
          i : longint;
+         vmtentry : pvmtentry;
       begin
          inherited deref;
          childof:=tobjectdef(childofderef.resolve);
@@ -3970,6 +3955,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
@@ -4002,6 +3992,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}
@@ -4031,35 +4047,28 @@ implementation
 
     procedure tobjectdef.set_parent( c : tobjectdef);
       begin
-        { nothing to do if the parent was not forward !}
         if assigned(childof) then
           exit;
         childof:=c;
-        { some options are inherited !! }
-        if assigned(c) then
+        if not assigned(c) then
+          exit;
+        { inherit options and status }
+        objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
+        { add the data of the anchestor class/object }
+        if (objecttype in [odt_class,odt_object]) then
           begin
-             { only important for classes }
-             objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
-             if not (objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) then
-               begin
-                  { add the data of the anchestor class }
-                  tObjectSymtable(symtable).datasize:=
-                    tObjectSymtable(symtable).datasize+
-                    tObjectSymtable(c.symtable).datasize;
-                  { inherit recordalignment }
-                  tObjectSymtable(symtable).recordalignment:=tObjectSymtable(c.symtable).recordalignment;
-                  if (oo_has_vmt in objectoptions) and
-                     (oo_has_vmt in c.objectoptions) then
-                    tObjectSymtable(symtable).datasize:=
-                      tObjectSymtable(symtable).datasize-sizeof(pint);
-                  { if parent has a vmt field then
-                    the offset is the same for the child PM }
-                  if (oo_has_vmt in c.objectoptions) or is_class(self) then
-                    begin
-                       vmt_offset:=c.vmt_offset;
-                       include(objectoptions,oo_has_vmt);
-                    end;
-               end;
+            tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize+tObjectSymtable(c.symtable).datasize;
+            { inherit recordalignment }
+            tObjectSymtable(symtable).recordalignment:=tObjectSymtable(c.symtable).recordalignment;
+            if (oo_has_vmt in objectoptions) and
+               (oo_has_vmt in c.objectoptions) then
+              tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize-sizeof(pint);
+            { if parent has a vmt field then the offset is the same for the child PM }
+            if (oo_has_vmt in c.objectoptions) or is_class(self) then
+              begin
+                vmt_offset:=c.vmt_offset;
+                include(objectoptions,oo_has_vmt);
+              end;
           end;
       end;
 
@@ -4088,7 +4097,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

@@ -46,7 +46,6 @@ interface
           constructor create(st:tsymtyp;const n : string);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor destroy;override;
-          procedure resolve_type_forward;
           procedure ppuwrite(ppufile:tcompilerppufile);virtual;
        end;
 
@@ -85,7 +84,6 @@ interface
           FProcdefList   : TFPObjectList;
           FProcdefDerefList : TFPList;
        public
-          overloadchecked : boolean;
           constructor create(const n : string);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
@@ -94,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;
 
@@ -364,6 +357,7 @@ implementation
          { Register symbol }
          current_module.symlist[SymId]:=self;
          ppufile.getposinfo(fileinfo);
+         visibility:=tvisibility(ppufile.getbyte);
          ppufile.getsmallset(symoptions);
       end;
 
@@ -373,6 +367,7 @@ implementation
          ppufile.putlongint(SymId);
          ppufile.putstring(realname);
          ppufile.putposinfo(fileinfo);
+         ppufile.putbyte(byte(visibility));
          ppufile.putsmallset(symoptions);
       end;
 
@@ -383,96 +378,6 @@ implementation
       end;
 
 
-    { Resolve forward defined types and give errors for non-resolved ones }
-    procedure tstoredsym.resolve_type_forward;
-      var
-        hpd,pd : tdef;
-        srsym  : tsym;
-        srsymtable : TSymtable;
-        again  : boolean;
-
-      begin
-         { Check only typesyms or record/object fields }
-         case typ of
-           typesym :
-             pd:=ttypesym(self).typedef;
-           fieldvarsym :
-             pd:=tfieldvarsym(self).vardef
-           else
-             internalerror(2008090702);
-         end;
-         repeat
-           again:=false;
-           case pd.typ of
-             arraydef :
-               begin
-                 { elementdef could also be defined using a forwarddef }
-                 pd:=tarraydef(pd).elementdef;
-                 again:=true;
-               end;
-             pointerdef,
-             classrefdef :
-               begin
-                 { classrefdef inherits from pointerdef }
-                 hpd:=tabstractpointerdef(pd).pointeddef;
-                 { still a forward def ? }
-                 if hpd.typ=forwarddef then
-                  begin
-                    { try to resolve the forward }
-                    if not assigned(tforwarddef(hpd).tosymname) then
-                      internalerror(20021120);
-                    searchsym(tforwarddef(hpd).tosymname^,srsym,srsymtable);
-                    { we don't need the forwarddef anymore, dispose it }
-                    hpd.free;
-                    tabstractpointerdef(pd).pointeddef:=nil; { if error occurs }
-                    { was a type sym found ? }
-                    if assigned(srsym) and
-                       (srsym.typ=typesym) then
-                     begin
-                       tabstractpointerdef(pd).pointeddef:=ttypesym(srsym).typedef;
-                       { avoid wrong unused warnings web bug 801 PM }
-                       inc(ttypesym(srsym).refs);
-                       { we need a class type for classrefdef }
-                       if (pd.typ=classrefdef) and
-                          not(is_class(ttypesym(srsym).typedef)) then
-                         MessagePos1(tsym(srsym).fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename);
-                     end
-                    else
-                     begin
-                       MessagePos1(fileinfo,sym_e_forward_type_not_resolved,realname);
-                       { try to recover }
-                       tabstractpointerdef(pd).pointeddef:=generrordef;
-                     end;
-                  end;
-               end;
-             recorddef :
-               begin
-                 tstoredsymtable(trecorddef(pd).symtable).resolve_forward_types;
-               end;
-             objectdef :
-               begin
-                 if not(m_fpc in current_settings.modeswitches) and
-                    (oo_is_forward in tobjectdef(pd).objectoptions) then
-                  begin
-                    { only give an error as the implementation may follow in an
-                      other type block which is allowed by FPC modes }
-                    MessagePos1(fileinfo,sym_e_forward_type_not_resolved,realname);
-                  end
-                 else
-                  begin
-                    { Check all fields of the object declaration, but don't
-                      check objectdefs in objects/records, because these
-                      can't exist (anonymous objects aren't allowed) }
-                    if not(owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                      tstoredsymtable(tobjectdef(pd).symtable).resolve_forward_types;
-                  end;
-               end;
-          end;
-        until not again;
-      end;
-
-
-
 {****************************************************************************
                                  TLABELSYM
 ****************************************************************************}
@@ -561,8 +466,7 @@ implementation
          FProcdefderefList:=nil;
          { the tprocdef have their own symoptions, make the procsym
            always visible }
-         symoptions:=[sp_public];
-         overloadchecked:=false;
+         visibility:=vis_public;
       end;
 
 
@@ -697,20 +601,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;
@@ -859,51 +749,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);
@@ -72,10 +71,8 @@ interface
           procedure allsymbolsused;
           procedure allprivatesused;
           procedure check_forwards;
-          procedure resolve_forward_types;
           procedure checklabels;
           function  needs_init_final : boolean;
-          procedure unchain_overloaded;
           procedure testfordefaultproperty(sym:TObject;arg:pointer);
        end;
 
@@ -89,8 +86,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;
@@ -194,6 +190,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;
@@ -211,7 +210,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 ***}
@@ -288,19 +286,11 @@ implementation
     procedure tstoredsymtable.insert(sym:TSymEntry;checkdup:boolean=true);
       begin
         inherited insert(sym,checkdup);
-        { keep track of syms whose type may need forward resolving later on }
-        if (sym.typ in [typesym,fieldvarsym]) then
-          forwardchecksyms.add(sym);
       end;
 
 
     procedure tstoredsymtable.delete(sym:TSymEntry);
       begin
-        { this must happen before inherited() is called, because }
-        { the sym is owned by symlist and will consequently be   }
-        { freed and invalid afterwards                           }
-        if (sym.typ in [typesym,fieldvarsym]) then
-          forwardchecksyms.remove(sym);
         inherited delete(sym);
       end;
 
@@ -645,7 +635,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;
 
@@ -662,11 +652,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;
 
 
 {***********************************************
@@ -711,12 +702,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
@@ -744,17 +729,6 @@ implementation
       end;
 
 
-    procedure tstoredsymtable.resolve_forward_types;
-      var
-        i: longint;
-      begin
-        for i:=0 to forwardchecksyms.Count-1 do
-          tstoredsym(forwardchecksyms[i]).resolve_type_forward;
-        { don't free, may still be reused }
-        forwardchecksyms.clear;
-      end;
-
-
 {****************************************************************************
                           TAbstractRecordSymtable
 ****************************************************************************}
@@ -835,7 +809,7 @@ implementation
         recordalignment:=max(recordalignment,varalignrecord);
       end;
 
-    procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym);
+    procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym;vis:tvisibility);
       var
         l      : aint;
         varalignfield,
@@ -846,6 +820,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 }
@@ -934,13 +910,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
@@ -1094,11 +1063,6 @@ implementation
             def:=TDef(unionst.DefList[i]);
             def.ChangeOwner(self);
           end;
-        { add the types that may need to be forward-checked }
-        forwardchecksyms.capacity:=forwardchecksyms.capacity+unionst.forwardchecksyms.count;
-        for i:=0 to unionst.forwardchecksyms.count-1 do
-          forwardchecksyms.add(tsym(unionst.forwardchecksyms[i]));
-        unionst.forwardchecksyms.clear;
         _datasize:=storesize;
         fieldalignment:=storealign;
       end;
@@ -1133,8 +1097,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 }
@@ -1528,7 +1493,7 @@ implementation
     procedure hidesym(sym:TSymEntry);
       begin
         sym.realname:='$hidden'+sym.realname;
-        include(tsym(sym).symoptions,sp_hidden);
+        tsym(sym).visibility:=vis_hidden;
       end;
 
 
@@ -1576,11 +1541,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;
@@ -1592,7 +1641,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
@@ -1600,17 +1648,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
@@ -1659,8 +1701,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
@@ -1719,21 +1763,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;
@@ -1937,54 +1982,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
@@ -2186,7 +2183,6 @@ implementation
        class_tobject:=nil;
        interface_iunknown:=nil;
        rec_tguid:=nil;
-       aktobjectdef:=nil;
        dupnr:=0;
      end;
 

compiler/symtype.pas

@@ -98,6 +98,7 @@ interface
       public
          fileinfo   : tfileposinfo;
          symoptions : tsymoptions;
+         visibility : tvisibility;
          refs       : longint;
          reflist    : TLinkedList;
          isdbgwritten : boolean;
@@ -106,11 +107,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);
@@ -196,9 +192,6 @@ interface
       memprocnodetree : tmemdebug;
 {$endif MEMDEBUG}
 
-    const
-       current_object_option : tsymoptions = [sp_public];
-
     function  FindUnitSymtable(st:TSymtable):TSymtable;
 
 
@@ -339,7 +332,7 @@ implementation
          symoptions:=[];
          fileinfo:=current_tokenpos;
          isdbgwritten := false;
-         symoptions:=current_object_option;
+         visibility:=vis_public;
       end;
 
     destructor  Tsym.destroy;
@@ -395,58 +388,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/systems.pas

@@ -408,6 +408,9 @@ interface
                                          system_x86_64_win64,
                                          system_ia64_win64]+system_linux;
 
+       { all systems for which weak linking has been tested/is supported }
+       system_weak_linking = systems_darwin;
+
        system_internal_sysinit = [system_i386_linux,system_i386_win32];
 
        system_embedded = [system_i386_embedded,system_m68k_embedded,system_alpha_embedded,

compiler/systems/i_amiga.pas

@@ -21,6 +21,8 @@
 { This unit implements support information structures for the AmigaOS. }
 unit i_amiga;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses

compiler/systems/i_atari.pas

@@ -21,6 +21,8 @@
 { This unit implements support information structures for atari. }
 unit i_atari;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses

compiler/systems/i_beos.pas

@@ -21,6 +21,8 @@
 { This unit implements support information structures for BeOS. }
 unit i_beos;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses

compiler/systems/i_bsd.pas

@@ -24,6 +24,8 @@
 
 unit i_bsd;
 
+{$i fpcdefs.inc}
+
   interface
 
     uses