Rebase to revision 17096

git-svn-id: branches/svenbarth/classhelpers@17099 -

.gitattributes

@@ -1344,7 +1344,6 @@ packages/cocoaint/src/foundation/NSXMLNode.inc svneol=native#text/plain
 packages/cocoaint/src/foundation/NSXMLNodeOptions.inc svneol=native#text/plain
 packages/cocoaint/src/foundation/NSXMLParser.inc svneol=native#text/plain
 packages/cocoaint/src/foundation/NSZone.inc svneol=native#text/plain
-packages/cocoaint/src/iPhoneAll.pas svneol=native#text/plain
 packages/cocoaint/src/quartzcore/AnonIncludeClassDefinitionsQuartzcore.inc svneol=native#text/plain
 packages/cocoaint/src/quartzcore/CAAnimation.inc svneol=native#text/plain
 packages/cocoaint/src/quartzcore/CABase.inc svneol=native#text/plain
@@ -1395,8 +1394,6 @@ packages/cocoaint/src/quartzcore/CVPixelBufferPool.inc svneol=native#text/plain
 packages/cocoaint/src/quartzcore/CVPixelFormatDescription.inc svneol=native#text/plain
 packages/cocoaint/src/quartzcore/CVReturn.inc svneol=native#text/plain
 packages/cocoaint/src/quartzcore/QuartzCore.inc svneol=native#text/plain
-packages/cocoaint/src/uikit/UIKit.inc svneol=native#text/plain
-packages/cocoaint/src/uikit/UndefinedClasses.inc svneol=native#text/plain
 packages/cocoaint/src/webkit/AnonIncludeClassDefinitionsWebkit.inc svneol=native#text/plain
 packages/cocoaint/src/webkit/CarbonUtils.inc svneol=native#text/plain
 packages/cocoaint/src/webkit/DOM.inc svneol=native#text/plain
@@ -1586,6 +1583,7 @@ packages/cocoaint/utils/parser.php svneol=native#text/plain
 packages/cocoaint/utils/patches/cocoa-coredata-webkit.patch svneol=native#text/plain
 packages/cocoaint/utils/patches/uikit-3.2.patch svneol=native#text/plain
 packages/cocoaint/utils/patches/uikit-4.2.patch svneol=native#text/plain
+packages/cocoaint/utils/source/docset.php svneol=native#text/plain
 packages/cocoaint/utils/source/objp.php svneol=native#text/plain
 packages/cocoaint/utils/source/objp_base.php svneol=native#text/plain
 packages/cocoaint/utils/source/utilities.php svneol=native#text/plain
@@ -2175,6 +2173,7 @@ packages/fcl-net/src/win/resolve.inc svneol=native#text/plain
 packages/fcl-passrc/Makefile svneol=native#text/plain
 packages/fcl-passrc/Makefile.fpc svneol=native#text/plain
 packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
+packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
 packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain
@@ -4396,6 +4395,182 @@ packages/libndsfpc/src/nds/timers.inc svneol=native#text/plain
 packages/libndsfpc/src/nds/touch.inc svneol=native#text/plain
 packages/libndsfpc/src/nds7.pp svneol=native#text/plain
 packages/libndsfpc/src/nds9.pp svneol=native#text/plain
+packages/libogcfpc/Makefile svneol=native#text/plain
+packages/libogcfpc/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/audio/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/audio/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/audio/modplay/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/audio/modplay/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/audio/modplay/data/technique.mod -text
+packages/libogcfpc/examples/audio/modplay/modplay.pp svneol=native#text/plain
+packages/libogcfpc/examples/audio/mp3player/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/audio/mp3player/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/audio/mp3player/data/sample.mp3 -text
+packages/libogcfpc/examples/audio/mp3player/playmp3.pp svneol=native#text/plain
+packages/libogcfpc/examples/devices/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/devices/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/devices/network/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/devices/network/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/devices/network/sockettest/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/devices/network/sockettest/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/devices/network/sockettest/sockettest.pp svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbgecko/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbgecko/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbgecko/gdbstub/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbgecko/gdbstub/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbgecko/gdbstub/gdb.txt svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbgecko/gdbstub/gdbstub.pp svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbkeyboard/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbkeyboard/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbkeyboard/basic_stdin/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbkeyboard/basic_stdin/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/devices/usbkeyboard/basic_stdin/basic_stdin.pp svneol=native#text/plain
+packages/libogcfpc/examples/filesystem/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/filesystem/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/filesystem/directory/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/filesystem/directory/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/filesystem/directory/directory.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/gxSprites/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/gxSprites/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/gxSprites/gxsprites.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/gxSprites/textures/ballsprites.png -text
+packages/libogcfpc/examples/graphics/gx/gxSprites/textures/textures.scf svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson1/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson1/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson1/lesson1.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson2/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson2/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson2/lesson2.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson3/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson3/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson3/lesson3.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson4/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson4/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson4/lesson4.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson5/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson5/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson5/lesson5.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson6/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson6/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson6/lesson6.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson6/textures/NeHe.bmp -text
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson6/textures/NeHe.scf svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson7/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson7/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson7/lesson7.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson7/textures/crate.bmp -text
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson7/textures/crate.scf svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson8/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson8/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson8/lesson8.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson8/textures/Glass.bmp -text
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson8/textures/glass.scf svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson9/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson9/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson9/lesson9.pp svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson9/textures/Star.bmp -text
+packages/libogcfpc/examples/graphics/gx/neheGX/lesson9/textures/startex.scf svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/triangle/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/triangle/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/graphics/gx/triangle/triangle.pp svneol=native#text/plain
+packages/libogcfpc/examples/template/Makefile svneol=native#text/plain
+packages/libogcfpc/examples/template/Makefile.fpc svneol=native#text/plain
+packages/libogcfpc/examples/template/template.pp svneol=native#text/plain
+packages/libogcfpc/fpmake.pp svneol=native#text/plain
+packages/libogcfpc/src/aesndlib.pp svneol=native#text/plain
+packages/libogcfpc/src/asndlib.pp svneol=native#text/plain
+packages/libogcfpc/src/bte/bd_addr.inc svneol=native#text/plain
+packages/libogcfpc/src/bte/bte.inc svneol=native#text/plain
+packages/libogcfpc/src/debug.inc svneol=native#text/plain
+packages/libogcfpc/src/debug.pp svneol=native#text/plain
+packages/libogcfpc/src/di/di.inc svneol=native#text/plain
+packages/libogcfpc/src/fat.pp svneol=native#text/plain
+packages/libogcfpc/src/gccore.inc svneol=native#text/plain
+packages/libogcfpc/src/gccore.pp svneol=native#text/plain
+packages/libogcfpc/src/gcmodplay.pp svneol=native#text/plain
+packages/libogcfpc/src/gctypes.pp svneol=native#text/plain
+packages/libogcfpc/src/iso9660.pp svneol=native#text/plain
+packages/libogcfpc/src/mp3player.pp svneol=native#text/plain
+packages/libogcfpc/src/network.pp svneol=native#text/plain
+packages/libogcfpc/src/ogc/aram.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/arqmgr.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/arqueue.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/audio.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/cache.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/card.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/cast.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/color.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/cond.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/conf.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/consol.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/context.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/disc_io.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/dsp.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/dvd.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/es.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/exi.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/gu.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/gx.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/gx_struct.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/ios.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/ipc.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/irq.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/isfs.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_config.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_heap.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_messages.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_mutex.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_objmgr.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_priority.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_queue.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_sema.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_stack.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_states.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_threadq.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_threads.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_tqdata.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_watchdog.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/lwp_wkspace.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/machine/asm.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/machine/processor.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/machine/spinlock.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/message.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/mutex.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/pad.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/semaphore.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/si.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/stm.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/sys_state.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/system.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/texconv.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/tpl.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/usb.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/usbgecko.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/usbmouse.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/usbstorage.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/video.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/video_types.inc svneol=native#text/plain
+packages/libogcfpc/src/ogc/wiilaunch.inc svneol=native#text/plain
+packages/libogcfpc/src/ogcsys.inc svneol=native#text/plain
+packages/libogcfpc/src/sdcard/card_buf.inc svneol=native#text/plain
+packages/libogcfpc/src/sdcard/card_cmn.inc svneol=native#text/plain
+packages/libogcfpc/src/sdcard/card_io.inc svneol=native#text/plain
+packages/libogcfpc/src/sdcard/gcsd.inc svneol=native#text/plain
+packages/libogcfpc/src/sdcard/wiisd_io.inc svneol=native#text/plain
+packages/libogcfpc/src/wiikeyboard/keyboard.inc svneol=native#text/plain
+packages/libogcfpc/src/wiikeyboard/usbkeyboard.inc svneol=native#text/plain
+packages/libogcfpc/src/wiikeyboard/wsksymdef.inc svneol=native#text/plain
+packages/libogcfpc/src/wiiuse/wiiuse.inc svneol=native#text/plain
+packages/libogcfpc/src/wiiuse/wpad.inc svneol=native#text/plain
 packages/libpng/Makefile svneol=native#text/plain
 packages/libpng/Makefile.fpc svneol=native#text/plain
 packages/libpng/fpmake.pp svneol=native#text/plain
@@ -8109,6 +8284,7 @@ tests/tbf/tb0216.pp svneol=native#text/plain
 tests/tbf/tb0217.pp svneol=native#text/plain
 tests/tbf/tb0218.pp svneol=native#text/plain
 tests/tbf/tb0219.pp svneol=native#text/pascal
+tests/tbf/tb0220.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
@@ -8870,10 +9046,12 @@ tests/test/cg/obj/tcext4.c -text
 tests/test/cg/obj/tcext5.c -text
 tests/test/cg/obj/tcext6.c svneol=native#text/plain
 tests/test/cg/obj/win32/i386/cpptcl1.o -text
+tests/test/cg/obj/win32/i386/cpptcl2.o -text
 tests/test/cg/obj/win32/i386/ctest.o -text
 tests/test/cg/obj/win32/i386/tcext3.o -text
 tests/test/cg/obj/win32/i386/tcext4.o -text
 tests/test/cg/obj/win32/i386/tcext5.o -text
+tests/test/cg/obj/win32/i386/tcext6.o -text
 tests/test/cg/obj/win64/x86_64/ctest.o -text svneol=unset#unset
 tests/test/cg/obj/win64/x86_64/tcext3.o -text svneol=unset#unset
 tests/test/cg/obj/win64/x86_64/tcext4.o -text svneol=unset#unset
@@ -9277,6 +9455,7 @@ tests/test/tarray4.pp svneol=native#text/plain
 tests/test/tarray5.pp svneol=native#text/plain
 tests/test/tarray6.pp svneol=native#text/plain
 tests/test/tarray7.pp svneol=native#text/plain
+tests/test/tarray8.pp svneol=native#text/plain
 tests/test/tasmread.pp svneol=native#text/plain
 tests/test/tasout.pp svneol=native#text/plain
 tests/test/tassignmentoperator1.pp svneol=native#text/pascal
@@ -11127,8 +11306,10 @@ tests/webtbs/tw18620.pp svneol=native#text/pascal
 tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
+tests/webtbs/tw18702.pp svneol=native#text/pascal
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw1883.pp svneol=native#text/plain
+tests/webtbs/tw18859.pp svneol=native#text/plain
 tests/webtbs/tw1888.pp svneol=native#text/plain
 tests/webtbs/tw1889.pp svneol=native#text/plain
 tests/webtbs/tw1896.pp svneol=native#text/plain
@@ -12181,7 +12362,6 @@ utils/fpmc/test.mc -text
 utils/fppkg/Makefile svneol=native#text/plain
 utils/fppkg/Makefile.fpc svneol=native#text/plain
 utils/fppkg/README.txt svneol=native#text/plain
-utils/fppkg/buildfppkg.pp svneol=native#text/plain
 utils/fppkg/examples/pkglibcurl.pp svneol=native#text/plain
 utils/fppkg/examples/pkgocurl.pp svneol=native#text/plain
 utils/fppkg/examples/pkgsynapse.pp svneol=native#text/plain

.gitignore

@@ -658,15 +658,6 @@ packages/cocoaint/src/foundation/build-stamp.*
 packages/cocoaint/src/foundation/fpcmade.*
 packages/cocoaint/src/foundation/units
 packages/cocoaint/src/fpcmade.*
-packages/cocoaint/src/uikit/*.bak
-packages/cocoaint/src/uikit/*.exe
-packages/cocoaint/src/uikit/*.o
-packages/cocoaint/src/uikit/*.ppu
-packages/cocoaint/src/uikit/*.s
-packages/cocoaint/src/uikit/Package.fpc
-packages/cocoaint/src/uikit/build-stamp.*
-packages/cocoaint/src/uikit/fpcmade.*
-packages/cocoaint/src/uikit/units
 packages/cocoaint/src/units
 packages/cocoaint/src/webkit/*.bak
 packages/cocoaint/src/webkit/*.exe
@@ -4328,6 +4319,9 @@ packages/libndsfpc/tests/build-stamp.*
 packages/libndsfpc/tests/fpcmade.*
 packages/libndsfpc/tests/units
 packages/libndsfpc/units
+packages/libogcfpc/examples/devices/network/sockettest/data
+packages/libogcfpc/examples/devices/usbgecko/gdbstub/data
+packages/libogcfpc/examples/devices/usbkeyboard/basic_stdin/data
 packages/libpng/*.bak
 packages/libpng/*.exe
 packages/libpng/*.o

compiler/aasmtai.pas

@@ -401,9 +401,9 @@ interface
        tai_datablock = class(tailineinfo)
           is_global : boolean;
           sym       : tasmsymbol;
-          size      : aint;
+          size      : asizeint;
           constructor Create(const _name : string;_size : aint);
-          constructor Create_global(const _name : string;_size : aint);
+          constructor Create_global(const _name : string;_size : asizeint);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure derefimpl;override;
@@ -883,7 +883,7 @@ implementation
       end;
 
 
-    constructor tai_datablock.Create_global(const _name : string;_size : aint);
+    constructor tai_datablock.Create_global(const _name : string;_size : asizeint);
       begin
          inherited Create;
          typ:=ait_datablock;

compiler/aoptobj.pas

@@ -991,6 +991,7 @@ Unit AoptObj;
                         strpnew('next label reused'))));
       {$endif finaldestdebug}
                       l.increfs;
+                      tasmlabel(hp.oper[0]^.ref^.symbol).decrefs;
                       hp.oper[0]^.ref^.symbol := l;
                       if not GetFinalDestination(hp,succ(level)) then
                         exit;
@@ -1037,6 +1038,12 @@ Unit AoptObj;
                                 (hp1.typ <> ait_label) do
                             if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
                               begin
+                                if (hp1.typ = ait_instruction) and
+                                   taicpu(hp1).is_jmp and
+                                   (taicpu(hp1).oper[0]^.typ = top_ref) and
+                                   assigned(taicpu(hp1).oper[0]^.ref^.symbol) and
+                                   (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) then
+                                   TAsmLabel(taicpu(hp1).oper[0]^.ref^.symbol).decrefs;
                                 asml.remove(hp1);
                                 hp1.free;
                               end
@@ -1051,6 +1058,7 @@ Unit AoptObj;
                             begin
                               hp2:=tai(hp1.next);
                               asml.remove(p);
+                              tasmlabel(taicpu(p).oper[0]^.ref^.symbol).decrefs;
                               p.free;
                               p:=hp2;
                               continue;

compiler/arm/cgcpu.pas

@@ -531,7 +531,7 @@ unit cgcpu;
     procedure tcgarm.a_call_reg(list : TAsmList;reg: tregister);
       begin
         { check not really correct: should only be used for non-Thumb cpus }
-        if (current_settings.cputype<cpu_armv6) then
+        if (current_settings.cputype<cpu_armv5) then
           begin
             list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
             list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,reg));

compiler/avr/aasmcpu.pas

@@ -73,6 +73,8 @@ uses
     function spilling_create_load(const ref:treference;r:tregister):Taicpu;
     function spilling_create_store(r:tregister; const ref:treference):Taicpu;
 
+    function setcondition(i : taicpu;c : tasmcond) : taicpu;
+
 implementation
 
 {*****************************************************************************
@@ -136,7 +138,7 @@ implementation
          inherited create(op);
          ops:=2;
          loadreg(0,_op1);
-         loadconst(1,_op2);
+         loadconst(1,aint(_op2));
       end;
 
      constructor taicpu.op_const_reg(op:tasmop; _op1: LongInt; _op2: tregister);
@@ -225,6 +227,8 @@ implementation
         case getregtype(r) of
           R_INTREGISTER :
             result:=taicpu.op_ref_reg(A_LD,ref,r);
+          R_ADDRESSREGISTER :
+            result:=taicpu.op_ref_reg(A_LD,ref,r);
           else
             internalerror(200401041);
         end;
@@ -236,6 +240,8 @@ implementation
         case getregtype(r) of
           R_INTREGISTER :
             result:=taicpu.op_reg_ref(A_ST,r,ref);
+          R_ADDRESSREGISTER :
+            result:=taicpu.op_reg_ref(A_ST,r,ref);
           else
             internalerror(200401041);
         end;
@@ -251,6 +257,14 @@ implementation
       begin
       end;
 
+
+    function setcondition(i : taicpu;c : tasmcond) : taicpu;
+      begin
+        i.condition:=c;
+        result:=i;
+      end;
+
+
 begin
   cai_cpu:=taicpu;
   cai_align:=tai_align;

compiler/avr/agavrgas.pas

@@ -43,10 +43,6 @@ unit agavrgas;
      end;
 
 
-    const
-      gas_shiftmode2str : array[tshiftmode] of string[3] = (
-        '','lsl','lsr','asr','ror','rrx');
-
   implementation
 
     uses
@@ -88,8 +84,6 @@ unit agavrgas;
 
             if assigned(symbol) then
               begin
-                if (base<>NR_NO) and not(is_pc(base)) then
-                  internalerror(200309011);
                 s:=symbol.name;
                 if offset<0 then
                   s:=s+tostr(offset)
@@ -106,9 +100,6 @@ unit agavrgas;
       end;
 
 
-    const
-      shiftmode2str: array[tshiftmode] of string[3] = ('','lsl','lsr','asr','ror','rrx');
-
     function getopstr(const o:toper) : string;
       var
         hs : string;

compiler/avr/cpubase.pas

@@ -48,10 +48,10 @@ unit cpubase;
         A_OR,A_ORI,A_EOR,A_COM,A_NEG,A_SBR,A_CBR,A_INC,A_DEC,A_TST,A_CLR,
         A_SER,A_MUL,A_MULS,A_FMUL,A_FMULS,A_FMULSU,A_RJMP,A_IJMP,
         A_EIJMP,A_JMP,A_RCALL,A_ICALL,R_EICALL,A_CALL,A_RET,A_RETI,A_CPSE,
-        A_CP,A_CPC,A_CPI,A_SBxx,A_BRxx,A_MOV,A_MOVW,A_LDI,A_LDS,A_LD,A_LDD,
+        A_CP,A_CPC,A_CPI,A_SBIC,A_SBIS,A_BRxx,A_MOV,A_MOVW,A_LDI,A_LDS,A_LD,A_LDD,
         A_STS,A_ST,A_STD,A_LPM,A_ELPM,A_SPM,A_IN,A_OUT,A_PUSH,A_POP,
         A_LSL,A_LSR,A_ROL,A_ROR,A_ASR,A_SWAP,A_BSET,A_BCLR,A_SBI,A_CBI,
-        A_BST,A_BLD,A_Sxx,A_Cxx,A_BRAK,A_NOP,A_SLEEP,A_WDR);
+        A_BST,A_BLD,A_Sxx,A_CLI,A_BRAK,A_NOP,A_SLEEP,A_WDR);
 
 
       { This should define the array of instructions as string }
@@ -63,7 +63,8 @@ unit cpubase;
       { Last value of opcode enumeration  }
       lastop  = high(tasmop);
 
-      jmp_instructions = [A_BRxx,A_SBxx,A_JMP,A_RCALL,A_ICALL,A_EIJMP,A_RJMP,A_CALL,A_RET,A_RETI,A_CPSE,A_IJMP];
+      jmp_instructions = [A_BRxx,A_SBIC,A_SBIS,A_JMP,A_RCALL,A_ICALL,A_EIJMP,
+                          A_RJMP,A_CALL,A_RET,A_RETI,A_CPSE,A_IJMP];
 
 {*****************************************************************************
                                   Registers
@@ -90,9 +91,13 @@ unit cpubase;
       NR_ZLO = NR_R30;
       NR_ZHI = NR_R31;
 
+      NIO_SREG = $3f;
+      NIO_SP_LO = $3d;
+      NIO_SP_HI = $3e;
+
       { Integer Super registers first and last }
       first_int_supreg = RS_R0;
-      first_int_imreg = $10;
+      first_int_imreg = $20;
 
       { Float Super register first and last }
       first_fpu_supreg    = RS_INVALID;
@@ -102,8 +107,7 @@ unit cpubase;
       first_mm_supreg    = RS_INVALID;
       first_mm_imreg     = RS_INVALID;
 
-{ TODO: Calculate bsstart}
-      regnumber_count_bsstart = 64;
+      regnumber_count_bsstart = 32;
 
       regnumber_table : array[tregisterindex] of tregister = (
         {$i ravrnum.inc}
@@ -129,19 +133,19 @@ unit cpubase;
 
     type
       TAsmCond=(C_None,
-        C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS,
-        C_GE,C_LT,C_GT,C_LE,C_AL,C_NV
+        C_CC,C_CS,C_EQ,C_GE,C_HC,C_HS,C_ID,C_IE,C_LO,C_LT,
+        C_MI,C_NE,C_PL,C_SH,C_TC,C_TS,C_VC,C_VS
       );
 
     const
       cond2str : array[TAsmCond] of string[2]=('',
-        'eq','ne','cs','cc','mi','pl','vs','vc','hi','ls',
-        'ge','lt','gt','le','al','nv'
+        'cc','cs','eq','ge','hc','hs','id','ie','lo','lt',
+        'mi','ne','pl','sh','tc','ts','vc','vs'
       );
 
       uppercond2str : array[TAsmCond] of string[2]=('',
-        'EQ','NE','CS','CC','MI','PL','VS','VC','HI','LS',
-        'GE','LT','GT','LE','AL','NV'
+        'CC','CS','EQ','GE','HC','HS','ID','IE','LO','LT',
+        'MI','NE','PL','SH','TC','TS','VC','VS'
       );
 
 {*****************************************************************************
@@ -149,25 +153,14 @@ unit cpubase;
 *****************************************************************************}
 
     type
-      TResFlags = (F_EQ,F_NE,F_CS,F_CC,F_MI,F_PL,F_VS,F_VC,F_HI,F_LS,
-        F_GE,F_LT,F_GT,F_LE);
+      TResFlags = (F_NotPossible,F_CC,F_CS,F_EQ,F_GE,F_LO,F_LT,
+        F_NE,F_SH,F_VC,F_VS);
 
 {*****************************************************************************
                                 Operands
 *****************************************************************************}
 
-      taddressmode = (AM_OFFSET,AM_PREINDEXED,AM_POSTINDEXED);
-      tshiftmode = (SM_None,SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX);
-
-      tupdatereg = (UR_None,UR_Update);
-
-      pshifterop = ^tshifterop;
-
-      tshifterop = record
-        shiftmode : tshiftmode;
-        rs : tregister;
-        shiftimm : byte;
-      end;
+      taddressmode = (AM_UNCHANGED,AM_POSTINCREMENT,AM_PREDRECEMENT);
 
 {*****************************************************************************
                                  Constants
@@ -342,11 +335,12 @@ unit cpubase;
     function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
 
-    function is_pc(const r : tregister) : boolean;
-
     function dwarf_reg(r:tregister):byte;
     function GetHigh(const r : TRegister) : TRegister;
 
+    { returns the next virtual register }
+    function GetNextReg(const r : TRegister) : TRegister;
+
   implementation
 
     uses
@@ -374,16 +368,14 @@ unit cpubase;
 
 
     function reg_cgsize(const reg: tregister): tcgsize;
-      const subreg2cgsize:array[Tsubregister] of Tcgsize =
-            (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO);
       begin
         case getregtype(reg) of
           R_INTREGISTER :
-            reg_cgsize:=OS_32;
-          R_FPUREGISTER :
-            reg_cgsize:=OS_F80;
+            reg_cgsize:=OS_8;
+          R_ADDRESSREGISTER :
+            reg_cgsize:=OS_16;
           else
-            internalerror(200303181);
+            internalerror(2011021905);
           end;
         end;
 
@@ -391,8 +383,8 @@ unit cpubase;
     procedure inverse_flags(var f: TResFlags);
       const
         inv_flags: array[TResFlags] of TResFlags =
-          (F_NE,F_EQ,F_CC,F_CS,F_PL,F_MI,F_VC,F_VS,F_LS,F_HI,
-          F_LT,F_GE,F_LE,F_GT);
+          (F_NotPossible,F_CS,F_CC,F_NE,F_LT,F_SH,F_GE,
+           F_NE,F_LO,F_VS,F_VC);
       begin
         f:=inv_flags[f];
       end;
@@ -400,10 +392,12 @@ unit cpubase;
 
     function flags_to_cond(const f: TResFlags) : TAsmCond;
       const
-        flag_2_cond: array[F_EQ..F_LE] of TAsmCond =
-          (C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS,
-           C_GE,C_LT,C_GT,C_LE);
+        flag_2_cond: array[F_CC..F_VS] of TAsmCond =
+          (C_CC,C_CS,C_EQ,C_GE,C_LO,C_LT,
+           C_NE,C_SH,C_VC,C_VS);
       begin
+        if f=F_NotPossible then
+          internalerror(2011022101);
         if f>high(flag_2_cond) then
           internalerror(200112301);
         result:=flag_2_cond[f];
@@ -434,24 +428,11 @@ unit cpubase;
       end;
 
 
-    procedure shifterop_reset(var so : tshifterop);
-      begin
-        FillChar(so,sizeof(so),0);
-      end;
-
-
-    function is_pc(const r : tregister) : boolean;
-      begin
-        is_pc:=(r=NR_R15);
-      end;
-
-
     function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
       const
         inverse: array[TAsmCond] of TAsmCond=(C_None,
-          C_NE,C_EQ,C_CC,C_CS,C_PL,C_MI,C_VC,C_VS,C_LS,C_HI,
-          C_LT,C_GE,C_LE,C_GT,C_None,C_None
-        );
+          C_CS,C_CC,C_NE,C_LT,C_HS,C_HC,C_IE,C_ID,C_SH,C_GE,
+          C_PL,C_EQ,C_MI,C_LO,C_TS,C_TC,C_VS,C_VC);
       begin
         result := inverse[c];
       end;
@@ -482,4 +463,10 @@ unit cpubase;
         result:=TRegister(longint(r)+1)
       end;
 
+
+    function GetNextReg(const r: TRegister): TRegister;
+      begin
+        result:=TRegister(longint(r)+1);
+      end;
+
 end.

compiler/avr/cpupara.pas

@@ -109,10 +109,7 @@ unit cpupara;
             orddef:
               getparaloc:=LOC_REGISTER;
             floatdef:
-              if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then
-                getparaloc:=LOC_REGISTER
-              else
-                getparaloc:=LOC_FPUREGISTER;
+              getparaloc:=LOC_REGISTER;
             enumdef:
               getparaloc:=LOC_REGISTER;
             pointerdef:

compiler/avr/itcpugas.pas

@@ -39,10 +39,10 @@ interface
         'or','ori','eor','com','neg','sbr','cbr','inc','dec','tst','clr',
         'ser','mul','muls','fmul','fmuls','fmulsu','rjmp','ijmp',
         'eijmp','jmp','rcall','icall','eicall','call','ret','reti','cpse',
-        'cp','cpc','cpi','sb','br','mov','movw','ldi','lds','ld','ldd',
+        'cp','cpc','cpi','sbic','sbis','br','mov','movw','ldi','lds','ld','ldd',
         'sts','st','std','lpm','elpm','spm','in','out','push','pop',
         'lsl','lsr','rol','ror','asr','swap','bset','bclr','sbi','cbi',
-        'bst','bld','s','c','brak','nop','sleep','wdr');
+        'bst','bld','s','cli','brak','nop','sleep','wdr');
 
     function gas_regnum_search(const s:string):Tregister;
     function gas_regname(r:Tregister):string;

compiler/avr/navradd.pas

@@ -70,22 +70,22 @@ interface
                 if nf_swapped in flags then
                   case NodeType of
                     ltn:
-                      GetResFlags:=F_GT;
+                      GetResFlags:=F_NotPossible;
                     lten:
                       GetResFlags:=F_GE;
                     gtn:
                       GetResFlags:=F_LT;
                     gten:
-                      GetResFlags:=F_LE;
+                      GetResFlags:=F_NotPossible;
                   end
                 else
                   case NodeType of
                     ltn:
                       GetResFlags:=F_LT;
                     lten:
-                      GetResFlags:=F_LE;
+                      GetResFlags:=F_NotPossible;
                     gtn:
-                      GetResFlags:=F_GT;
+                      GetResFlags:=F_NotPossible;
                     gten:
                       GetResFlags:=F_GE;
                   end;
@@ -95,22 +95,22 @@ interface
                 if nf_swapped in Flags then
                   case NodeType of
                     ltn:
-                      GetResFlags:=F_HI;
+                      GetResFlags:=F_NotPossible;
                     lten:
                       GetResFlags:=F_CS;
                     gtn:
                       GetResFlags:=F_CC;
                     gten:
-                      GetResFlags:=F_LS;
+                      GetResFlags:=F_NotPossible;
                   end
                 else
                   case NodeType of
                     ltn:
                       GetResFlags:=F_CC;
                     lten:
-                      GetResFlags:=F_LS;
+                      GetResFlags:=F_NotPossible;
                     gtn:
-                      GetResFlags:=F_HI;
+                      GetResFlags:=F_NotPossible;
                     gten:
                       GetResFlags:=F_CS;
                   end;
@@ -173,6 +173,9 @@ interface
         unsigned:=not(is_signed(left.resultdef)) or
                   not(is_signed(right.resultdef));
 
+        if getresflags(unsigned)=F_NotPossible then
+          swapleftright;
+
         current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,left.location.register,right.location.register));
         tmpreg1:=left.location.register;
         tmpreg2:=right.location.register;

compiler/avr/navrmat.pas

@@ -80,7 +80,6 @@ implementation
         helper2,
         resultreg  : tregister;
         size       : Tcgsize;
-        so : tshifterop;
        procedure genOrdConstNodeDiv;
          begin
 {

compiler/avr/raavrgas.pas

@@ -136,16 +136,16 @@ Unit raavrgas;
 
     Procedure tavrattreader.BuildReference(oper : tavroperand);
 
-      procedure Consume_RBracket;
+      procedure Consume_RParen;
         begin
-          if actasmtoken<>AS_RBRACKET then
+          if actasmtoken<>AS_RPAREN then
            Begin
              Message(asmr_e_invalid_reference_syntax);
              RecoverConsume(true);
            end
           else
            begin
-             Consume(AS_RBRACKET);
+             Consume(AS_RPAREN);
              if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
               Begin
                 Message(asmr_e_invalid_reference_syntax);
@@ -172,30 +172,22 @@ Unit raavrgas;
 
 
       begin
-        Consume(AS_LBRACKET);
+        Consume(AS_LPAREN);
         if actasmtoken=AS_REGISTER then
           begin
             oper.opr.ref.base:=actasmregister;
             Consume(AS_REGISTER);
             { can either be a register or a right parenthesis }
             { (reg)        }
-            if actasmtoken=AS_RBRACKET then
+            if actasmtoken=AS_LPAREN then
              Begin
-               Consume_RBracket;
-               oper.opr.ref.addressmode:=AM_POSTINDEXED;
-               if actasmtoken=AS_COMMA then
-                 read_index;
+               Consume_RParen;
                exit;
              end;
-            if actasmtoken=AS_COMMA then
+            if actasmtoken=AS_PLUS then
               begin
-                read_index;
-                Consume_RBracket;
-              end;
-            if actasmtoken=AS_NOT then
-              begin
-                consume(AS_NOT);
-                oper.opr.ref.addressmode:=AM_PREINDEXED;
+                consume(AS_PLUS);
+                oper.opr.ref.addressmode:=AM_POSTINCREMENT;
               end;
           end {end case }
         else

compiler/cgbase.pas

@@ -85,6 +85,10 @@ interface
          addr_highesta     // bits 48-63, adjusted
          {$ENDIF}
          {$ENDIF}
+         {$IFDEF AVR}
+         ,addr_lo8
+         ,addr_hi8
+         {$ENDIF}
          );
 
 
@@ -327,8 +331,8 @@ interface
     {# From a constant numeric value, return the abstract code generator
        size.
     }
-    function int_cgsize(const a: aint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
-    function int_float_cgsize(const a: aint): tcgsize;
+    function int_cgsize(const a: tcgint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
+    function int_float_cgsize(const a: tcgint): tcgsize;
 
     { return the inverse condition of opcmp }
     function inverse_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif}
@@ -585,7 +589,7 @@ implementation
       end;
 
 
-    function int_cgsize(const a: aint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
+    function int_cgsize(const a: tcgint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
       const
         size2cgsize : array[0..8] of tcgsize = (
           OS_NO,OS_8,OS_16,OS_NO,OS_32,OS_NO,OS_NO,OS_NO,OS_64
@@ -598,7 +602,7 @@ implementation
       end;
 
 
-    function int_float_cgsize(const a: aint): tcgsize;
+    function int_float_cgsize(const a: tcgint): tcgsize;
       begin
         case a of
           4 :

compiler/cgobj.pas

@@ -451,6 +451,8 @@ unit cgobj;
 
           procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
           procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
+          procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
+            const name: string);
           procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);
           procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);
 
@@ -3580,6 +3582,45 @@ implementation
         cgpara1.done;
       end;
 
+    procedure tcg.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
+      var
+        cgpara1,cgpara2,cgpara3: TCGPara;
+        href: TReference;
+        hreg, lenreg: TRegister;
+      begin
+        cgpara1.init;
+        cgpara2.init;
+        cgpara3.init;
+        paramanager.getintparaloc(pocall_default,1,cgpara1);
+        paramanager.getintparaloc(pocall_default,2,cgpara2);
+        paramanager.getintparaloc(pocall_default,3,cgpara3);
+
+        reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
+        if highloc.loc in [LOC_REGISTER,LOC_CREGISTER] then
+          hreg:=highloc.register
+        else
+          begin
+            hreg:=getintregister(list,OS_INT);
+            a_load_loc_reg(list,OS_INT,highloc,hreg);
+          end;
+        { increment, converts high(x) to length(x) }
+        lenreg:=getintregister(list,OS_INT);
+        a_op_const_reg_reg(list,OP_ADD,OS_INT,1,hreg,lenreg);
+
+        a_load_reg_cgpara(list,OS_INT,lenreg,cgpara3);
+        a_loadaddr_ref_cgpara(list,href,cgpara2);
+        a_loadaddr_ref_cgpara(list,ref,cgpara1);
+        paramanager.freecgpara(list,cgpara1);
+        paramanager.freecgpara(list,cgpara2);
+        paramanager.freecgpara(list,cgpara3);
+        allocallcpuregisters(list);
+        a_call_name(list,name,false);
+        deallocallcpuregisters(list);
+
+        cgpara3.done;
+        cgpara2.done;
+        cgpara1.done;
+      end;
 
     procedure tcg.g_initialize(list : TAsmList;t : tdef;const ref : treference);
       var
@@ -3866,7 +3907,7 @@ implementation
            a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
            cgpara1.init;
            paramanager.getintparaloc(pocall_default,1,cgpara1);
-           a_load_const_cgpara(list,OS_INT,210,cgpara1);
+           a_load_const_cgpara(list,OS_INT,aint(210),cgpara1);
            paramanager.freecgpara(list,cgpara1);
            a_call_name(list,'FPC_HANDLEERROR',false);
            a_label(list,oklabel);

compiler/cgutils.pas

@@ -36,7 +36,7 @@ unit cgutils;
       { reference record, reordered for best alignment }
       preference = ^treference;
       treference = record
-         offset      : aint;
+         offset      : asizeint;
          symbol,
          relsymbol   : tasmsymbol;
 {$if defined(x86) or defined(m68k)}

compiler/dbgdwarf.pas

@@ -1701,10 +1701,10 @@ implementation
 
     procedure TDebugInfoDwarf.appenddef_string(list:TAsmList;def:tstringdef);
 
-      procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: aword);
+      procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: asizeuint);
         var
           { maxlen can be > high(int64) }
-          slen : aword;
+          slen : asizeuint;
           arr : tasmlabel;
         begin
           { fix length of openshortstring }
@@ -1782,9 +1782,13 @@ implementation
               }
 {$ifdef cpu64bitaddr}
               addnormalstringdef('LongString',u64inttype,qword(1024*1024));
-{$else cpu64bitaddr}
-              addnormalstringdef('LongString',u32inttype,cardinal(1024*1024));
 {$endif cpu64bitaddr}
+{$ifdef cpu32bitaddr}
+              addnormalstringdef('LongString',u32inttype,cardinal(1024*1024));
+{$endif cpu32bitaddr}
+{$ifdef cpu16bitaddr}
+              addnormalstringdef('LongString',u16inttype,cardinal(1024));
+{$endif cpu16bitaddr}
            end;
          st_ansistring:
            begin
@@ -2453,7 +2457,7 @@ implementation
       var
         bitoffset,
         fieldoffset,
-        fieldnatsize: aint;
+        fieldnatsize: asizeint;
       begin
         if (sp_static in sym.symoptions) or
            (sym.visibility=vis_hidden) then

compiler/dbgstabs.pas

@@ -354,7 +354,7 @@ implementation
     procedure TDebugInfoStabs.field_add_stabstr(p:TObject;arg:pointer);
       var
         spec    : string[3];
-        varsize : aint;
+        varsize : asizeint;
         newss   : ansistring;
         ss      : pansistring absolute arg;
       begin
@@ -379,8 +379,13 @@ implementation
                 varsize:=tfieldvarsym(p).vardef.size;
                 { open arrays made overflows !! }
                 { how can a record/object/class contain an open array? (JM) }
+{$ifdef cpu16bitaddr}
+                if varsize>$fff then
+                  varsize:=$fff;
+{$else cpu16bitaddr}
                 if varsize>$fffffff then
                   varsize:=$fffffff;
+{$endif cpu16bitaddr}
                 newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)),
                                      spec+def_stab_number(tfieldvarsym(p).vardef),
                                      tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)*8),tostr(varsize*8)])

compiler/fpcdefs.inc

@@ -112,12 +112,13 @@
 {$endif m68k}
 
 {$ifdef avr}
-  {$define cpu16bit}
+  {$define cpu8bit}
   {$define cpu16bitaddr}
-  {$define cpu16bitalu}
+  {$define cpu8bitalu}
   {$define cpuflags}
   {$define cpunofpu}
   {$define cpunodefaultint}
+  {$define cpuneedsdiv32helper}
 {$endif avr}
 
 {$ifdef mipsel}

compiler/globals.pas

@@ -718,7 +718,86 @@ implementation
                           Default Macro Handling
 ****************************************************************************}
 
+{$ifdef windows}
+{
+  This code is copied from sysutils.pp
+}
+     Type
+       PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall;
+
+     var
+       SHGetFolderPath : PFNSHGetFolderPath = Nil;
+       CFGDLLHandle : THandle = 0;
+
+     const
+       CSIDL_PERSONAL                = $0005; { %USERPROFILE%\My Documents                                       }
+       CSIDL_APPDATA                 = $001A; { %USERPROFILE%\Application Data (roaming)                         }
+       CSIDL_LOCAL_APPDATA           = $001C; { %USERPROFILE%\Local Settings\Application Data (non roaming)      }
+       CSIDL_COMMON_APPDATA          = $0023; { %PROFILESPATH%\All Users\Application Data                        }
+       CSIDL_PROGRAM_FILES           = $0026; { %SYSTEMDRIVE%\Program Files                                      }
+       CSIDL_PROFILE                 = $0028; { %USERPROFILE%                                                    }
+       CSIDL_PROGRAM_FILES_COMMON    = $002B; { %SYSTEMDRIVE%\Program Files\Common                               }
+
+       CSIDL_FLAG_CREATE             = $8000; { (force creation of requested folder if it doesn't exist yet)     }
+
+
+     Procedure InitDLL;
+       Var
+         pathBuf: array[0..MAX_PATH-1] of char;
+         pathLength: Integer;
+       begin
+         { Load shfolder.dll using a full path, in order to prevent spoofing (Mantis #18185)
+           Don't bother loading shell32.dll because shfolder.dll itself redirects SHGetFolderPath
+           to shell32.dll whenever possible. }
+         pathLength:=GetSystemDirectory(pathBuf, MAX_PATH);
+         if (pathLength>0) and (pathLength<MAX_PATH-14) then { 14=length('\shfolder.dll'#0) }
+           begin
+             StrLCopy(@pathBuf[pathLength],'\shfolder.dll',MAX_PATH-pathLength-1);
+             CFGDLLHandle:=LoadLibrary(pathBuf);
+             if (CFGDLLHandle<>0) then
+               begin
+                 Pointer(ShGetFolderPath):=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+                 If @ShGetFolderPath=nil then
+                   begin
+                     FreeLibrary(CFGDLLHandle);
+                     CFGDllHandle:=0;
+                   end;
+               end;
+           end;
+         If (@ShGetFolderPath=Nil) then
+           Raise Exception.Create('Could not determine SHGetFolderPath Function');
+       end;
+
+
+     Function GetSpecialDir(ID :  Integer) : String;
+
+       Var
+         APath : Array[0..MAX_PATH] of char;
+
+       begin
+         Result:='';
+         if (CFGDLLHandle=0) then
+           InitDLL;
+         If (SHGetFolderPath<>Nil) then
+           begin
+             if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then
+               Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0]));
+           end;
+       end;
+{$endif windows}
+
+
      procedure DefaultReplacements(var s:ansistring);
+       {$ifdef windows}
+       procedure ReplaceSpecialFolder(const MacroName: string; const ID: integer);
+         begin
+           // Only try to receive the special folders (and thus dynamically
+           // load shfolder.dll) when that's needed.
+           if pos(MacroName,s)>0 then
+             Replace(s,MacroName,GetSpecialDir(ID));
+         end;
+
+       {$endif windows}
        var
          envstr: string;
          envvalue: pchar;
@@ -734,6 +813,15 @@ implementation
            Replace(s,'$FPCTARGET',target_os_string)
          else
            Replace(s,'$FPCTARGET',target_full_string);
+{$ifdef windows}
+         ReplaceSpecialFolder('$LOCAL_APPDATA',CSIDL_LOCAL_APPDATA);
+         ReplaceSpecialFolder('$APPDATA',CSIDL_APPDATA);
+         ReplaceSpecialFolder('$COMMON_APPDATA',CSIDL_COMMON_APPDATA);
+         ReplaceSpecialFolder('$PERSONAL',CSIDL_PERSONAL);
+         ReplaceSpecialFolder('$PROGRAM_FILES',CSIDL_PROGRAM_FILES);
+         ReplaceSpecialFolder('$PROGRAM_FILES_COMMON',CSIDL_PROGRAM_FILES_COMMON);
+         ReplaceSpecialFolder('$PROFILE',CSIDL_PROFILE);
+{$endif windows}
          { Replace environment variables between dollar signs }
          i := pos('$',s);
          while i>0 do
@@ -1493,4 +1581,10 @@ implementation
         features:=[low(Tfeature)..high(Tfeature)];
      end;
 
+{$ifdef windows}
+initialization
+finalization
+  if CFGDLLHandle<>0 then
+    FreeLibrary(CFGDllHandle);
+{$endif windows}
 end.

compiler/globtype.pas

@@ -70,11 +70,25 @@ interface
      Const
        AIntBits = 16;
 {$endif cpu16bitalu}
+{$ifdef cpu8bitalu}
+       AWord = Byte;
+       AInt = Shortint;
+
+     Const
+       AIntBits = 8;
+{$endif cpu8bitalu}
 
      Type
        PAWord = ^AWord;
        PAInt = ^AInt;
 
+       { target cpu specific type used to store data sizes }
+       ASizeInt = PInt;
+       ASizeUInt = PUInt;
+
+       { type used for handling constants etc. in the code generator }
+       TCGInt = Int64;
+
        { This must be an ordinal type with the same size as a pointer
          Note: Must be unsigned! Otherwise, ugly code like
          pointer(-1) will result in a pointer with the value

compiler/link.pas

@@ -703,7 +703,7 @@ Implementation
 
     Function TExternalLinker.MakeStaticLibrary:boolean;
 
-        function GetNextFiles(const maxCmdLength : AInt; var item : TCmdStrListItem) : TCmdStr;
+        function GetNextFiles(const maxCmdLength : Longint; var item : TCmdStrListItem) : TCmdStr;
           begin
             result := '';
             while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin

compiler/msg/errord.msg

@@ -3,7 +3,7 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of SVN revision 15850
+#   Based on errore.msg of SVN revision 16783
 #
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2010 by the Free Pascal Development team
@@ -378,7 +378,7 @@ scanner_w_illegal_warn_identifier=02087_W_Ung
 #
 # Parser
 #
-# 03295 is the last used one
+# 03304 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -636,7 +636,7 @@ parser_e_void_function=03080_E_Prozeduren k
 % In \fpc, you can specify a return value for a function when using
 % the \var{exit} statement. This error occurs when you try to do this with a
 % procedure. Procedures cannot return a value.
-parser_e_only_methods_allowed=03081_E_Konstruktoren, Destructoren und class operators m�ssen Methoden sein
+parser_e_only_methods_allowed=03081_E_Konstruktoren, Destruktoren und Klassenoperatoren m�ssen Methoden sein
 % You're declaring a procedure as destructor, constructor or class operator, when the
 % procedure isn't a class method.
 parser_e_operator_not_overloaded=03082_E_Operator besitzt kein Overload
@@ -1089,7 +1089,7 @@ parser_e_protected_or_private_expected=03214_E_Protected oder private erwartet
 parser_e_illegal_slice=03215_E_SLICE kann nicht ausserhalb der Parameterliste benutzt werden
 % \var{slice} can be used only for arguments accepting an open array parameter.
 parser_e_dispinterface_cant_have_parent=03216_E_Ein DISPINTERFACE kann keine Elternklasse haben.
-% A DISPINTERFACE is a special type of interface which can't have a parent class.
+% A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type.
 parser_e_dispinterface_needs_a_guid=03217_E_Ein DISPINTERFACE ben”tigt einen GUID
 % A DISPINTERFACE always needs an interface identification (a GUID).
 parser_w_overridden_methods_not_same_ret=03218_W_šberschriebene Methoden m�ssen einen entsprechenden R�ckgabetyp haben. Dieser Code kann abst�rzen, weil er von einem Delphi Parser Bug abh„ngt (Methode "$2" wird durch "$1" �berschrieben, die einen anderen R�ckgabetyp hat).
@@ -1117,7 +1117,7 @@ parser_e_packed_element_no_loop=03223_E_Bit packed Array-Elemente und Record-Fel
 % (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will
 % be packed at the bit level. For performance reasons, they cannot be
 % used as loop variables.
-parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb records, objects und Klassen erlaubt
+parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb Records, Objekten und Klassen erlaubt
 % The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside
 % records, objects and classes.
 parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein
@@ -1194,7 +1194,7 @@ parser_e_field_not_allowed_here=03251_E_Felder sind nach der Definition einer Me
 % without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is
 % that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers
 % such as \var{default} and \var{register} also as field names.
-parser_e_no_local_para_def=03252_E_Parameter k”nnen keine lokalen Typdeklarationen enthalten. Verwende eine getrennte Typdefinition in einem "type"-Block
+parser_e_no_local_para_def=03252_E_Parameter oder Ergebnistypen k”nnen keine lokalen Typdeklarationen enthalten. Verwende eine getrennte Typdefinition in einem "type"-Block
 % In Pascal, types are not considered to be identical simply because they are semantically equivalent.
 % Two variables or parameters are only considered to be of the same type if they refer to the
 % same type definition.
@@ -1258,14 +1258,16 @@ parser_e_no_objc_published=03271_E_Objective-C Klassen k
 parser_f_need_objc=03272_F_Dieses Modul erfordert, dass der Objective-C Mode-Schalter �bersetzt wird
 % This error indicates the use of Objective-C language features without an Objective-C mode switch
 % active. Enable one via the -M command line switch, or the {\$modeswitch x} directive.
-parser_e_must_use_override_objc=03273_E_Vererbte Methoden k”nnen nur in Objective-C �berschrieben werden, f�ge "override" hinzu.
-parser_h_should_use_override_objc=03274_H_Vererbte Methoden k”nnen nur in Objective-C �berschrieben werden, f�ge "override" hinzu
+parser_e_must_use_override_objc=03273_E_Vererbte Methoden k”nnen nur in Objective-C �berschrieben werden, f�ge "override" hinzu (Vererbte Methode ist in $1 definiert)
+parser_h_should_use_override_objc=03274_H_Vererbte Methoden k”nnen nur in Objective-C �berschrieben werden, f�ge "override" hinzu (Vererbte Methode ist in $1 definiert)
 % It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same
 % name always map to the same virtual method entry. In order to make this clear in the source code,
 % the compiler always requires the \var{override} directive to be specified when implementing overriding
 % Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C
 % does not have any \var{override}-style keyword (since it's the default and only behaviour in that language),
 % which makes it hard for automated header conversion tools to include it everywhere.
+% The type in which the inherited method is defined is explicitly mentioned, because this may either
+% be an objcclass or an objccategory.
 parser_e_objc_message_name_changed=03275_E_Der Nachrichtenname "$1" in der vererbten Klasse unterscheidet sich vom Nachrichtennamen "$2" in der aktuellen Klasse
 % An overriding Objective-C method cannot have a different message name than an inherited method. The reason
 % is that these message names uniquely define the message to the Objective-C runtime, which means that
@@ -1277,8 +1279,8 @@ parser_e_no_category_as_types=03277_E_Objective-C Kategorien k
 % It is not possible to declare a variable as an instance of an Objective-C category. A
 % category adds methods to the scope of an existing class, but does not define a type by itself.
 parser_e_no_category_override=03278_E_Kategorien �berschreiben Methoden nicht, sondern ersetzen sie. "reintroduce" benutzen
-parser_e_must_use_reintroduce_objc=03279_E_Ersetzte Methoden k”nnen in Objective-C nur wieder eingef�hrt werden, f�ge "reintroduce" hinzu
-parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden k”nnen in Objective-C nur wieder eingef�hrt werden, f�ge "reintroduce" hinzu
+parser_e_must_use_reintroduce_objc=03279_E_Ersetzte Methoden k”nnen in Objective-C nur wieder eingef�hrt werden, f�ge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert)
+parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden k”nnen in Objective-C nur wieder eingef�hrt werden, f�ge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert)
 % A category replaces an existing method in an Objective-C class, rather than that it overrides it.
 % Calling an inherited method from an category method will call that method in
 % the extended class' parent, not in the extended class itself. The
@@ -1286,6 +1288,8 @@ parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden k
 % called or referred to. This behaviour corresponds somewhat more closely to
 % \var{reintroduce} than to \var{override} (although in case of \var{reintroduce}
 % in Object Pascal, hidden methods are still reachable via inherited).
+% The type in which the inherited method is defined is explicitly mentioned, because this may either
+% be an objcclass or an objccategory.
 parser_e_implements_getter_not_default_cc=03281_E_Getter f�r das Interface implements m�ssen die voreingestellte calling convention des Ziels benutzen
 % Interface getters are called via a helper in the run time library, and hence
 % have to use the default calling convention for the target (\var{register} on
@@ -1342,6 +1346,36 @@ parser_e_no_procvarnested_const=03296_E_Typisierte Konstanten des Typs 'procedur
 % procedural variable contains a reference to a nested procedure/function.
 % Therefore such typed constants can only be initialized with global
 % functions/procedures since these do not require a parent frame pointer.
+parser_f_no_generic_inside_generic=03297_F_Die Deklaration einer generischen Klasse innerhalb einer anderen generischen Klasse ist nicht erlaubt
+% At the moment, scanner supports recording of only one token buffer at the time
+% (guarded by internal error 200511173 in tscannerfile.startrecordtokens).
+% Since generics are implemented by recording tokens, it is not possible to
+% have declaration of generic class inside another generic class.
+parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Vorw„rts-Deklarationen des ObjC-Protokolls "$1" m�ssen aufgel”st sein, bevor eine ObjC-Klasse ihr folgen kann
+% An objcprotocol must be fully defined before classes can conform to it.
+% This error occurs in the following situation:
+% \begin{verbatim}
+%  Type MyProtocol = objcprotoocl;
+%       ChildClass = Class(NSObject,MyProtocol)
+%         ...
+%       end;
+% \end{verbatim}
+% where \var{MyProtocol} is declared but not defined.
+parser_e_no_record_published=03299_E_Record -Typen k”nnen keine ”ffentlichen Abschnitte (published sections) haben
+% Published sections can be used only inside classes.
+parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records nicht erlaubt
+% Destructor declarations aren't allowed in records.
+parser_e_class_methods_only_static_in_records=03301_E_Klassenmethoden m�ssen in Records statisch sein
+% Class methods declarations aren't allowed in records without static modifier.
+% Records have no inheritance and therefore non static class methods have no sence for them.
+parser_e_no_constructor_in_records=03302_E_Konstruktoren sind in Records nicht erlaubt
+% Constructor declarations aren't allowed in records.
+parser_e_at_least_one_argument_must_be_of_type=03303_E_Entweder das Ergebnis oder mindestens ein Parameter m�ssen vom Typ "$1" sein
+% It is required that either the result of the routine or at least one of its parameters be of the specified type.
+% For example class operators either take an instance of the structured type in which they are defined, or they return one.
+parser_e_cant_use_type_parameters_here=03304_E_Typ-Parameter k”nnen initialization/finalization erfordern - Sie k”nnen deshalb nicht in varianten Rekords verwendet werden
+% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization
+% code which is implicitly generated by the compiler. 
 %
 % \end{description}
 # EndOfTeX
@@ -1349,7 +1383,7 @@ parser_e_no_procvarnested_const=03296_E_Typisierte Konstanten des Typs 'procedur
 #
 # Type Checking
 #
-# 04095 is the last used one
+# 04098 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1693,6 +1727,10 @@ type_w_procvar_univ_conflicting_para=04095_W_Erzwungener univ Parameter Typ in e
 % when \var{test} returns.
 type_e_generics_cannot_reference_itself=04096_E_Typ-Parameter bei der Spezialisation von Generics k”nnen den aktuel spezialisierten Typ nicht referenzieren
 % Recursive specializations of generics like \var{Type MyType = specialize MyGeneric<MyType>;} are not possible.
+type_e_type_parameters_are_not_allowed_here=04097_E_Typ-Parameter sind f�r nicht-generische Klassen/Record/Objekte Prozeduren und Funktionen nicht erlaubt
+% Type parameters are only allowed for methods of generic classes, records or objects
+type_e_generic_declaration_does_not_match=04098_E_Die generische Deklaration von "$1" unterscheidet sich vom der vorherigen Deklaration
+% Generic declaration does not match the previous declaration
 %
 % \end{description}
 # EndOfTeX
@@ -1700,7 +1738,7 @@ type_e_generics_cannot_reference_itself=04096_E_Typ-Parameter bei der Spezialisa
 #
 # Symtable
 #
-# 05080 is the last used one
+# 05083 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -1939,6 +1977,11 @@ sym_e_objc_formal_class_not_resolved=05080_E_Die vollst
 % of the class to be in scope.
 sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos in die 'initialization'- oder 'finalization'-Bl”cke einer Unit sind nicht erlaubt
 % Gotos into initialization or finalization blockse of units are not allowed.
+sym_e_external_class_name_mismatch1=05082=E_Ung�ltiger externer Name "$1" f�r die formale Klasse "$2"
+sym_e_external_class_name_mismatch2=05083=E_Hierhin muss die vollst„ndige Klassendefinition mit externem Namen "$1"
+% When a class is declared using a formal external definition, the actual external
+% definition (if any) must specify the same external name as the formal definition
+% (since both definitions refer to the same actual class type).
 %
 % \end{description}
 # EndOfTeX
@@ -1946,7 +1989,7 @@ sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos in die 'initi
 #
 # Codegenerator
 #
-# 06050 is the last used one
+# 06052 is the last used one
 #
 % \section{Code generator messages}
 % This section lists all messages that can be displayed if the code
@@ -2083,6 +2126,9 @@ cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Interprozedurale g
 % from a subroutine to the main program
 cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label m�ssen im selben Bereich definiert werden, in dem sie deklariert werden
 % In ISO mode, labels must be defined in the same scope as they are declared.
+cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Excpetion Frames enth„lt, darf nicht mit einem goto verlassen werden
+% Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures
+% which use automated types like ansistrings or class constructurs are affected by this too.
 %
 % \end{description}
 # EndOfTeX
@@ -2090,7 +2136,7 @@ cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label m
 #
 # Assembler reader
 #
-# 07109 is the last used one
+# 07110 is the last used one
 #
 asmr_d_start_reading=07000_DL_Starte $1 Stil Assembler Parsen
 % This informs you that an assembler block is being parsed
@@ -2343,6 +2389,9 @@ asmr_e_empty_regset=07109_E_Ein Registerset kann nicht leer sein
 % Instructions on the ARM architecture that take a register set as argument require that such a set
 % contains at least one register.
 
+asmr_w_useless_got_for_local=07110_W_@GOTPCREL ist nutzlos und bei lokalen Symbole m”glicherweise gef„hrlich
+% The use of @GOTPCREL supposes an extra indirection that is
+% not present if the symbol is local, which might lead to wrong asembler code
 #
 # Assembler/binary writers
 #
@@ -3107,7 +3156,8 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 *g2gw_Erzeuge DWARFv2-Debug-Informationen (wie -gw2)
 *g2gw2_Erzeuge DWARFv2-Debug-Informationen
 *g2gw3_Erzeuge DWARFv3-Debug-Informationen
-**1i_Zeige alle Information �ber den Compiler
+*g2gw4_Generate DWARFv4-Debug-Informationen (experimentell)
+**1i_Zeige alle Informationen �ber den Compiler
 **2iD_Zeige Compilerdatum
 **2iV_Zeige Compilerversion
 **2iW_Zeige vollst„ndige Compilerversion
@@ -3171,6 +3221,7 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 **2st_Erzeuge Script um auf dem Zielsystem zu linken
 **2sr_šberspringe die Phase der "register allocation" (mit -alr benutzen)
 **1T<x>_Zielbetriebssystem::
+3*2Tdarwin_Darwin/Mac OS X
 3*2Temx_OS/2 via EMX (einschliesslich EMX/RSX extender)
 3*2Tfreebsd_FreeBSD
 3*2Tgo32v2_Version 2 des DJ Delorie DOS extender
@@ -3182,23 +3233,27 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 3*2Tos2_OS/2 / eComStation
 3*2Tsunos_SunOS/Solaris
 3*2Tsymbian_Symbian OS
+3*2Tsolaris_Solaris
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twdosx_WDOSX DOS extender
 3*2Twin32_Windows 32 Bit
 3*2Twince_Windows CE
+4*2Tdarwin_Darwin/Mac OS X
+4*2Twin64_Win64 (64 bit Windows systems)
 4*2Tlinux_Linux
 6*2Tamiga_Commodore Amiga
 6*2Tatari_Atari ST/STe/TT
-6*2Tlinux_Linux-68k
-6*2Tmacos_Macintosh m68k (nicht unterst�tzt)
+6*2Tlinux_Linux
 6*2Tpalmos_PalmOS
+A*2Tdarwin_Darwin/iPhoneOS/iOS
 A*2Tlinux_Linux
 A*2Twince_Windows CE
-P*2Tamiga_AmigaOS auf PowerPC
-P*2Tdarwin_Darwin und Mac OS X auf PowerPC
-P*2Tlinux_Linux auf PowerPC
-P*2Tmacos_Mac OS (classic) auf PowerPC
+P*2Tamiga_AmigaOS
+P*2Tdarwin_Darwin und Mac OS X
+P*2Tlinux_Linux
+P*2Tmacos_Mac OS (classic)
 P*2Tmorphos_MorphOS
+S*2Tsolaris_Solaris
 S*2Tlinux_Linux
 **1u<x>_Entferne die Definition f�r das Symbol <x>
 **1U<x>_Unit-Optionen:

compiler/msg/errordu.msg

@@ -3,7 +3,7 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of SVN revision 15850
+#   Based on errore.msg of SVN revision 16783
 #
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2010 by the Free Pascal Development team
@@ -378,7 +378,7 @@ scanner_w_illegal_warn_identifier=02087_W_Ungültige Bezeichner "$1" für die $W
 #
 # Parser
 #
-# 03295 is the last used one
+# 03304 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -636,7 +636,7 @@ parser_e_void_function=03080_E_Prozeduren können keinen Wert zurückliefern
 % In \fpc, you can specify a return value for a function when using
 % the \var{exit} statement. This error occurs when you try to do this with a
 % procedure. Procedures cannot return a value.
-parser_e_only_methods_allowed=03081_E_Konstruktoren, Destructoren und Class operators müssen Methoden sein
+parser_e_only_methods_allowed=03081_E_Konstruktoren, Destruktoren und Klassenoperatoren müssen Methoden sein
 % You're declaring a procedure as destructor, constructor or class operator, when the
 % procedure isn't a class method.
 parser_e_operator_not_overloaded=03082_E_Operator besitzt kein Overload
@@ -1089,7 +1089,7 @@ parser_e_protected_or_private_expected=03214_E_Protected oder private erwartet
 parser_e_illegal_slice=03215_E_SLICE kann nicht ausserhalb der Parameterliste benutzt werden
 % \var{slice} can be used only for arguments accepting an open array parameter.
 parser_e_dispinterface_cant_have_parent=03216_E_Ein DISPINTERFACE kann keine Elternklasse haben.
-% A DISPINTERFACE is a special type of interface which can't have a parent class.
+% A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type.
 parser_e_dispinterface_needs_a_guid=03217_E_Ein DISPINTERFACE benötigt einen GUID
 % A DISPINTERFACE always needs an interface identification (a GUID).
 parser_w_overridden_methods_not_same_ret=03218_W_Überschriebene Methoden müssen einen entsprechenden Rückgabetyp haben. Dieser Code kann abstürzen, weil er von einem Delphi Parser Bug abhängt (Methode "$2" wird durch "$1" überschrieben, die einen anderen Rückgabetyp hat).
@@ -1117,7 +1117,7 @@ parser_e_packed_element_no_loop=03223_E_Bit packed Array-Elemente und Record-Fel
 % (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will
 % be packed at the bit level. For performance reasons, they cannot be
 % used as loop variables.
-parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb records, objects und Klassen erlaubt
+parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb Records, Objekten und Klassen erlaubt
 % The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside
 % records, objects and classes.
 parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein
@@ -1194,7 +1194,7 @@ parser_e_field_not_allowed_here=03251_E_Felder sind nach der Definition einer Me
 % without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is
 % that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers
 % such as \var{default} and \var{register} also as field names.
-parser_e_no_local_para_def=03252_E_Parameter können keine lokalen Typdeklarationen enthalten. Verwende eine getrennte Typdefinition in einem "type"-Block
+parser_e_no_local_para_def=03252_E_Parameter oder Ergebnistypen können keine lokalen Typdeklarationen enthalten. Verwende eine getrennte Typdefinition in einem "type"-Block
 % In Pascal, types are not considered to be identical simply because they are semantically equivalent.
 % Two variables or parameters are only considered to be of the same type if they refer to the
 % same type definition.
@@ -1258,14 +1258,16 @@ parser_e_no_objc_published=03271_E_Objective-C Klassen können keinen Abschnitt
 parser_f_need_objc=03272_F_Dieses Modul erfordert, dass der Objective-C Mode-Schalter übersetzt wird
 % This error indicates the use of Objective-C language features without an Objective-C mode switch
 % active. Enable one via the -M command line switch, or the {\$modeswitch x} directive.
-parser_e_must_use_override_objc=03273_E_Vererbte Methoden können nur in Objective-C überschrieben werden, füge "override" hinzu.
-parser_h_should_use_override_objc=03274_H_Vererbte Methoden können nur in Objective-C überschrieben werden, füge "override" hinzu
+parser_e_must_use_override_objc=03273_E_Vererbte Methoden können nur in Objective-C überschrieben werden, füge "override" hinzu (Vererbte Methode ist in $1 definiert)
+parser_h_should_use_override_objc=03274_H_Vererbte Methoden können nur in Objective-C überschrieben werden, füge "override" hinzu (Vererbte Methode ist in $1 definiert)
 % It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same
 % name always map to the same virtual method entry. In order to make this clear in the source code,
 % the compiler always requires the \var{override} directive to be specified when implementing overriding
 % Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C
 % does not have any \var{override}-style keyword (since it's the default and only behaviour in that language),
 % which makes it hard for automated header conversion tools to include it everywhere.
+% The type in which the inherited method is defined is explicitly mentioned, because this may either
+% be an objcclass or an objccategory.
 parser_e_objc_message_name_changed=03275_E_Der Nachrichtenname "$1" in der vererbten Klasse unterscheidet sich vom Nachrichtennamen "$2" in der aktuellen Klasse
 % An overriding Objective-C method cannot have a different message name than an inherited method. The reason
 % is that these message names uniquely define the message to the Objective-C runtime, which means that
@@ -1277,8 +1279,8 @@ parser_e_no_category_as_types=03277_E_Objective-C Kategorien können nicht als T
 % It is not possible to declare a variable as an instance of an Objective-C category. A
 % category adds methods to the scope of an existing class, but does not define a type by itself.
 parser_e_no_category_override=03278_E_Kategorien überschreiben Methoden nicht, sondern ersetzen sie. "reintroduce" benutzen
-parser_e_must_use_reintroduce_objc=03279_E_Ersetzte Methoden können in Objective-C nur wieder eingeführt werden, füge "reintroduce" hinzu
-parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden können in Objective-C nur wieder eingeführt werden, füge "reintroduce" hinzu
+parser_e_must_use_reintroduce_objc=03279_E_Ersetzte Methoden können in Objective-C nur wieder eingeführt werden, füge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert)
+parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden können in Objective-C nur wieder eingeführt werden, füge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert)
 % A category replaces an existing method in an Objective-C class, rather than that it overrides it.
 % Calling an inherited method from an category method will call that method in
 % the extended class' parent, not in the extended class itself. The
@@ -1286,6 +1288,8 @@ parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden können in Object
 % called or referred to. This behaviour corresponds somewhat more closely to
 % \var{reintroduce} than to \var{override} (although in case of \var{reintroduce}
 % in Object Pascal, hidden methods are still reachable via inherited).
+% The type in which the inherited method is defined is explicitly mentioned, because this may either
+% be an objcclass or an objccategory.
 parser_e_implements_getter_not_default_cc=03281_E_Getter für das Interface implements müssen die voreingestellte calling convention des Ziels benutzen
 % Interface getters are called via a helper in the run time library, and hence
 % have to use the default calling convention for the target (\var{register} on
@@ -1342,6 +1346,36 @@ parser_e_no_procvarnested_const=03296_E_Typisierte Konstanten des Typs 'procedur
 % procedural variable contains a reference to a nested procedure/function.
 % Therefore such typed constants can only be initialized with global
 % functions/procedures since these do not require a parent frame pointer.
+parser_f_no_generic_inside_generic=03297_F_Die Deklaration einer generischen Klasse innerhalb einer anderen generischen Klasse ist nicht erlaubt
+% At the moment, scanner supports recording of only one token buffer at the time
+% (guarded by internal error 200511173 in tscannerfile.startrecordtokens).
+% Since generics are implemented by recording tokens, it is not possible to
+% have declaration of generic class inside another generic class.
+parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Vorwärts-Deklarationen des ObjC-Protokolls "$1" müssen aufgelöst sein, bevor eine ObjC-Klasse ihr folgen kann
+% An objcprotocol must be fully defined before classes can conform to it.
+% This error occurs in the following situation:
+% \begin{verbatim}
+%  Type MyProtocol = objcprotoocl;
+%       ChildClass = Class(NSObject,MyProtocol)
+%         ...
+%       end;
+% \end{verbatim}
+% where \var{MyProtocol} is declared but not defined.
+parser_e_no_record_published=03299_E_Record -Typen können keine öffentlichen Abschnitte (published sections) haben
+% Published sections can be used only inside classes.
+parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records nicht erlaubt
+% Destructor declarations aren't allowed in records.
+parser_e_class_methods_only_static_in_records=03301_E_Klassenmethoden müssen in Records statisch sein
+% Class methods declarations aren't allowed in records without static modifier.
+% Records have no inheritance and therefore non static class methods have no sence for them.
+parser_e_no_constructor_in_records=03302_E_Konstruktoren sind in Records nicht erlaubt
+% Constructor declarations aren't allowed in records.
+parser_e_at_least_one_argument_must_be_of_type=03303_E_Entweder das Ergebnis oder mindestens ein Parameter müssen vom Typ "$1" sein
+% It is required that either the result of the routine or at least one of its parameters be of the specified type.
+% For example class operators either take an instance of the structured type in which they are defined, or they return one.
+parser_e_cant_use_type_parameters_here=03304_E_Typ-Parameter können initialization/finalization erfordern - Sie können deshalb nicht in varianten Rekords verwendet werden
+% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization
+% code which is implicitly generated by the compiler. 
 %
 % \end{description}
 # EndOfTeX
@@ -1349,7 +1383,7 @@ parser_e_no_procvarnested_const=03296_E_Typisierte Konstanten des Typs 'procedur
 #
 # Type Checking
 #
-# 04095 is the last used one
+# 04098 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1693,6 +1727,10 @@ type_w_procvar_univ_conflicting_para=04095_W_Erzwungener univ Parameter Typ in e
 % when \var{test} returns.
 type_e_generics_cannot_reference_itself=04096_E_Typ-Parameter bei der Spezialisation von Generics können den aktuel spezialisierten Typ nicht referenzieren
 % Recursive specializations of generics like \var{Type MyType = specialize MyGeneric<MyType>;} are not possible.
+type_e_type_parameters_are_not_allowed_here=04097_E_Typ-Parameter sind für nicht-generische Klassen/Record/Objekte Prozeduren und Funktionen nicht erlaubt
+% Type parameters are only allowed for methods of generic classes, records or objects
+type_e_generic_declaration_does_not_match=04098_E_Die generische Deklaration von "$1" unterscheidet sich vom der vorherigen Deklaration
+% Generic declaration does not match the previous declaration
 %
 % \end{description}
 # EndOfTeX
@@ -1700,7 +1738,7 @@ type_e_generics_cannot_reference_itself=04096_E_Typ-Parameter bei der Spezialisa
 #
 # Symtable
 #
-# 05080 is the last used one
+# 05083 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -1939,6 +1977,11 @@ sym_e_objc_formal_class_not_resolved=05080_E_Die vollständige Definition der fo
 % of the class to be in scope.
 sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos in die 'initialization'- oder 'finalization'-Blöcke einer Unit sind nicht erlaubt
 % Gotos into initialization or finalization blockse of units are not allowed.
+sym_e_external_class_name_mismatch1=05082=E_Ungültiger externer Name "$1" für die formale Klasse "$2"
+sym_e_external_class_name_mismatch2=05083=E_Hierhin muss die vollständige Klassendefinition mit externem Namen "$1"
+% When a class is declared using a formal external definition, the actual external
+% definition (if any) must specify the same external name as the formal definition
+% (since both definitions refer to the same actual class type).
 %
 % \end{description}
 # EndOfTeX
@@ -1946,7 +1989,7 @@ sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos in die 'initi
 #
 # Codegenerator
 #
-# 06050 is the last used one
+# 06052 is the last used one
 #
 % \section{Code generator messages}
 % This section lists all messages that can be displayed if the code
@@ -2083,6 +2126,9 @@ cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Interprozedurale g
 % from a subroutine to the main program
 cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label müssen im selben Bereich definiert werden, in dem sie deklariert werden
 % In ISO mode, labels must be defined in the same scope as they are declared.
+cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Excpetion Frames enthält, darf nicht mit einem goto verlassen werden
+% Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures
+% which use automated types like ansistrings or class constructurs are affected by this too.
 %
 % \end{description}
 # EndOfTeX
@@ -2090,7 +2136,7 @@ cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label müssen im s
 #
 # Assembler reader
 #
-# 07109 is the last used one
+# 07110 is the last used one
 #
 asmr_d_start_reading=07000_DL_Starte $1 Stil Assembler Parsen
 % This informs you that an assembler block is being parsed
@@ -2343,6 +2389,9 @@ asmr_e_empty_regset=07109_E_Ein Registerset kann nicht leer sein
 % Instructions on the ARM architecture that take a register set as argument require that such a set
 % contains at least one register.
 
+asmr_w_useless_got_for_local=07110_W_@GOTPCREL ist nutzlos und bei lokalen Symbole möglicherweise gefährlich
+% The use of @GOTPCREL supposes an extra indirection that is
+% not present if the symbol is local, which might lead to wrong asembler code
 #
 # Assembler/binary writers
 #
@@ -3107,7 +3156,8 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 *g2gw_Erzeuge DWARFv2-Debug-Informationen (wie -gw2)
 *g2gw2_Erzeuge DWARFv2-Debug-Informationen
 *g2gw3_Erzeuge DWARFv3-Debug-Informationen
-**1i_Zeige alle Information über den Compiler
+*g2gw4_Generate DWARFv4-Debug-Informationen (experimentell)
+**1i_Zeige alle Informationen über den Compiler
 **2iD_Zeige Compilerdatum
 **2iV_Zeige Compilerversion
 **2iW_Zeige vollständige Compilerversion
@@ -3171,6 +3221,7 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 **2st_Erzeuge Script um auf dem Zielsystem zu linken
 **2sr_Überspringe die Phase der "register allocation" (mit -alr benutzen)
 **1T<x>_Zielbetriebssystem::
+3*2Tdarwin_Darwin/Mac OS X
 3*2Temx_OS/2 via EMX (einschliesslich EMX/RSX extender)
 3*2Tfreebsd_FreeBSD
 3*2Tgo32v2_Version 2 des DJ Delorie DOS extender
@@ -3182,23 +3233,27 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 3*2Tos2_OS/2 / eComStation
 3*2Tsunos_SunOS/Solaris
 3*2Tsymbian_Symbian OS
+3*2Tsolaris_Solaris
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twdosx_WDOSX DOS extender
 3*2Twin32_Windows 32 Bit
 3*2Twince_Windows CE
+4*2Tdarwin_Darwin/Mac OS X
 4*2Tlinux_Linux
+4*2Twin64_Win64 (64 bit Windows systems)
 6*2Tamiga_Commodore Amiga
 6*2Tatari_Atari ST/STe/TT
-6*2Tlinux_Linux-68k
-6*2Tmacos_Macintosh m68k (nicht unterstützt)
+6*2Tlinux_Linux
 6*2Tpalmos_PalmOS
+A*2Tdarwin_Darwin/iPhoneOS/iOS
 A*2Tlinux_Linux
 A*2Twince_Windows CE
-P*2Tamiga_AmigaOS auf PowerPC
-P*2Tdarwin_Darwin und Mac OS X auf PowerPC
-P*2Tlinux_Linux auf PowerPC
-P*2Tmacos_Mac OS (classic) auf PowerPC
+P*2Tamiga_AmigaOS
+P*2Tdarwin_Darwin und Mac OS X
+P*2Tlinux_Linux
+P*2Tmacos_Mac OS (classic)
 P*2Tmorphos_MorphOS
+S*2Tsolaris_Solaris
 S*2Tlinux_Linux
 **1u<x>_Entferne die Definition für das Symbol <x>
 **1U<x>_Unit-Optionen:

compiler/ncgmat.pas

@@ -368,7 +368,7 @@ implementation
                   cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,hdenom,hl);
                   paraloc1.init;
                   paramanager.getintparaloc(pocall_default,1,paraloc1);
-                  cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_S32,200,paraloc1);
+                  cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_S32,aint(200),paraloc1);
                   paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
                   cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR',false);
                   paraloc1.done;

compiler/ncgutil.pas

@@ -1302,9 +1302,13 @@ implementation
     const
 {$ifdef cpu64bitalu}
       trashintvalues: array[0..nroftrashvalues-1] of aint = ($5555555555555555,aint($AAAAAAAAAAAAAAAA),aint($EFEFEFEFEFEFEFEF),0);
-{$else cpu64bitalu}
-      trashintvalues: array[0..nroftrashvalues-1] of aint = ($55555555,aint($AAAAAAAA),aint($EFEFEFEF),0);
 {$endif cpu64bitalu}
+{$ifdef cpu32bitalu}
+      trashintvalues: array[0..nroftrashvalues-1] of aint = ($55555555,aint($AAAAAAAA),aint($EFEFEFEF),0);
+{$endif cpu32bitalu}
+{$ifdef cpu8bitalu}
+      trashintvalues: array[0..nroftrashvalues-1] of aint = ($55,aint($AA),aint($EF),0);
+{$endif cpu8bitalu}
 
     procedure trash_reference(list: TAsmList; const ref: treference; size: aint);
       var
@@ -1557,6 +1561,8 @@ implementation
     procedure init_paras(p:TObject;arg:pointer);
       var
         href : treference;
+        hsym : tparavarsym;
+        eldef : tdef;
         tmpreg : tregister;
         list : TAsmList;
         needs_inittable,
@@ -1580,7 +1586,18 @@ implementation
                      paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
                      begin
                        location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
-                       cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
+                       if is_open_array(tparavarsym(p).vardef) then
+                         begin
+                           { open arrays do not contain correct element count in their rtti,
+                             the actual count must be passed separately. }
+                           hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                           eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                           if not assigned(hsym) then
+                             internalerror(201003031);
+                           cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_ADDREF_ARRAY');
+                         end
+                       else
+                         cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
                      end;
                  end;
              vs_out :
@@ -1605,7 +1622,18 @@ implementation
                        else
                          trash_reference(list,href,2);
                      if needs_inittable then
-                       cg.g_initialize(list,tparavarsym(p).vardef,href);
+                       begin
+                         if is_open_array(tparavarsym(p).vardef) then
+                           begin
+                             hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                             eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                             if not assigned(hsym) then
+                               internalerror(201103033);
+                             cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
+                           end
+                         else
+                           cg.g_initialize(list,tparavarsym(p).vardef,href);
+                       end;
                    end;
                end;
              else if do_trashing and
@@ -1638,6 +1666,8 @@ implementation
       var
         list : TAsmList;
         href : treference;
+        hsym : tparavarsym;
+        eldef : tdef;
       begin
         if not(tsym(p).typ=paravarsym) then
           exit;
@@ -1648,7 +1678,16 @@ implementation
             begin
               include(current_procinfo.flags,pi_needs_implicit_finally);
               location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
-              cg.g_decrrefcount(list,tparavarsym(p).vardef,href);
+              if is_open_array(tparavarsym(p).vardef) then
+                begin
+                  hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                  eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                  if not assigned(hsym) then
+                    internalerror(201003032);
+                  cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_DECREF_ARRAY');
+                end
+              else
+                cg.g_decrrefcount(list,tparavarsym(p).vardef,href);
             end;
          end;
         { open arrays can contain elements requiring init/final code, so the else has been removed here }
@@ -2444,7 +2483,7 @@ implementation
 
     procedure insertbssdata(sym : tstaticvarsym);
       var
-        l : aint;
+        l : asizeint;
         varalign : shortint;
         storefilepos : tfileposinfo;
         list : TAsmList;

compiler/ogbase.pas

@@ -1505,8 +1505,13 @@ implementation
         { sections }
         FExeSectionList:=TFPHashObjectList.Create(true);
         FImageBase:=0;
+{$ifdef cpu16bitaddr}
+        SectionMemAlign:=$10;
+        SectionDataAlign:=$10;
+{$else cpu16bitaddr}
         SectionMemAlign:=$1000;
         SectionDataAlign:=$200;
+{$endif cpu16bitaddr}
         FCExeSection:=TExeSection;
         FCObjData:=TObjData;
       end;

compiler/parabase.pas

@@ -63,7 +63,7 @@ unit parabase;
 
        TCGPara = object
           Location  : PCGParalocation;
-          IntSize   : aint; { size of the total location in bytes }
+          IntSize   : tcgint; { size of the total location in bytes }
           Alignment : ShortInt;
           Size      : TCGSize;  { Size of the parameter included in all locations }
 {$ifdef powerpc}

compiler/pinline.pas

@@ -620,14 +620,12 @@ implementation
          begin
            destppn:=tcallparanode(ppn.right);
            { create call to fpc_initialize/finalize_array }
-           npara:=ccallparanode.create(cordconstnode.create
-                     (destppn.left.resultdef.size,s32inttype,true),
-                  ccallparanode.create(ctypeconvnode.create
+           npara:=ccallparanode.create(ctypeconvnode.create
                      (ppn.left,s32inttype),
                   ccallparanode.create(caddrnode.create_internal
                      (crttinode.create(tstoreddef(destppn.left.resultdef),initrtti,rdt_normal)),
                   ccallparanode.create(caddrnode.create_internal
-                     (destppn.left),nil))));
+                     (destppn.left),nil)));
            if isinit then
              newblock:=ccallnode.createintern('fpc_initialize_array',npara)
            else

compiler/pp.lpi

@@ -25,9 +25,9 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="-n -Fuc:\svn\fpcbranches\classhelpers\rtl\units\i386-win32 -Fu. c:\svn\fpcbranches\classhelpers\tests\test\tchlp42.pp"/>
+        <CommandLineParams Value="-n -Fuc:\svn\fpcbranches\classhelpers\rtl\units\i386-win32 -Futests\test -FEtestoutput c:\svn\fpcbranches\classhelpers\tests\test\tchlp84.pp"/>
         <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
-        <WorkingDirectory Value="c:\svn\fpcbranches\classhelpers\tests\test"/>
+        <WorkingDirectory Value="c:\svn\fpcbranches\classhelpers\"/>
       </local>
     </RunParams>
     <Units Count="2">

compiler/ppcavr.lpi

@@ -1,8 +1,8 @@
 <?xml version="1.0"?>
 <CONFIG>
   <ProjectOptions>
+    <Version Value="9"/>
     <PathDelim Value="\"/>
-    <Version Value="7"/>
     <General>
       <Flags>
         <MainUnitHasUsesSectionForAllUnits Value="False"/>
@@ -12,9 +12,11 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <TargetFileExt Value=".exe"/>
       <Title Value="pp"/>
     </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@@ -40,14 +42,14 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="8"/>
+    <Version Value="9"/>
     <PathDelim Value="\"/>
     <Target>
       <Filename Value="avr\pp"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="avr\"/>
-      <OtherUnitFiles Value="avr\;systems\"/>
+      <IncludeFiles Value="avr"/>
+      <OtherUnitFiles Value="avr;systems"/>
       <UnitOutputDirectory Value="avr\lazbuild"/>
     </SearchPaths>
     <Parsing>
@@ -55,6 +57,7 @@
         <CStyleOperator Value="False"/>
         <AllowLabel Value="False"/>
         <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
     <Linking>
@@ -71,8 +74,7 @@
       <ConfigFile>
         <StopAfterErrCount Value="50"/>
       </ConfigFile>
-      <CustomOptions Value="-davr
-"/>
+      <CustomOptions Value="-davr"/>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>

compiler/ppu.pas

@@ -257,6 +257,7 @@ type
     function getint64:int64;
     function  getqword:qword;
     function getaint:aint;
+    function getasizeint:asizeint;
     function getaword:aword;
     function  getreal:ppureal;
     function  getstring:string;
@@ -718,6 +719,16 @@ begin
 end;
 
 
+function tppufile.getasizeint:asizeint;
+begin
+{$ifdef cpu64bitaddr}
+  result:=getint64;
+{$else cpu64bitaddr}
+  result:=getlongint;
+{$endif cpu32bitaddr}
+end;
+
+
 function tppufile.getaword:aword;
 begin
 {$ifdef cpu64bitalu}

compiler/psystem.pas

@@ -217,18 +217,26 @@ implementation
         ptruinttype:=u64inttype;
         ptrsinttype:=s64inttype;
 {$endif cpu64bitaddr}
-{$ifdef cpu32bit}
-        uinttype:=u32inttype;
-        sinttype:=s32inttype;
+{$ifdef cpu32bitaddr}
         ptruinttype:=u32inttype;
         ptrsinttype:=s32inttype;
-{$endif cpu32bit}
-{$ifdef cpu16bit}
-        uinttype:=u16inttype;
-        sinttype:=s16inttype;
+{$endif cpu32bitaddr}
+{$ifdef cpu32bitalu}
+        uinttype:=u32inttype;
+        sinttype:=s32inttype;
+{$endif cpu32bitalu}
+{$ifdef cpu16bitaddr}
         ptruinttype:=u16inttype;
         ptrsinttype:=s16inttype;
-{$endif cpu16bit}
+{$endif cpu16bitaddr}
+{$ifdef cpu16bitalu}
+        uinttype:=u16inttype;
+        sinttype:=s16inttype;
+{$endif cpu16bitalu}
+{$ifdef cpu8bitalu}
+        uinttype:=u8inttype;
+        sinttype:=s8inttype;
+{$endif cpu8bitalu}
         { some other definitions }
         voidpointertype:=tpointerdef.create(voidtype);
         charpointertype:=tpointerdef.create(cchartype);

compiler/ptconst.pas

@@ -171,7 +171,7 @@ implementation
       threc = record
         list   : tasmlist;
         origsym: tstaticvarsym;
-        offset:  aint;
+        offset:  asizeint;
       end;
 
     { this procedure reads typed constants }
@@ -829,7 +829,7 @@ implementation
         var
           n : tnode;
           i : longint;
-          len : aint;
+          len : asizeint;
           ch  : array[0..1] of char;
           ca  : pbyte;
           int_const: tai_const;

compiler/ptype.pas

@@ -1187,8 +1187,8 @@ implementation
                                     Message(parser_e_array_lower_less_than_upper_bound);
                                     highval:=lowval;
                                   end
-                                 else if (lowval<int64(low(aint))) or
-                                         (highval > high(aint)) then
+                                 else if (lowval<int64(low(asizeint))) or
+                                         (highval>high(asizeint)) then
                                    begin
                                      Message(parser_e_array_range_out_of_bounds);
                                      lowval :=0;

compiler/symdef.pas

@@ -70,7 +70,7 @@ interface
           procedure buildderefimpl;override;
           procedure deref;override;
           procedure derefimpl;override;
-          function  size:aint;override;
+          function  size:asizeint;override;
           function  getvardef:longint;override;
           function  alignment:shortint;override;
           function  is_publishable : boolean;override;
@@ -83,7 +83,7 @@ interface
           { generics }
           procedure initgeneric;
        private
-          savesize  : aint;
+          savesize  : asizeuint;
        end;
 
        tfiletyp = (ft_text,ft_typed,ft_untyped);
@@ -205,7 +205,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
-          function  size:aint;override;
+          function  size:asizeint;override;
           function  alignment : shortint;override;
           function  padalignment: shortint;
           function  GetTypeName:string;override;
@@ -302,7 +302,7 @@ interface
           procedure resetvmtentries;
           procedure copyvmtentries(objdef:tobjectdef);
           function  getparentdef:tdef;override;
-          function  size : aint;override;
+          function  size : asizeint;override;
           function  alignment:shortint;override;
           function  vmtmethodoffset(index:longint):longint;
           function  members_need_inittable : boolean;
@@ -350,7 +350,7 @@ interface
 
        tarraydef = class(tstoreddef)
           lowrange,
-          highrange     : aint;
+          highrange     : asizeint;
           rangedef      : tdef;
           rangedefderef : tderef;
           arrayoptions  : tarraydefoptions;
@@ -360,11 +360,11 @@ interface
           _elementdefderef : tderef;
           procedure setelementdef(def:tdef);
        public
-          function elesize : aint;
-          function elepackedbitsize : aint;
-          function elecount : aword;
+          function elesize : asizeint;
+          function elepackedbitsize : asizeint;
+          function elecount : asizeuint;
           constructor create_from_pointer(def:tdef);
-          constructor create(l,h:aint;def:tdef);
+          constructor create(l,h:asizeint;def:tdef);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy; override;
           function getcopy : tstoreddef;override;
@@ -373,7 +373,7 @@ interface
           function  getmangledparaname : string;override;
           procedure buildderef;override;
           procedure deref;override;
-          function size : aint;override;
+          function size : asizeint;override;
           function alignment : shortint;override;
           { returns the label of the range check string }
           function needs_inittable : boolean;override;
@@ -392,7 +392,7 @@ interface
           function  GetTypeName:string;override;
           function alignment:shortint;override;
           procedure setsize;
-          function  packedbitsize: aint; override;
+          function  packedbitsize: asizeint; override;
           function getvardef : longint;override;
        end;
 
@@ -455,7 +455,7 @@ interface
           function getcopy : tstoreddef;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  GetSymtable(t:tGetSymtable):TSymtable;override;
-          function  size : aint;override;
+          function  size : asizeint;override;
           function  GetTypeName:string;override;
           function  is_publishable : boolean;override;
           function  is_methodpointer:boolean;override;
@@ -583,10 +583,10 @@ interface
 
        tstringdef = class(tstoreddef)
           stringtype : tstringtype;
-          len        : aint;
+          len        : asizeint;
           constructor createshort(l : byte);
           constructor loadshort(ppufile:tcompilerppufile);
-          constructor createlong(l : aint);
+          constructor createlong(l : asizeint);
           constructor loadlong(ppufile:tcompilerppufile);
           constructor createansi;
           constructor loadansi(ppufile:tcompilerppufile);
@@ -609,13 +609,13 @@ interface
 
        tenumdef = class(tstoreddef)
           minval,
-          maxval    : aint;
+          maxval    : asizeint;
           has_jumps : boolean;
           basedef   : tenumdef;
           basedefderef : tderef;
           symtable  : TSymtable;
           constructor create;
-          constructor create_subrange(_basedef:tenumdef;_min,_max:aint);
+          constructor create_subrange(_basedef:tenumdef;_min,_max:asizeint);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           function getcopy : tstoreddef;override;
@@ -625,11 +625,11 @@ interface
           function  GetTypeName:string;override;
           function  is_publishable : boolean;override;
           procedure calcsavesize;
-          function  packedbitsize: aint; override;
-          procedure setmax(_max:aint);
-          procedure setmin(_min:aint);
-          function  min:aint;
-          function  max:aint;
+          function  packedbitsize: asizeint; override;
+          procedure setmax(_max:asizeint);
+          procedure setmin(_min:asizeint);
+          function  min:asizeint;
+          function  max:asizeint;
           function  getfirstsym:tsym;
        end;
 
@@ -638,7 +638,7 @@ interface
           elementdefderef : tderef;
           setbase,
           setmax   : aword;
-          constructor create(def:tdef;low, high : aint);
+          constructor create(def:tdef;low, high : asizeint);
           constructor ppuload(ppufile:tcompilerppufile);
           function getcopy : tstoreddef;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -1116,7 +1116,7 @@ implementation
       end;
 
 
-    function tstoreddef.size : aint;
+    function tstoreddef.size : asizeint;
       begin
          size:=savesize;
       end;
@@ -1176,7 +1176,7 @@ implementation
               recsize:=size;
               is_intregable:=
                 ispowerof2(recsize,temp) and
-                (recsize <= sizeof(aint));
+                (recsize <= sizeof(asizeint));
             end;
         end;
      end;
@@ -1222,7 +1222,7 @@ implementation
       end;
 
 
-    constructor tstringdef.createlong(l : aint);
+    constructor tstringdef.createlong(l : asizeint);
       begin
          inherited create(stringdef);
          stringtype:=st_longstring;
@@ -1235,7 +1235,7 @@ implementation
       begin
          inherited ppuload(stringdef,ppufile);
          stringtype:=st_longstring;
-         len:=ppufile.getaint;
+         len:=ppufile.getasizeint;
          savesize:=sizeof(pint);
       end;
 
@@ -1410,7 +1410,7 @@ implementation
       end;
 
 
-    constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:aint);
+    constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:asizeint);
       begin
          inherited create(enumdef);
          minval:=_min;
@@ -1486,7 +1486,7 @@ implementation
       end;
 
 
-    function tenumdef.packedbitsize: aint;
+    function tenumdef.packedbitsize: asizeint;
       var
         sizeval: tconstexprint;
         power: longint;
@@ -1509,27 +1509,27 @@ implementation
       end;
 
 
-    procedure tenumdef.setmax(_max:aint);
+    procedure tenumdef.setmax(_max:asizeint);
       begin
         maxval:=_max;
         calcsavesize;
       end;
 
 
-    procedure tenumdef.setmin(_min:aint);
+    procedure tenumdef.setmin(_min:asizeint);
       begin
         minval:=_min;
         calcsavesize;
       end;
 
 
-    function tenumdef.min:aint;
+    function tenumdef.min:asizeint;
       begin
         min:=minval;
       end;
 
 
-    function tenumdef.max:aint;
+    function tenumdef.max:asizeint;
       begin
         max:=maxval;
       end;
@@ -1656,7 +1656,7 @@ implementation
       end;
 
 
-    function torddef.packedbitsize: aint;
+    function torddef.packedbitsize: asizeint;
       var
         sizeval: tconstexprint;
         power: longint;
@@ -1928,7 +1928,8 @@ implementation
             else
               savesize:=368;
         end;
-{$else cpu64bitaddr}
+{$endif cpu64bitaddr}
+{$ifdef cpu32bitaddr}
         case filetyp of
           ft_text :
             savesize:=592{+4};
@@ -1936,7 +1937,16 @@ implementation
           ft_untyped :
             savesize:=332;
         end;
-{$endif cpu64bitaddr}
+{$endif cpu32bitaddr}
+{$ifdef cpu8bitaddr}
+        case filetyp of
+          ft_text :
+            savesize:=127;
+          ft_typed,
+          ft_untyped :
+            savesize:=127;
+        end;
+{$endif cpu8bitaddr}
       end;
 
 
@@ -2214,7 +2224,7 @@ implementation
                                    TSETDEF
 ***************************************************************************}
 
-    constructor tsetdef.create(def:tdef;low, high : aint);
+    constructor tsetdef.create(def:tdef;low, high : asizeint);
       var
         setallocbits: aint;
         packedsavesize: aint;
@@ -2343,7 +2353,7 @@ implementation
                            TARRAYDEF
 ***************************************************************************}
 
-    constructor tarraydef.create(l,h:aint;def:tdef);
+    constructor tarraydef.create(l,h:asizeint;def:tdef);
       begin
          inherited create(arraydef);
          lowrange:=l;
@@ -2423,7 +2433,7 @@ implementation
       end;
 
 
-    function tarraydef.elesize : aint;
+    function tarraydef.elesize : asizeint;
       begin
         if (ado_IsBitPacked in arrayoptions) then
           internalerror(2006080101);
@@ -2434,7 +2444,7 @@ implementation
       end;
 
 
-    function tarraydef.elepackedbitsize : aint;
+    function tarraydef.elepackedbitsize : asizeint;
       begin
         if not(ado_IsBitPacked in arrayoptions) then
           internalerror(2006080102);
@@ -2445,7 +2455,7 @@ implementation
       end;
 
 
-    function tarraydef.elecount : aword;
+    function tarraydef.elecount : asizeuint;
       var
         qhigh,qlow : qword;
       begin
@@ -2459,7 +2469,7 @@ implementation
             qhigh:=highrange;
             qlow:=qword(-lowrange);
             { prevent overflow, return 0 to indicate overflow }
-            if qhigh+qlow>qword(high(aint)-1) then
+            if qhigh+qlow>qword(high(asizeint)-1) then
               result:=0
             else
               result:=qhigh+qlow+1;
@@ -2469,10 +2479,10 @@ implementation
       end;
 
 
-    function tarraydef.size : aint;
+    function tarraydef.size : asizeint;
       var
-        cachedelecount : aword;
-        cachedelesize : aint;
+        cachedelecount : asizeuint;
+        cachedelesize : asizeint;
       begin
         if ado_IsDynamicArray in arrayoptions then
           begin
@@ -2503,17 +2513,17 @@ implementation
 
         { prevent overflow, return -1 to indicate overflow }
         { also make sure we don't need 64/128 bit arithmetic to calculate offsets }
-        if (cachedelecount > aword(high(aint))) or
-           ((high(aint) div cachedelesize) < aint(cachedelecount)) or
-           { also lowrange*elesize must be < high(aint) to prevent overflow when
+        if (cachedelecount > asizeuint(high(asizeint))) or
+           ((high(asizeint) div cachedelesize) < asizeint(cachedelecount)) or
+           { also lowrange*elesize must be < high(asizeint) to prevent overflow when
              accessing the array, see ncgmem (PFV) }
-           ((high(aint) div cachedelesize) < abs(lowrange)) then
+           ((high(asizeint) div cachedelesize) < abs(lowrange)) then
           begin
             result:=-1;
             exit;
           end;
 
-        result:=cachedelesize*aint(cachedelecount);
+        result:=cachedelesize*asizeint(cachedelecount);
         if (ado_IsBitPacked in arrayoptions) then
           { can't just add 7 and divide by 8, because that may overflow }
           result:=result div 8 + ord((result mod 8)<>0);
@@ -2908,7 +2918,7 @@ implementation
       end;
 
 
-    function trecorddef.size:aint;
+    function trecorddef.size:asizeint;
       begin
         result:=trecordsymtable(symtable).datasize;
       end;
@@ -4065,7 +4075,7 @@ implementation
       end;
 
 
-    function tprocvardef.size : aint;
+    function tprocvardef.size : asizeint;
       begin
          if ((po_methodpointer in procoptions) or
              is_nested_pd(self)) and
@@ -4749,7 +4759,7 @@ implementation
           (assigned(childof) and childof.implements_any_interfaces);
       end;
 
-    function tobjectdef.size : aint;
+    function tobjectdef.size : asizeint;
       begin
         if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
           result:=sizeof(pint)

compiler/symsym.pas

@@ -136,7 +136,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
-          function  getsize : aint;
+          function  getsize : asizeint;
           function  getpackedbitsize : longint;
           function  is_regvar(refpara: boolean):boolean;
           procedure trigger_notifications(what:Tnotification_flag);
@@ -153,7 +153,7 @@ interface
       end;
 
       tfieldvarsym = class(tabstractvarsym)
-          fieldoffset   : aint;   { offset in record/object }
+          fieldoffset   : asizeint;   { offset in record/object }
           objcoffsetmangledname: pshortstring; { mangled name of offset, calculated as needed }
           constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(ppufile:tcompilerppufile);
@@ -246,7 +246,7 @@ interface
           constructor create(const n : string);
           destructor  destroy;override;
           constructor ppuload(ppufile:tcompilerppufile);
-          function  getsize : aint;
+          function  getsize : asizeint;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
@@ -952,7 +952,7 @@ implementation
       end;
 
 
-    function tpropertysym.getsize : aint;
+    function tpropertysym.getsize : asizeint;
       begin
          getsize:=0;
       end;
@@ -1045,7 +1045,7 @@ implementation
       end;
 
 
-    function tabstractvarsym.getsize : aint;
+    function tabstractvarsym.getsize : asizeint;
       begin
         if assigned(vardef) and
            ((vardef.typ<>arraydef) or

compiler/symtable.pas

@@ -84,7 +84,7 @@ interface
           constructor create(const n:string;usealign:shortint);
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure alignrecord(fieldoffset:aint;varalign:shortint);
+          procedure alignrecord(fieldoffset:asizeint;varalign:shortint);
           procedure addfield(sym:tfieldvarsym;vis:tvisibility);
           procedure addalignmentpadding;
           procedure insertdef(def:TDefEntry);override;
@@ -92,14 +92,14 @@ interface
           function has_single_field(out sym:tfieldvarsym): boolean;
           function get_unit_symtable: tsymtable;
         protected
-          _datasize       : aint;
+          _datasize       : asizeint;
           { size in bits of the data in case of bitpacked record. Only important during construction, }
           { no need to save in/restore from ppu file. datasize is always (databitsize+7) div 8.       }
-          databitsize    : aint;
-          procedure setdatasize(val: aint);
+          databitsize    : asizeint;
+          procedure setdatasize(val: asizeint);
         public
           function iscurrentunit: boolean; override;
-          property datasize : aint read _datasize write setdatasize;
+          property datasize : asizeint read _datasize write setdatasize;
        end;
 
        trecordsymtable = class(tabstractrecordsymtable)
@@ -845,7 +845,7 @@ implementation
       end;
 
 
-    function field2recordalignment(fieldoffs, fieldalign: aint): aint;
+    function field2recordalignment(fieldoffs, fieldalign: asizeint): asizeint;
       begin
         { optimal alignment of the record when declaring a variable of this }
         { type is independent of the packrecords setting                    }
@@ -871,7 +871,7 @@ implementation
           result:=1;
       end;
 
-    procedure tabstractrecordsymtable.alignrecord(fieldoffset:aint;varalign:shortint);
+    procedure tabstractrecordsymtable.alignrecord(fieldoffset:asizeint;varalign:shortint);
       var
         varalignrecord: shortint;
       begin
@@ -888,7 +888,7 @@ implementation
 
     procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym;vis:tvisibility);
       var
-        l      : aint;
+        l      : asizeint;
         varalignfield,
         varalign : shortint;
         vardef : tdef;
@@ -920,7 +920,7 @@ implementation
                 begin
                   databitsize:=_datasize*8;
                   sym.fieldoffset:=databitsize;
-                  if (l>high(aint) div 8) then
+                  if (l>high(asizeint) div 8) then
                     Message(sym_e_segment_too_large);
                   l:=l*8;
                 end;
@@ -930,11 +930,11 @@ implementation
               { bit packed records are limited to high(aint) bits }
               { instead of bytes to avoid double precision        }
               { arithmetic in offset calculations                 }
-              if int64(l)>high(aint)-sym.fieldoffset then
+              if int64(l)>high(asizeint)-sym.fieldoffset then
                 begin
                   Message(sym_e_segment_too_large);
-                  _datasize:=high(aint);
-                  databitsize:=high(aint);
+                  _datasize:=high(asizeint);
+                  databitsize:=high(asizeint);
                 end
               else
                 begin
@@ -990,7 +990,7 @@ implementation
         varalignfield:=used_align(varalign,current_settings.alignment.recordalignmin,fieldalignment);
 
         sym.fieldoffset:=align(_datasize,varalignfield);
-        if l>high(aint)-sym.fieldoffset then
+        if l>high(asizeint)-sym.fieldoffset then
           begin
             Message(sym_e_segment_too_large);
             _datasize:=high(aint);
@@ -1080,7 +1080,7 @@ implementation
           result:=result.defowner.owner;
       end;
 
-    procedure tabstractrecordsymtable.setdatasize(val: aint);
+    procedure tabstractrecordsymtable.setdatasize(val: asizeint);
       begin
         _datasize:=val;
         if (usefieldalignment=bit_alignment) then
@@ -1156,11 +1156,11 @@ implementation
                 else
                   begin
                     bitsize:=tfieldvarsym(sym).getsize;
-                    if (bitsize>high(aint) div 8) then
+                    if (bitsize>high(asizeint) div 8) then
                       Message(sym_e_segment_too_large);
                     bitsize:=bitsize*8;
                   end;
-                if bitsize>high(aint)-databitsize then
+                if bitsize>high(asizeint)-databitsize then
                   begin
                     Message(sym_e_segment_too_large);
                     _datasize:=high(aint);
@@ -1176,7 +1176,7 @@ implementation
               end
             else
               begin
-                if tfieldvarsym(sym).getsize>high(aint)-_datasize then
+                if tfieldvarsym(sym).getsize>high(asizeint)-_datasize then
                   begin
                     Message(sym_e_segment_too_large);
                     _datasize:=high(aint);

compiler/symtype.pas

@@ -73,8 +73,8 @@ interface
          function  mangledparaname:string;
          function  getmangledparaname:string;virtual;
          function  rtti_mangledname(rt:trttitype):string;virtual;abstract;
-         function  size:aint;virtual;abstract;
-         function  packedbitsize:aint;virtual;
+         function  size:asizeint;virtual;abstract;
+         function  packedbitsize:asizeint;virtual;
          function  alignment:shortint;virtual;abstract;
          function  getvardef:longint;virtual;abstract;
          function  getparentdef:tdef;virtual;
@@ -314,7 +314,7 @@ implementation
       end;
 
 
-    function tdef.packedbitsize:aint;
+    function tdef.packedbitsize:asizeint;
       begin
         result:=size * 8;
       end;

compiler/systems/i_wii.pas

@@ -86,7 +86,7 @@ unit i_wii;
                 maxCrecordalign : 8
               );
             first_parm_offset : 8;
-            stacksize    : 32*1024*1024;
+            stacksize    : 131072;  // 128 kb 
             abi : abi_powerpc_sysv;
           );
 

compiler/systems/t_wii.pas

@@ -562,9 +562,8 @@ begin
 
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-
   Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf')))));
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName))));
   Replace(cmdstr,'$STATIC',StaticStr);
   Replace(cmdstr,'$STRIP',StripStr);

installer/install.dat

@@ -87,6 +87,10 @@ package=usymbolicdos.zip[usymbdos.zip],Symbolic (unit for parsing and evaluating
 package=ufcl-resdos.zip[ufcledos.zip],Free Component Library (FCL)-resources
 # Dos 30
 package=ubzip2dos.zip[ubz2dos.zip],Units for bzip2 decompression
+# Dos 31
+package=ufcl-jsdos.zip[ufcjsdos.zip],Free Component Library (FCL)-Javascript support
+# Dos 32
+package=uhermesdos.zip[uhermdos.zip],Port of Hermes graphics library
 
 #
 # Win32 packages
@@ -144,6 +148,8 @@ package=units-oggvorbis.i386-win32.zip,OGG Vorbis interface units
 package=units-openal.i386-win32.zip,OpenAL interface units
 # Win32 22
 package=units-openssl.i386-win32.zip,OpenSSL interface units
+# Win32 23
+package=units-hermes.i386-win32.zip,Port of Hermes graphics library
 
 #
 # Win32 packages 2nd part
@@ -208,6 +214,8 @@ package=units-symbolic.i386-win32.zip,Symbolic (unit for parsing and evaluating
 package=units-fcl-res.i386-win32.zip,Free Component Library (FCL)-resources
 # Win32-2 29
 package=units-bzip2.i386-win32.zip,Units for bzip2 decompression
+# Win32-2 30
+package=units-fcl-js.i386-win32.zip,Free Component Library (FCL)-Javascript support
 
 
 #
@@ -262,6 +270,8 @@ package=ufcl-registryos2.zip[ufclros2.zip],Free Component Library (FCL)-registry
 package=ufcl-xmlos2.zip[ufclxos2.zip],Free Component Library (FCL)-XML
 # OS/2 20
 #package=ufcl-webos2.zip[ufclwos2.zip],Free Component Library (FCL)-Web
+# OS/2 21
+package=uhermesos2.zip[uhermos2.zip],Port of Hermes graphics library
 
 #
 # OS/2 packages 2nd part
@@ -316,6 +326,8 @@ package=usymbolicos2.zip[usymbos2.zip],Symbolic (unit for parsing and evaluating
 package=ufcl-resos2.zip[ufcleos2.zip],Free Component Library (FCL)-resources
 # OS/2-2 24
 package=ubzip2os2.zip[ubz2os2.zip],Units for bzip2 decompression
+# OS/2-2 25
+package=ufcl-jsos2.zip[ufcjsos2.zip],Free Component Library (FCL)-Javascript support
 
 
 
@@ -372,6 +384,8 @@ package=ufcl-registryemx.zip[ufclremx.zip],Free Component Library (FCL)-registry
 package=ufcl-xmlemx.zip[ufclxemx.zip],Free Component Library (FCL)-XML
 # EMX 20
 #package=ufcl-webemx.zip[ufclwemx.zip],Free Component Library (FCL)-Web
+# EMX 21
+package=uhermesemx.zip[uhermemx.zip],Port of Hermes graphics library
 
 #
 # EMX packages 2nd part
@@ -426,6 +440,8 @@ package=usymbolicemx.zip[usymbemx.zip],Symbolic (unit for parsing and evaluating
 package=ufcl-resemx.zip[ufcleemx.zip],Free Component Library (FCL)-resources
 # EMX-2 24
 package=ubzip2emx.zip[ubz2emx.zip],Units for bzip2 decompression
+# EMX-2 25
+package=ufcl-jsemx.zip[ufcjsemx.zip],Free Component Library (FCL)-Javascript support
 
 
 #
@@ -481,6 +497,8 @@ package=units-gdbint.source.zip[ugdbsrc.zip],GDB interface units
 package=units-postgres.source.zip[upgrsrc.zip],PostGreSQL interface units
 # Source 16
 package=units-graph.source.zip[ugrphsrc.zip],Unit Graph
+# Source 17
+package=units-hermes.source.zip[uhermsrc.zip],Port of Hermes graphics library
 
 #
 # Source packages 2nd part
@@ -538,6 +556,8 @@ package=units-symbolic.source.zip[usymbsrc.zip],Symbolic (unit for parsing and e
 package=units-fcl-res.source.zip[ufclesrc.zip],Free Component Library (FCL)-resources
 # Source-2 25
 package=units-bzip2.source.zip[ubz2src.zip],Units for bzip2 decompression
+# Source-2 26
+package=fcl-js.source.zip[ufcjssrc.zip],Free Component Library (FCL)-Javascript support
 
 
 #

installer/install.pas

@@ -94,11 +94,11 @@ program install;
 
   const
      installerversion='2.5.1';
-     installercopyright='Copyright (c) 1993-2009 Florian Klaempfl';
+     installercopyright='Copyright (c) 1993-2011 Florian Klaempfl';
 
 
-     maxpacks=30;
-     maxpackages=29;
+     maxpacks=20;
+     maxpackages=40;
      maxdefcfgs=1024;
 
      HTMLIndexExt = '.htx';

packages/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/12/12]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/02/07]
 #
 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 i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -289,7 +289,7 @@ ifeq ($(FULL_TARGET),i386-netbsd)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick gdbint libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 gtk2 librsvg bfd aspell svgalib imlib utmp  fpgtk xforms fftw pcap ggi sdl openssl gnome1 httpd13 httpd20 httpd22 pxlib numlib
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib fcl-extra imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib
+override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib fcl-extra imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib iconvenc gtk2 cairo
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes
@@ -382,7 +382,7 @@ ifeq ($(FULL_TARGET),sparc-netbsd)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick gdbint libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 gtk2 librsvg bfd aspell svgalib imlib utmp  fpgtk xforms fftw pcap ggi sdl openssl gnome1 httpd13 httpd20 httpd22 pxlib numlib
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib fcl-extra imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib
+override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib fcl-extra imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib iconvenc gtk2 cairo
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes
@@ -394,7 +394,7 @@ ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick gdbint libpng x11 gdbm tcl syslog libcurl opengl cairo  bfd aspell svgalib imlib utmp  fpgtk xforms fftw pcap ggi sdl openssl graph gnome1 gtk1 gtk2 librsvg httpd13 httpd20 httpd22 pxlib numlib users iconvenc gmp fcl-extra libxml
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib fcl-extra imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib
+override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib fcl-extra imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib iconvenc gtk2 cairo
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-js fcl-process unzip regexpr chm fcl-res libgd symbolic bzip2 hermes  fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc gmp fcl-extra univint opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib cocoaint
@@ -2141,6 +2141,9 @@ TARGET_DIRS_HTTPD13=1
 TARGET_DIRS_HTTPD20=1
 TARGET_DIRS_HTTPD22=1
 TARGET_DIRS_NUMLIB=1
+TARGET_DIRS_ICONVENC=1
+TARGET_DIRS_GTK2=1
+TARGET_DIRS_CAIRO=1
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
 TARGET_DIRS_HASH=1
@@ -3600,6 +3603,9 @@ TARGET_DIRS_HTTPD13=1
 TARGET_DIRS_HTTPD20=1
 TARGET_DIRS_HTTPD22=1
 TARGET_DIRS_NUMLIB=1
+TARGET_DIRS_ICONVENC=1
+TARGET_DIRS_GTK2=1
+TARGET_DIRS_CAIRO=1
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
 TARGET_DIRS_HASH=1
@@ -3857,6 +3863,9 @@ TARGET_DIRS_HTTPD13=1
 TARGET_DIRS_HTTPD20=1
 TARGET_DIRS_HTTPD22=1
 TARGET_DIRS_NUMLIB=1
+TARGET_DIRS_ICONVENC=1
+TARGET_DIRS_GTK2=1
+TARGET_DIRS_CAIRO=1
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 TARGET_DIRS_HASH=1
@@ -9694,11 +9703,11 @@ winunits-base_shared: fcl-registry_shared fcl-base_shared
 winunits-base_smart: fcl-registry_smart fcl-base_smart
 winunits-base_debug: fcl-registry_debug fcl-base_debug
 winunits-base_release: fcl-registry_release fcl-base_release
-winunits-jedi_all: winunits-base_all fcl-registry fcl-base_all
-winunits-jedi_shared: winunits-base_shared fcl-registry fcl-base_shared
-winunits-jedi_smart: winunits-base_smart fcl-registry fcl-base_smart
-winunits-jedi_debug: winunits-base_debug fcl-registry fcl-base_debug
-winunits-jedi_release: winunits-base_release fcl-registry fcl-base_release
+winunits-jedi_all: winunits-base_all fcl-registry_all fcl-base_all
+winunits-jedi_shared: winunits-base_shared fcl-registry_shared fcl-base_shared
+winunits-jedi_smart: winunits-base_smart fcl-registry_smart fcl-base_smart
+winunits-jedi_debug: winunits-base_debug fcl-registry_debug fcl-base_debug
+winunits-jedi_release: winunits-base_release fcl-registry_release fcl-base_release
 xforms_all: x11_all
 xforms_shared: x11_shared
 xforms_smart: x11_smart

packages/Makefile.fpc

@@ -37,7 +37,7 @@ dirs_arm_darwin=httpd13 httpd20 httpd22 opengles objcrtl
 dirs_i386_iphonesim=httpd13 httpd20 httpd22 opengles objcrtl
 dirs_solaris=fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick \
                libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib fcl-extra \
-               imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib
+               imlib utmp  fpgtk xforms fftw pcap ggi  openssl gnome1 httpd13 httpd20 httpd22 numlib iconvenc gtk2 cairo
 dirs_netbsd=fv fcl-web fastcgi fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick \
                gdbint libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 gtk2 librsvg bfd aspell svgalib \
                imlib utmp  fpgtk xforms fftw pcap ggi sdl openssl gnome1 httpd13 httpd20 httpd22 pxlib numlib
@@ -64,6 +64,7 @@ dirs_palmos=palmunits
 dirs_go32v2=fv graph unzip gdbint
 dirs_amiga=amunits
 dirs_morphos=fv opengl sdl
+dirs_wii=libogcfpc
 
 [install]
 fpcpackage=y
@@ -345,11 +346,11 @@ winunits-base_smart: fcl-registry_smart fcl-base_smart
 winunits-base_debug: fcl-registry_debug fcl-base_debug
 winunits-base_release: fcl-registry_release fcl-base_release
 
-winunits-jedi_all: winunits-base_all fcl-registry fcl-base_all
-winunits-jedi_shared: winunits-base_shared fcl-registry fcl-base_shared
-winunits-jedi_smart: winunits-base_smart fcl-registry fcl-base_smart
-winunits-jedi_debug: winunits-base_debug fcl-registry fcl-base_debug
-winunits-jedi_release: winunits-base_release fcl-registry fcl-base_release
+winunits-jedi_all: winunits-base_all fcl-registry_all fcl-base_all
+winunits-jedi_shared: winunits-base_shared fcl-registry_shared fcl-base_shared
+winunits-jedi_smart: winunits-base_smart fcl-registry_smart fcl-base_smart
+winunits-jedi_debug: winunits-base_debug fcl-registry_debug fcl-base_debug
+winunits-jedi_release: winunits-base_release fcl-registry_release fcl-base_release
 
 
 xforms_all: x11_all

packages/cocoaint/src/appkit/NSAttributedString.inc

@@ -25,7 +25,7 @@ const
 
 const
   NSNoUnderlineStyle = 0;
-  NSSingleUnderlineStyle = 0;
+  NSSingleUnderlineStyle = 1;
 
 {$endif}
 {$endif}

packages/cocoaint/src/appkit/NSCell.inc

@@ -50,9 +50,9 @@ const
 
 const
   NSImageScaleProportionallyDown = 0;
-  NSImageScaleAxesIndependently = 0;
-  NSImageScaleNone = 1;
-  NSImageScaleProportionallyUpOrDown = 2;
+  NSImageScaleAxesIndependently = 1;
+  NSImageScaleNone = 2;
+  NSImageScaleProportionallyUpOrDown = 3;
 
 const
   NSMixedState = -1;
@@ -85,14 +85,14 @@ const
 
 const
   NSBackgroundStyleLight = 0;
-  NSBackgroundStyleDark = 0;
-  NSBackgroundStyleRaised = 1;
-  NSBackgroundStyleLowered = 2;
+  NSBackgroundStyleDark = 1;
+  NSBackgroundStyleRaised = 2;
+  NSBackgroundStyleLowered = 3;
 
 const
   NSScaleProportionally = 0;
-  NSScaleToFit = 0;
-  NSScaleNone = 1;
+  NSScaleToFit = 1;
+  NSScaleNone = 2;
 
 { Types }
 type

packages/cocoaint/src/appkit/NSImageCell.inc

@@ -8,21 +8,21 @@
 
 const
   NSImageAlignCenter = 0;
-  NSImageAlignTop = 0;
-  NSImageAlignTopLeft = 1;
-  NSImageAlignTopRight = 2;
-  NSImageAlignLeft = 3;
-  NSImageAlignBottom = 4;
-  NSImageAlignBottomLeft = 5;
-  NSImageAlignBottomRight = 6;
-  NSImageAlignRight = 7;
+  NSImageAlignTop = 1;
+  NSImageAlignTopLeft = 2;
+  NSImageAlignTopRight = 3;
+  NSImageAlignLeft = 4;
+  NSImageAlignBottom = 5;
+  NSImageAlignBottomLeft = 6;
+  NSImageAlignBottomRight = 7;
+  NSImageAlignRight = 8;
 
 const
   NSImageFrameNone = 0;
-  NSImageFramePhoto = 0;
-  NSImageFrameGrayBezel = 1;
-  NSImageFrameGroove = 2;
-  NSImageFrameButton = 3;
+  NSImageFramePhoto = 1;
+  NSImageFrameGrayBezel = 2;
+  NSImageFrameGroove = 3;
+  NSImageFrameButton = 4;
 
 { Types }
 type

packages/cocoaint/src/appkit/NSParagraphStyle.inc

@@ -8,17 +8,17 @@
 
 const
   NSLeftTabStopType = 0;
-  NSRightTabStopType = 0;
-  NSCenterTabStopType = 1;
-  NSDecimalTabStopType = 2;
+  NSRightTabStopType = 1;
+  NSCenterTabStopType = 2;
+  NSDecimalTabStopType = 3;
 
 const
   NSLineBreakByWordWrapping = 0;
-  NSLineBreakByCharWrapping = 0;
-  NSLineBreakByClipping = 1;
-  NSLineBreakByTruncatingHead = 2;
-  NSLineBreakByTruncatingTail = 3;
-  NSLineBreakByTruncatingMiddle = 4;
+  NSLineBreakByCharWrapping = 1;
+  NSLineBreakByClipping = 2;
+  NSLineBreakByTruncatingHead = 3;
+  NSLineBreakByTruncatingTail = 4;
+  NSLineBreakByTruncatingMiddle = 5;
 
 { Types }
 type

packages/cocoaint/src/appkit/NSSpeechSynthesizer.inc

@@ -8,8 +8,8 @@
 
 const
   NSSpeechImmediateBoundary = 0;
-  NSSpeechWordBoundary = 0;
-  NSSpeechSentenceBoundary = 1;
+  NSSpeechWordBoundary = 1;
+  NSSpeechSentenceBoundary = 2;
 
 { Types }
 type

packages/cocoaint/src/appkit/NSTableView.inc

@@ -12,11 +12,11 @@ const
 
 const
   NSTableViewNoColumnAutoresizing = 0;
-  NSTableViewUniformColumnAutoresizingStyle = 0;
-  NSTableViewSequentialColumnAutoresizingStyle = 1;
-  NSTableViewReverseSequentialColumnAutoresizingStyle = 2;
-  NSTableViewLastColumnOnlyAutoresizingStyle = 3;
-  NSTableViewFirstColumnOnlyAutoresizingStyle = 4;
+  NSTableViewUniformColumnAutoresizingStyle = 1;
+  NSTableViewSequentialColumnAutoresizingStyle = 2;
+  NSTableViewReverseSequentialColumnAutoresizingStyle = 3;
+  NSTableViewLastColumnOnlyAutoresizingStyle = 4;
+  NSTableViewFirstColumnOnlyAutoresizingStyle = 5;
 
 const
   NSTableViewGridNone = 0;

packages/cocoaint/src/appkit/NSWindow.inc

@@ -61,8 +61,8 @@ const
 
 const
   NSDirectSelection = 0;
-  NSSelectingNext = 0;
-  NSSelectingPrevious = 1;
+  NSSelectingNext = 1;
+  NSSelectingPrevious = 2;
 
 const
   NSWindowCloseButton = 0;

packages/cocoaint/src/foundation/NSComparisonPredicate.inc

@@ -12,24 +12,24 @@ const
 
 const
   NSDirectPredicateModifier = 0;
-  NSAllPredicateModifier = 0;
-  NSAnyPredicateModifier = 1;
+  NSAllPredicateModifier = 1;
+  NSAnyPredicateModifier = 2;
 
 const
   NSLessThanPredicateOperatorType = 0;
-  NSLessThanOrEqualToPredicateOperatorType = 0;
-  NSGreaterThanPredicateOperatorType = 1;
-  NSGreaterThanOrEqualToPredicateOperatorType = 2;
-  NSEqualToPredicateOperatorType = 3;
-  NSNotEqualToPredicateOperatorType = 4;
-  NSMatchesPredicateOperatorType = 5;
-  NSLikePredicateOperatorType = 6;
-  NSBeginsWithPredicateOperatorType = 7;
-  NSEndsWithPredicateOperatorType = 8;
-  NSInPredicateOperatorType = 9;
-  NSCustomSelectorPredicateOperatorType = 10;
+  NSLessThanOrEqualToPredicateOperatorType = 1;
+  NSGreaterThanPredicateOperatorType = 2;
+  NSGreaterThanOrEqualToPredicateOperatorType = 3;
+  NSEqualToPredicateOperatorType = 4;
+  NSNotEqualToPredicateOperatorType = 5;
+  NSMatchesPredicateOperatorType = 6;
+  NSLikePredicateOperatorType = 7;
+  NSBeginsWithPredicateOperatorType = 8;
+  NSEndsWithPredicateOperatorType = 9;
+  NSInPredicateOperatorType = 10;
+  NSCustomSelectorPredicateOperatorType = 11;
   NSContainsPredicateOperatorType = 99;
-  NSBetweenPredicateOperatorType = 11;
+  NSBetweenPredicateOperatorType = 100;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSCompoundPredicate.inc

@@ -8,8 +8,8 @@
 
 const
   NSNotPredicateType = 0;
-  NSAndPredicateType = 0;
-  NSOrPredicateType = 1;
+  NSAndPredicateType = 1;
+  NSOrPredicateType = 2;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSDecimal.inc

@@ -14,10 +14,10 @@ const
 
 const
   NSCalculationNoError = 0;
-  NSCalculationLossOfPrecision = 0;
-  NSCalculationUnderflow = 1;
-  NSCalculationOverflow = 2;
-  NSCalculationDivideByZero = 3;
+  NSCalculationLossOfPrecision = 1;
+  NSCalculationUnderflow = 2;
+  NSCalculationOverflow = 3;
+  NSCalculationDivideByZero = 4;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSExpression.inc

@@ -8,15 +8,15 @@
 
 const
   NSConstantValueExpressionType = 0;
-  NSEvaluatedObjectExpressionType = 0;
-  NSVariableExpressionType = 1;
-  NSKeyPathExpressionType = 2;
-  NSFunctionExpressionType = 3;
-  NSUnionSetExpressionType = 4;
-  NSIntersectSetExpressionType = 5;
-  NSMinusSetExpressionType = 6;
+  NSEvaluatedObjectExpressionType = 1;
+  NSVariableExpressionType = 2;
+  NSKeyPathExpressionType = 3;
+  NSFunctionExpressionType = 4;
+  NSUnionSetExpressionType = 5;
+  NSIntersectSetExpressionType = 6;
+  NSMinusSetExpressionType = 7;
   NSSubqueryExpressionType = 13;
-  NSAggregateExpressionType = 7;
+  NSAggregateExpressionType = 14;
   NSBlockExpressionType = 19;
 
 { Types }

packages/cocoaint/src/foundation/NSPathUtilities.inc

@@ -8,15 +8,15 @@
 
 const
   NSApplicationDirectory = 1;
-  NSDemoApplicationDirectory = 0;
-  NSDeveloperApplicationDirectory = 1;
-  NSAdminApplicationDirectory = 2;
-  NSLibraryDirectory = 3;
-  NSDeveloperDirectory = 4;
-  NSUserDirectory = 5;
-  NSDocumentationDirectory = 6;
-  NSDocumentDirectory = 7;
-  NSCoreServiceDirectory = 8;
+  NSDemoApplicationDirectory = 2;
+  NSDeveloperApplicationDirectory = 3;
+  NSAdminApplicationDirectory = 4;
+  NSLibraryDirectory = 5;
+  NSDeveloperDirectory = 6;
+  NSUserDirectory = 7;
+  NSDocumentationDirectory = 8;
+  NSDocumentDirectory = 9;
+  NSCoreServiceDirectory = 10;
   NSAutosavedInformationDirectory = 11;
   NSDesktopDirectory = 12;
   NSCachesDirectory = 13;

packages/cocoaint/src/foundation/NSProcessInfo.inc

@@ -8,12 +8,12 @@
 
 const
   NSWindowsNTOperatingSystem = 1;
-  NSWindows95OperatingSystem = 0;
-  NSSolarisOperatingSystem = 1;
-  NSHPUXOperatingSystem = 2;
-  NSMACHOperatingSystem = 3;
-  NSSunOSOperatingSystem = 4;
-  NSOSF1OperatingSystem = 5;
+  NSWindows95OperatingSystem = 2;
+  NSSolarisOperatingSystem = 3;
+  NSHPUXOperatingSystem = 4;
+  NSMACHOperatingSystem = 5;
+  NSSunOSOperatingSystem = 6;
+  NSOSF1OperatingSystem = 7;
 
 {$endif}
 {$endif}

packages/cocoaint/src/foundation/NSScriptCommand.inc

@@ -8,16 +8,16 @@
 
 const
   NSNoScriptError = 0;
-  NSReceiverEvaluationScriptError = 0;
-  NSKeySpecifierEvaluationScriptError = 1;
-  NSArgumentEvaluationScriptError = 2;
-  NSReceiversCantHandleCommandScriptError = 3;
-  NSRequiredArgumentsMissingScriptError = 4;
-  NSArgumentsWrongScriptError = 5;
-  NSUnknownKeyScriptError = 6;
-  NSInternalScriptError = 7;
-  NSOperationNotSupportedForKeyScriptError = 8;
-  NSCannotCreateScriptCommandError = 9;
+  NSReceiverEvaluationScriptError = 1;
+  NSKeySpecifierEvaluationScriptError = 2;
+  NSArgumentEvaluationScriptError = 3;
+  NSReceiversCantHandleCommandScriptError = 4;
+  NSRequiredArgumentsMissingScriptError = 5;
+  NSArgumentsWrongScriptError = 6;
+  NSUnknownKeyScriptError = 7;
+  NSInternalScriptError = 8;
+  NSOperationNotSupportedForKeyScriptError = 9;
+  NSCannotCreateScriptCommandError = 10;
 
 {$endif}
 {$endif}

packages/cocoaint/src/foundation/NSScriptObjectSpecifiers.inc

@@ -8,12 +8,12 @@
 
 const
   NSNoSpecifierError = 0;
-  NSNoTopLevelContainersSpecifierError = 0;
-  NSContainerSpecifierError = 1;
-  NSUnknownKeySpecifierError = 2;
-  NSInvalidIndexSpecifierError = 3;
-  NSInternalSpecifierError = 4;
-  NSOperationNotSupportedForKeySpecifierError = 5;
+  NSNoTopLevelContainersSpecifierError = 1;
+  NSContainerSpecifierError = 2;
+  NSUnknownKeySpecifierError = 3;
+  NSInvalidIndexSpecifierError = 4;
+  NSInternalSpecifierError = 5;
+  NSOperationNotSupportedForKeySpecifierError = 6;
 
 const
   NSPositionAfter = 0;
@@ -24,7 +24,7 @@ const
 
 const
   NSRelativeAfter = 0;
-  NSRelativeBefore = 0;
+  NSRelativeBefore = 1;
 
 const
   NSIndexSubelement = 0;

packages/cocoaint/src/foundation/NSScriptStandardSuiteCommands.inc

@@ -8,8 +8,8 @@
 
 const
   NSSaveOptionsYes = 0;
-  NSSaveOptionsNo = 0;
-  NSSaveOptionsAsk = 1;
+  NSSaveOptionsNo = 1;
+  NSSaveOptionsAsk = 2;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSScriptWhoseTests.inc

@@ -8,13 +8,13 @@
 
 const
   NSEqualToComparison = 0;
-  NSLessThanOrEqualToComparison = 0;
-  NSLessThanComparison = 1;
-  NSGreaterThanOrEqualToComparison = 2;
-  NSGreaterThanComparison = 3;
-  NSBeginsWithComparison = 4;
-  NSEndsWithComparison = 5;
-  NSContainsComparison = 6;
+  NSLessThanOrEqualToComparison = 1;
+  NSLessThanComparison = 2;
+  NSGreaterThanOrEqualToComparison = 3;
+  NSGreaterThanComparison = 4;
+  NSBeginsWithComparison = 5;
+  NSEndsWithComparison = 6;
+  NSContainsComparison = 7;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSURLHandle.inc

@@ -8,9 +8,9 @@
 
 const
   NSURLHandleNotLoaded = 0;
-  NSURLHandleLoadSucceeded = 0;
-  NSURLHandleLoadInProgress = 1;
-  NSURLHandleLoadFailed = 2;
+  NSURLHandleLoadSucceeded = 1;
+  NSURLHandleLoadInProgress = 2;
+  NSURLHandleLoadFailed = 3;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSXMLDTDNode.inc

@@ -8,25 +8,25 @@
 
 const
   NSXMLEntityGeneralKind = 1;
-  NSXMLEntityParsedKind = 0;
-  NSXMLEntityUnparsedKind = 1;
-  NSXMLEntityParameterKind = 2;
-  NSXMLEntityPredefined = 3;
-  NSXMLAttributeCDATAKind = 4;
-  NSXMLAttributeIDKind = 5;
-  NSXMLAttributeIDRefKind = 6;
-  NSXMLAttributeIDRefsKind = 7;
-  NSXMLAttributeEntityKind = 8;
-  NSXMLAttributeEntitiesKind = 9;
-  NSXMLAttributeNMTokenKind = 10;
-  NSXMLAttributeNMTokensKind = 11;
-  NSXMLAttributeEnumerationKind = 12;
-  NSXMLAttributeNotationKind = 13;
-  NSXMLElementDeclarationUndefinedKind = 14;
-  NSXMLElementDeclarationEmptyKind = 15;
-  NSXMLElementDeclarationAnyKind = 16;
-  NSXMLElementDeclarationMixedKind = 17;
-  NSXMLElementDeclarationElementKind = 18;
+  NSXMLEntityParsedKind = 2;
+  NSXMLEntityUnparsedKind = 3;
+  NSXMLEntityParameterKind = 4;
+  NSXMLEntityPredefined = 5;
+  NSXMLAttributeCDATAKind = 6;
+  NSXMLAttributeIDKind = 7;
+  NSXMLAttributeIDRefKind = 8;
+  NSXMLAttributeIDRefsKind = 9;
+  NSXMLAttributeEntityKind = 10;
+  NSXMLAttributeEntitiesKind = 11;
+  NSXMLAttributeNMTokenKind = 12;
+  NSXMLAttributeNMTokensKind = 13;
+  NSXMLAttributeEnumerationKind = 14;
+  NSXMLAttributeNotationKind = 15;
+  NSXMLElementDeclarationUndefinedKind = 16;
+  NSXMLElementDeclarationEmptyKind = 17;
+  NSXMLElementDeclarationAnyKind = 18;
+  NSXMLElementDeclarationMixedKind = 19;
+  NSXMLElementDeclarationElementKind = 20;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSXMLDocument.inc

@@ -8,9 +8,9 @@
 
 const
   NSXMLDocumentXMLKind = 0;
-  NSXMLDocumentXHTMLKind = 0;
-  NSXMLDocumentHTMLKind = 1;
-  NSXMLDocumentTextKind = 2;
+  NSXMLDocumentXHTMLKind = 1;
+  NSXMLDocumentHTMLKind = 2;
+  NSXMLDocumentTextKind = 3;
 
 { Types }
 type

packages/cocoaint/src/foundation/NSXMLNode.inc

@@ -8,18 +8,18 @@
 
 const
   NSXMLInvalidKind = 0;
-  NSXMLDocumentKind = 0;
-  NSXMLElementKind = 1;
-  NSXMLAttributeKind = 2;
-  NSXMLNamespaceKind = 3;
-  NSXMLProcessingInstructionKind = 4;
-  NSXMLCommentKind = 5;
-  NSXMLTextKind = 6;
-  NSXMLDTDKind = 7;
-  NSXMLEntityDeclarationKind = 8;
-  NSXMLAttributeDeclarationKind = 9;
-  NSXMLElementDeclarationKind = 10;
-  NSXMLNotationDeclarationKind = 11;
+  NSXMLDocumentKind = 1;
+  NSXMLElementKind = 2;
+  NSXMLAttributeKind = 3;
+  NSXMLNamespaceKind = 4;
+  NSXMLProcessingInstructionKind = 5;
+  NSXMLCommentKind = 6;
+  NSXMLTextKind = 7;
+  NSXMLDTDKind = 8;
+  NSXMLEntityDeclarationKind = 9;
+  NSXMLAttributeDeclarationKind = 10;
+  NSXMLElementDeclarationKind = 11;
+  NSXMLNotationDeclarationKind = 12;
 
 { Types }
 type

packages/cocoaint/src/iPhoneAll.pas

@@ -1,126 +0,0 @@
-unit iPhoneAll;
-
-{$mode objfpc}
-{$modeswitch objectivec1}
-
-interface
-
-{$linkframework CoreFoundation}
-{$linkframework CoreGraphics}
-{$linkframework UIKit}
-
-uses
-  ctypes,
-  CFBase,CFArray,CFBag,CFCharacterSet,CFData,CFDate,CFDictionary,CFNumber,CFPropertyList,CFSet,CFString,CFStringEncodingExt,CFTimeZone,CFTree,CFURL,CFXMLNode,CFXMLParser,CFMachPort,CFMessagePort,CFRunLoop,CFSocket,CFBinaryHeap,CFBitVector,CFBundle,CFByteOrders,CFPlugIn,CFPreferences,CFURLAccess,CFUUID,CFLocale,CFStream,CFDateFormatter,CFNumberFormatter,CFCalendar,CFUserNotification,CFNotificationCenter,CFAttributedString,CFNetworkErrorss,
-  CGBase,CGAffineTransforms,CGBitmapContext,CGColor,CGColorSpace,CGContext,CGDataConsumer,CGDataProvider,CGDirectDisplay,CGDirectPalette,CGDisplayConfiguration,CGDisplayFades,CGErrors,CGEvent,CGEventSource,CGEventTypes,CGFont,CGFunction,CGGLContext,CGGeometry,CGImage,CGLayer,CGPDFArray,CGPDFContentStream,CGPDFContext,CGPDFDictionary,CGPDFDocument,CGPDFObject,CGPDFOperatorTable,CGPDFPage,CGPDFScanner,CGPDFStream,CGPDFString,CGPSConverter,CGPath,CGPattern,CGRemoteOperation,CGSession,CGShading,CGWindowLevels,
-  MacTypes, AEDataModel, Icons,
-  AnonClassDefinitionsQuartzcore,
-  AnonClassDefinitionsUikit;
-  
-{$define INTERFACE}
-
-{$include UndefinedTypes.inc}
-{$include uikit/AnonIncludeClassDefinitionsUikit.inc}
-
-{$define HEADER}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef HEADER}
-
-{$define TYPES}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef TYPES}
-
-{$define RECORDS}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef RECORDS}
-
-type
-{$define FORWARD}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef FORWARD}
-
-{$define PROTOCOLS}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef PROTOCOLS}
-
-{$define CLASSES}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef CLASSES}
- 
-{$define FUNCTIONS}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef FUNCTIONS}
-
-{$define EXTERNAL_SYMBOLS}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef EXTERNAL_SYMBOLS}
-
-{$define USER_PATCHES}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include quartzcore/QuartzCore.inc}
-{$include uikit/UIKit.inc}
-{$undef USER_PATCHES}
-
-{ Inline functions }
-function NSSTR (inString: PChar): NSString;
-function NSMakeRange (loc: NSUInteger; len: NSUInteger): NSRange;
-function NSMaxRange (range: NSRange): NSUInteger;
-function NSLocationInRange (loc: NSUInteger; range: NSRange): boolean;
-function NSEqualRanges (range1, range2: NSRange): boolean;
-function NSMakePoint (x: CGFloat; y: CGFloat): NSPoint;
-function NSMakeSize(w: CGFloat; h: CGFloat): NSSize;
-function NSMakeRect(x, y: CGFloat; w, h: CGFloat): NSRect;
-function NSMaxX (aRect: NSRect): CGFloat;
-function NSMaxY (aRect: NSRect): CGFloat;
-function NSMidX (aRect: NSRect): CGFloat;
-function NSMidY (aRect: NSRect): CGFloat;
-function NSMinX (aRect: NSRect): CGFloat;
-function NSMinY (aRect: NSRect): CGFloat;
-function NSWidth (aRect: NSRect): CGFloat;
-function NSHeight (aRect: NSRect): CGFloat;
-function NSRectFromCGRect (aRect: CGRect): NSRect;
-function NSRectToCGRect (aRect: NSRect): CGRect;
-function NSPointFromCGPoint (aPoint: CGPoint): NSPoint;
-function NSPointToCGPoint (aPoint: NSPoint): CGPoint;
-function NSSizeFromCGSize(aSize: CGSize): NSSize;
-function NSSizeToCGSize(aSize: NSSize): CGSize;
-
-{$undef INTERFACE}
-implementation
-{$define IMPLEMENTATION}
-
-{$include InlineFunctions.inc}
-
-{$define USER_PATCHES}
-{$include foundation/Foundation.inc}
-{$include appkit/AppKit.inc}
-{$include uikit/UIKit.inc}
-{$undef USER_PATCHES}
-
-{$undef IMPLEMENTATION}
-end.

packages/cocoaint/src/uikit/UIKit.inc

@@ -1,51 +0,0 @@
-{$include UIKitDefines.inc}
-{$include UIAccelerometer.inc}
-{$include UIResponder.inc}
-{$include UIView.inc}
-{$include UIWindow.inc}
-{$include UIDevice.inc}
-{$include UIApplication.inc}
-{$include UIControl.inc}
-{$include UIActivityIndicatorView.inc}
-{$include UIBarItem.inc}
-{$include UIBarButtonItem.inc}
-{$include UIButton.inc}
-{$include UIColor.inc}
-{$include UIDatePicker.inc}
-{$include UIEvent.inc}
-{$include UIFont.inc}
-{$include UIGeometry.inc}
-{$include UIGraphics.inc}
-{$include UIImage.inc}
-{$include UIImageView.inc}
-{$include UIViewController.inc}
-{$include UINavigationController.inc}
-{$include UITabBarController.inc}
-{$include UIImagePickerController.inc}
-{$include UIInterface.inc}
-{$include UIAlert.inc}
-{$include UILabel.inc}
-{$include UINavigationBar.inc}
-{$include UINibDeclarations.inc}
-{$include UINibLoading.inc}
-{$include UIPageControl.inc}
-{$include UIPickerView.inc}
-{$include UIProgressView.inc}
-{$include UIScreen.inc}
-{$include UIScrollView.inc}
-{$include UISearchBar.inc}
-{$include UISegmentedControl.inc}
-{$include UISlider.inc}
-{$include UIStringDrawing.inc}
-{$include UISwitch.inc}
-{$include UITabBar.inc}
-{$include UITabBarItem.inc}
-{$include UITableView.inc}
-{$include UITableViewCell.inc}
-{$include UITableViewController.inc}
-{$include UITextInputTraits.inc}
-{$include UITextField.inc}
-{$include UITextView.inc}
-{$include UIToolbar.inc}
-{$include UITouch.inc}
-{$include UIWebView.inc}

packages/cocoaint/src/uikit/UndefinedClasses.inc

@@ -1,13 +0,0 @@
-
-{ Private instance variables from UITextField.h }
-UITextFieldBorderView = id;
-UITextFieldBackgroundView = id;
-UITextFieldLabel = id;
-UITextFieldAtomBackgroundView = id;
-
-{ Private instance variables from UITextView.h }
-WebFrame = id;
-WebCoreFrameBridge = id;
-DOMHTMLElement = id;
-UIDelayedAction = id;
-UIWebDocumentView = id;

packages/cocoaint/src/webkit/WebUIDelegate.inc

@@ -8,37 +8,37 @@
 
 const
   WebMenuItemTagOpenLinkInNewWindow = 1;
-  WebMenuItemTagDownloadLinkToDisk = 0;
-  WebMenuItemTagCopyLinkToClipboard = 1;
-  WebMenuItemTagOpenImageInNewWindow = 2;
-  WebMenuItemTagDownloadImageToDisk = 3;
-  WebMenuItemTagCopyImageToClipboard = 4;
-  WebMenuItemTagOpenFrameInNewWindow = 5;
-  WebMenuItemTagCopy = 6;
-  WebMenuItemTagGoBack = 7;
-  WebMenuItemTagGoForward = 8;
-  WebMenuItemTagStop = 9;
-  WebMenuItemTagReload = 10;
-  WebMenuItemTagCut = 11;
-  WebMenuItemTagPaste = 12;
-  WebMenuItemTagSpellingGuess = 13;
-  WebMenuItemTagNoGuessesFound = 14;
-  WebMenuItemTagIgnoreSpelling = 15;
-  WebMenuItemTagLearnSpelling = 16;
-  WebMenuItemTagOther = 17;
-  WebMenuItemTagSearchInSpotlight = 18;
-  WebMenuItemTagSearchWeb = 19;
-  WebMenuItemTagLookUpInDictionary = 20;
-  WebMenuItemTagOpenWithDefaultApplication = 21;
-  WebMenuItemPDFActualSize = 22;
-  WebMenuItemPDFZoomIn = 23;
-  WebMenuItemPDFZoomOut = 24;
-  WebMenuItemPDFAutoSize = 25;
-  WebMenuItemPDFSinglePage = 26;
-  WebMenuItemPDFFacingPages = 27;
-  WebMenuItemPDFContinuous = 28;
-  WebMenuItemPDFNextPage = 29;
-  WebMenuItemPDFPreviousPage = 30;
+  WebMenuItemTagDownloadLinkToDisk = 2;
+  WebMenuItemTagCopyLinkToClipboard = 3;
+  WebMenuItemTagOpenImageInNewWindow = 4;
+  WebMenuItemTagDownloadImageToDisk = 5;
+  WebMenuItemTagCopyImageToClipboard = 6;
+  WebMenuItemTagOpenFrameInNewWindow = 7;
+  WebMenuItemTagCopy = 8;
+  WebMenuItemTagGoBack = 9;
+  WebMenuItemTagGoForward = 10;
+  WebMenuItemTagStop = 11;
+  WebMenuItemTagReload = 12;
+  WebMenuItemTagCut = 13;
+  WebMenuItemTagPaste = 14;
+  WebMenuItemTagSpellingGuess = 15;
+  WebMenuItemTagNoGuessesFound = 16;
+  WebMenuItemTagIgnoreSpelling = 17;
+  WebMenuItemTagLearnSpelling = 18;
+  WebMenuItemTagOther = 19;
+  WebMenuItemTagSearchInSpotlight = 20;
+  WebMenuItemTagSearchWeb = 21;
+  WebMenuItemTagLookUpInDictionary = 22;
+  WebMenuItemTagOpenWithDefaultApplication = 23;
+  WebMenuItemPDFActualSize = 24;
+  WebMenuItemPDFZoomIn = 25;
+  WebMenuItemPDFZoomOut = 26;
+  WebMenuItemPDFAutoSize = 27;
+  WebMenuItemPDFSinglePage = 28;
+  WebMenuItemPDFFacingPages = 29;
+  WebMenuItemPDFContinuous = 30;
+  WebMenuItemPDFNextPage = 31;
+  WebMenuItemPDFPreviousPage = 32;
 
 const
   WebDragDestinationActionNone = 0;

packages/cocoaint/utils/patches/cocoa-coredata-webkit.patch

@@ -4,7 +4,7 @@
    NSWorkspaceLaunchNewInstance = $00080000;
    NSWorkspaceLaunchAndHide = $00100000;
    NSWorkspaceLaunchAndHideOthers = $00200000;
--  NSWorkspaceLaunchAllowingClassicStartup = 0;
+-  NSWorkspaceLaunchAllowingClassicStartup = 2097153;
 +  NSWorkspaceLaunchDefault = NSWorkspaceLaunchAsync or NSWorkspaceLaunchAllowingClassicStartup;
  
  const

packages/cocoaint/utils/source/docset.php

@@ -0,0 +1,140 @@
+<?
+
+// Returns an array of sub-directories for $directory
+function sub_directories ($directory, &$directories) {
+	
+	if (file_exists($directory)) {
+		$directories[] = $directory;
+	} else {
+		$directories = array();
+	}
+	
+	if ($handle = @opendir($directory)) {
+		while (($file = readdir($handle)) !== false) {
+			if (($file != '.') && ($file != '..') && ($file[0] != '.')) {
+				$path = "$directory/$file";
+				
+				if (is_dir($path)) sub_directories($path, $directories);
+			}
+		}
+		closedir($handle);
+	}
+}
+
+
+class DocSetParser {
+
+	var $docset;
+	var $methods = array();
+
+	// Parse a single reference file
+	private function parse ($path, $class) {
+		$method = null;
+		$methods = array();
+		
+		if ($lines = @file($path)) {
+			foreach ($lines as $line) {
+
+				// Parse instance method description
+				if ($method) {
+					if (preg_match("/<span.*data-abstract='(.*)'>/i", $line, $captures)) {
+						$methods[$method] = strip_tags($captures[1]);
+						$method = null;
+					}
+				}
+
+				// Found type definition tag
+				if (preg_match("/<h3 class=\"tight jump typeDef\">(\w+)<\/h3><p class=\"abstract\">(.*)<\/p>/i", $line, $captures)) {
+					
+					// Read until the end </p> because I can't get preg_match to do this
+					$text = substr($captures[2], 0, (stripos($captures[2], "</p>")));
+					if (!$text) $text = $captures[2];
+					
+					$methods[$captures[1]] = strip_tags($text);
+				}
+				
+				// Found constant tag
+				if (preg_match("/<code class=\"jump constantName\">(\w+)<\/code><\/dt><dd><p>(.*)<\/p>/i", $line, $captures)) {
+					//print_r($captures);
+					// Read until the end </p> because I can't get preg_match to do this
+					$text = substr($captures[2], 0, (stripos($captures[2], "</p>")));
+					if (!$text) $text = $captures[2];
+					
+					$methods[$captures[1]] = strip_tags($text);
+				}
+				
+				// Found instance method tag
+				if (preg_match("<a href=\"#//apple_ref/occ/(instm|intfm|intfp|clm)+/([a-zA-Z:_]+)/([a-zA-Z:_]+)\">", $line, $captures)) {
+					//print_r($captures);
+					if ($captures[2] == $class) {
+						$method = $captures[3];
+						continue;
+					}
+				}
+
+			}
+
+		} else {
+			print("* Warning: Can't find the docset at $path.\n");
+		}
+		
+		return $methods;
+	}
+	
+	// Parses the reference index.html file for the path to the reference html file
+	private function parse_reference_index ($path) {
+		$lines = file($path);
+		foreach ($lines as $line) {
+			if (preg_match("/<meta id=\"refresh\" http-equiv=\"refresh\" CONTENT=\"0; URL=(.*)\">/i", $line, $captures)) {
+				return $captures[1];
+			}
+		}
+	}
+	
+	public function parse_directory ($paths) {
+
+		foreach ($paths as $path) {
+			$path = $this->docset."/Contents/Resources/Documents/documentation".$path;
+			
+			if (file_exists($path)) {
+				sub_directories($path, $sub_directories);
+				foreach ($sub_directories as $directory) {
+					$name = basename($directory);
+					if (preg_match("/^(\w+)_(class|protocol)$/i", $name, $captures)) {
+						
+						$class = $captures[1];
+						$sub_path = $this->parse_reference_index("$directory/index.html");
+						
+						if ($methods = $this->parse("$directory/$sub_path", $class)) {
+							$this->methods[$class] = $methods;
+						}
+					}
+				}
+			} else {
+				print("* Warning: The docset at $path can't be found.\n");
+			}
+		}
+		
+		return true;
+	}
+		
+	function __construct ($docset) {
+		$this->docset = $docset;
+	}
+}
+
+
+// Cocoa
+//$path = "/Users/ryanjoseph/Desktop/com.apple.adc.documentation.AppleSnowLeopard.CoreReference.docset";
+//$folders = array("/Cocoa/Reference");
+
+// UIKIT
+// $path = "/Users/ryanjoseph/Desktop/com.apple.adc.documentation.AppleiOS4_2.iOSLibrary.docset";
+//$folders = array("/UIKit/Reference");
+
+//$parser = new DocSetParser($path);
+//$parser->parse_directory($folders);
+//print_r($parser->methods);
+
+
+?>

packages/cocoaint/utils/source/objp.php

@@ -2458,8 +2458,10 @@ class ObjectivePParser extends ObjectivePParserBase {
 		} elseif (ereg("^[[:space:]]*[,]*[[:space:]]*([a-zA-Z0-9_]+)[[:space:]]*=[[:space:]]*[(]*([0-9-]+)[)]*[,]*[[:space:]]*$", $line, $captures)) { // integer value
 			$captures[2] = trim($captures[2], ", ");
 			$this->dump[$file_name]["types"]["enums"][$block_count][] = $captures[1]." = ".$captures[2].";".$this->AppendEOLComment();
+			$auto_increment = $captures[2] + 1;
 		} elseif (ereg("^[[:space:]]*[,]*[[:space:]]*([a-zA-Z0-9_]+)[[:space:]]*=[[:space:]]*[(]*([0-9]+[xX]+[a-fA-F0-9]+)[)]*", $line, $captures)) { // hexadecimal value
 			$captures[2] = trim($captures[2], ", ");
+			$auto_increment = $captures[2] + 1;
 			$captures[2] = eregi_replace("^0x", "$", $captures[2]);
 			$this->dump[$file_name]["types"]["enums"][$block_count][] = $captures[1]." = ".$captures[2].";".$this->AppendEOLComment();
 		} elseif (ereg("^[[:space:]]*[,]*[[:space:]]*([a-zA-Z0-9_]+)[[:space:]]*=[[:space:]]*([a-zA-Z0-9]+[[:space:]]*<<[[:space:]]*[a-zA-Z0-9]+)", $line, $captures)) { // << shl value, no ()
@@ -2470,6 +2472,9 @@ class ObjectivePParser extends ObjectivePParserBase {
 			$captures[2] = ereg_replace("([[:space:]])shl([[:space:]]+)([0-9]+)[UL]+", "\\1shl\\2\\3", $captures[2]);
 
 			$this->dump[$file_name]["types"]["enums"][$block_count][] = $captures[1]." = ".$captures[2].";".$this->AppendEOLComment();
+			$operands = preg_split("/\s*shl\s*/", $captures[2]);
+			$auto_increment = ($operands[0] << $operands[1]) + 1;
+			
 		} elseif (ereg("^[[:space:]]*[,]*[[:space:]]*([a-zA-Z0-9_]+)[[:space:]]*=[[:space:]]*\(([a-zA-Z0-9]+[[:space:]]*<<[[:space:]]*[a-zA-Z0-9]+)\)", $line, $captures)) { // << shl value
 			$captures[2] = trim($captures[2], ", ");
 			$captures[2] = ereg_replace("[[:space:]]?<<[[:space:]]?", " shl ", $captures[2]);
@@ -2479,6 +2484,9 @@ class ObjectivePParser extends ObjectivePParserBase {
 			$captures[2] = ereg_replace("([[:space:]])shl([[:space:]]+)([0-9]+)[UL]+", "\\1shl\\2\\3", $captures[2]);
 
 			$this->dump[$file_name]["types"]["enums"][$block_count][] = $captures[1]." = ".$captures[2].";".$this->AppendEOLComment();
+			
+			$operands = preg_split("/\s*shl\s*/", $captures[2]);
+			$auto_increment = ($operands[0] << $operands[1]) + 1;
 		} elseif (ereg("^[[:space:]]*[,]*[[:space:]]*([a-zA-Z0-9_]+)[[:space:]]*[,}]*[[:space:]]*$", $line, $captures)) { // non-value
 			
 			// omit lines which started nested structures.
@@ -2657,7 +2665,7 @@ class ObjectivePParser extends ObjectivePParserBase {
 								
 				// parse enum fields
 				if (($got_enum) || ($got_named_enum)) {
-					// print($line."\n");
+					// print($line.", auto_inc = $auto_increment\n");
 					
 					$this->ParseEnumFields($line, $file_name, &$block_count, &$auto_increment);
 

packages/cocoaint/utils/uikit-skel/src/iPhoneAll.pas

@@ -14,7 +14,7 @@ uses
   ctypes,
   CFBase,CFArray,CFBag,CFCharacterSet,CFData,CFDate,CFDictionary,CFNumber,CFPropertyList,CFSet,CFString,CFStringEncodingExt,CFTimeZone,CFTree,CFURL,CFXMLNode,CFXMLParser,CFMachPort,CFMessagePort,CFRunLoop,CFSocket,CFBinaryHeap,CFBitVector,CFBundle,CFByteOrders,CFPlugIn,CFPreferences,CFURLAccess,CFUUID,CFLocale,CFStream,CFDateFormatter,CFNumberFormatter,CFCalendar,CFUserNotification,CFNotificationCenter,CFAttributedString,CFNetworkErrorss,
   CGBase,CGAffineTransforms,CGBitmapContext,CGColor,CGColorSpace,CGContext,CGDataConsumer,CGDataProvider,CGDirectDisplay,CGDirectPalette,CGDisplayConfiguration,CGDisplayFades,CGErrors,CGEvent,CGEventSource,CGEventTypes,CGFont,CGFunction,CGGLContext,CGGeometry,CGImage,CGLayer,CGPDFArray,CGPDFContentStream,CGPDFContext,CGPDFDictionary,CGPDFDocument,CGPDFObject,CGPDFOperatorTable,CGPDFPage,CGPDFScanner,CGPDFStream,CGPDFString,CGPSConverter,CGPath,CGPattern,CGRemoteOperation,CGSession,CGShading,CGWindowLevels,
-  MacTypes, AEDataModel, Icons, SecBase, SecTrust,
+  MacTypes, SecBase, SecTrust,
   AnonClassDefinitionsUikit;
 
 { undefine to generate SDK 3.2 headers }

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

@@ -549,7 +549,7 @@ procedure RegisterDatapacketReader(ADatapacketReaderClass : TDatapacketReaderCla
 
 implementation
 
-uses variants, dbconst;
+uses variants, dbconst, FmtBCD;
 
 Type TDatapacketReaderRegistration = record
                                        ReaderClass : TDatapacketReaderClass;
@@ -659,6 +659,18 @@ begin
     result := 0;
 end;
 
+function DBCompareBCD(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
+begin
+  // A simple subtraction doesn't work, since it could be that the result
+  // doesn't fit into a LargeInt
+  if PBCD(subValue)^ < PBCD(aValue)^ then
+    result := -1
+  else if PBCD(subValue)^  > PBCD(aValue)^ then
+    result := 1
+  else
+    result := 0;
+end;
+
 procedure unSetFieldIsNull(NullMask : pbyte;x : longint); //inline;
 begin
   NullMask[x div 8] := (NullMask[x div 8]) and not (1 shl (x mod 8));
@@ -1503,6 +1515,7 @@ begin
     ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
       @DBCompareDouble;
     ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
+    ftFmtBCD : ACompareRec.Comparefunc := @DBCompareBCD;
   else
     DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName,Fieldtypenames[AField.DataType]]);
   end;
@@ -1638,6 +1651,7 @@ begin
       ftword     : result := sizeof(longint);
     ftBoolean    : result := sizeof(wordbool);
     ftBCD        : result := sizeof(currency);
+    ftFmtBCD     : result := sizeof(TBCD);
     ftFloat,
       ftCurrency : result := sizeof(double);
     ftLargeInt   : result := sizeof(largeint);

packages/fcl-db/src/base/dataset.inc

@@ -901,8 +901,7 @@ begin
           if Required then Attributes := attributes + [faRequired];
           if ReadOnly then Attributes := attributes + [faReadOnly];
           if DataType = ftBCD then precision := (fields[i] as TBCDField).Precision
-          // this must change if TFMTBcdfield is implemented
-          else if DataType = ftFMTBcd then precision := (fields[i] as TBCDField).Precision;
+          else if DataType = ftFMTBcd then precision := (fields[i] as TFMTBCDField).Precision;
           end;
         end;
     finally

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

@@ -794,6 +794,48 @@ type
     property Size default 4;
   end;
 
+{ TFMTBCDField }
+
+  TFMTBCDField = class(TNumericField)
+  private
+    FMinValue,
+    FMaxValue   : TBCD;
+    FPrecision  : Longint;
+    FCurrency   : boolean;
+    function GetMaxValue: string;
+    function GetMinValue: string;
+    procedure SetMaxValue(const AValue: string);
+    procedure SetMinValue(const AValue: string);
+  protected
+    class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsBCD: TBCD; override;
+    function GetAsCurrency: Currency; override;
+    function GetAsFloat: Double; override;
+    function GetAsLongint: Longint; override;
+    function GetAsString: string; override;
+    function GetAsVariant: variant; override;
+    function GetDataSize: Integer; override;
+    function GetDefaultWidth: Longint; override;
+    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure SetAsBCD(const AValue: TBCD); override;
+    procedure SetAsFloat(AValue: Double); override;
+    procedure SetAsLongint(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+    procedure SetAsCurrency(AValue: Currency); override;
+    procedure SetVarValue(const AValue: Variant); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    function CheckRange(AValue : TBCD) : Boolean;
+    property Value: TBCD read GetAsBCD write SetAsBCD;
+  published
+    property Precision: Longint read FPrecision write FPrecision default 15;
+    property Currency: Boolean read FCurrency write FCurrency;
+    property MaxValue: string read GetMaxValue write SetMaxValue;
+    property MinValue: string read GetMinValue write SetMinValue;
+    property Size default 4;
+  end;
+
+
 { TBlobField }
   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
   TBlobType = ftBlob..ftWideMemo;
@@ -1833,7 +1875,7 @@ const
     varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varError,
     varOleStr, varOleStr, varError, varError, varError, varError, varError,
     varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr,
-    varOleStr,varOleStr, varOleStr,varOleStr);
+    varOleStr, varDouble, varOleStr,varOleStr);
 
 
 Const
@@ -1942,7 +1984,7 @@ const
       { ftIDispatch} Nil,
       { ftGuid} TGuidField,
       { ftTimeStamp} Nil,
-      { ftFMTBcd} Nil,
+      { ftFMTBcd} TFMTBCDField,
       { ftFixedWideString} TWideStringField,
       { ftWideMemo} TWideMemoField
     );

packages/fcl-db/src/base/fields.inc

@@ -109,10 +109,8 @@ begin
       TFloatField(Result).Precision:=FPrecision;
     if (Result is TBCDField) then
       TBCDField(Result).Precision:=FPrecision;
-    {Add when implemented:
     if (Result is TFmtBCDField) then
       TFmtBCDField(Result).Precision:=FPrecision;
-    }
   except
     Result.Free;
     Raise;
@@ -1072,7 +1070,7 @@ function TStringField.GetDataSize: Integer;
 
 begin
   if DataType=ftFixedChar then
-    Result:=Size
+    Result:=Size+1
   else
     Result:=Size+1;
 end;
@@ -2395,6 +2393,180 @@ begin
 end;
 
 
+{ TFMTBCDField }
+
+class procedure TFMTBCDField.CheckTypeSize(AValue: Longint);
+begin
+  If AValue > MAXFMTBcdFractionSize then
+    DatabaseErrorfmt(SInvalidFieldSize,[AValue]);
+end;
+
+constructor TFMTBCDField.Create(AOwner: TComponent);
+begin
+  Inherited Create(AOwner);
+  FMaxValue := 0;
+  FMinValue := 0;
+  FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
+  SetDataType(ftFMTBCD);
+// Max.precision for NUMERIC,DECIMAL datatypes supported by some databases:
+//  Firebird-18; Oracle,SqlServer-38; MySQL-65; PostgreSQL-1000
+  Precision := 15; //default number of digits
+  Size:=4; //default number of digits after decimal place
+end;
+
+function TFMTBCDField.GetDataSize: Integer;
+begin
+  Result := sizeof(TBCD);
+end;
+
+function TFMTBCDField.GetDefaultWidth: Longint;
+begin
+  if Precision > 0 then Result := Precision+1
+  else Result := inherited GetDefaultWidth;
+end;
+
+function TFMTBCDField.GetAsBCD: TBCD;
+begin
+  if not GetData(@Result) then
+    Result := NullBCD;
+end;
+
+function TFMTBCDField.GetAsCurrency: Currency;
+var bcd: TBCD;
+begin
+  if GetData(@bcd) then
+    BCDToCurr(bcd, Result)
+  else
+    Result := 0;
+end;
+
+function TFMTBCDField.GetAsVariant: Variant;
+var bcd: TBCD;
+begin
+  If GetData(@bcd) then
+    Result := VarFMTBcdCreate(bcd)
+  else
+    Result := Null;
+end;
+
+function TFMTBCDField.GetAsFloat: Double;
+var bcd: TBCD;
+begin
+  If GetData(@bcd) then
+    Result := BCDToDouble(bcd)
+  else
+    Result := 0;
+end;
+
+function TFMTBCDField.GetAsLongint: Longint;
+begin
+  Result := round(GetAsFloat);
+end;
+
+function TFMTBCDField.GetAsString: string;
+var bcd: TBCD;
+begin
+  If GetData(@bcd) then
+    Result:=BCDToStr(bcd)
+  else
+    Result:='';
+end;
+
+procedure TFMTBCDField.GetText(var TheText: string; ADisplayText: Boolean);
+var
+  bcd: TBCD;
+  E: double; //remove when formatBCD,BCDToStrF in fmtbcd.pp will be implemented
+  fmt: String;
+begin
+  if GetData(@bcd) then begin
+    E:=BCDToDouble(bcd);
+    if aDisplayText or (FEditFormat='') then
+      fmt := FDisplayFormat
+    else
+      fmt := FEditFormat;
+    if fmt<>'' then
+      TheText := FormatFloat(fmt,E)
+      //TheText := FormatBCD(fmt,bcd)
+    else if fCurrency then begin
+      if aDisplayText then
+        TheText := FloatToStrF(E, ffCurrency, FPrecision, 2{digits?})
+        //TheText := BcdToStrF(bcd, ffCurrency, FPrecision, 2{digits?})
+      else
+        TheText := FloatToStrF(E, ffFixed, FPrecision, 2{digits?});
+        //TheText := BcdToStrF(bcd, ffFixed, FPrecision, 2{digits?});
+    end else
+      TheText := BcdToStr(bcd);
+      //TheText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize);
+  end else
+    TheText := '';
+end;
+
+function TFMTBCDField.GetMaxValue: string;
+begin
+  Result:=BCDToStr(FMaxValue);
+end;
+
+function TFMTBCDField.GetMinValue: string;
+begin
+  Result:=BCDToStr(FMinValue);
+end;
+
+procedure TFMTBCDField.SetMaxValue(const AValue: string);
+begin
+  FMaxValue:=StrToBCD(AValue);
+end;
+
+procedure TFMTBCDField.SetMinValue(const AValue: string);
+begin
+  FMinValue:=StrToBCD(AValue);
+end;
+
+Function TFMTBCDField.CheckRange(AValue: TBCD) : Boolean;
+begin
+  If (FMinValue<>0) or (FMaxValue<>0) then
+    Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
+  else
+    Result:=True;
+end;
+
+procedure TFMTBCDField.SetAsBCD(const AValue: TBCD);
+begin
+  if CheckRange(AValue) then
+    SetData(@AValue)
+  else
+    RangeError(AValue, BCDToDouble(FMinValue), BCDToDouble(FMaxValue));
+end;
+
+procedure TFMTBCDField.SetAsCurrency(AValue: Currency);
+var bcd: TBCD;
+begin
+  if CurrToBCD(AValue, bcd, 32, Size) then
+    SetAsBCD(bcd);
+end;
+
+procedure TFMTBCDField.SetVarValue(const AValue: Variant);
+begin
+  SetAsBCD(VarToBCD(AValue));
+end;
+
+procedure TFMTBCDField.SetAsFloat(AValue: Double);
+begin
+  SetAsBCD(DoubleToBCD(AValue));
+end;
+
+
+procedure TFMTBCDField.SetAsLongint(AValue: Longint);
+begin
+  SetAsBCD(IntegerToBCD(AValue));
+end;
+
+
+procedure TFMTBCDField.SetAsString(const AValue: string);
+begin
+  SetAsBCD(StrToBCD(AValue));
+end;
+
+
 { TBlobField }
 
 Function TBlobField.GetBlobStream(Mode : TBlobStreamMode) : TStream;

packages/fcl-db/src/memds/memds.pp

@@ -300,6 +300,7 @@ begin
  dt1:= FieldDefs.Items[FieldNo-1].Datatype;
  case dt1 of
   ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
+  ftFixedChar:result:=FieldDefs.Items[FieldNo-1].Size+1;
   ftBoolean:  result:=SizeOf(Wordbool);
   ftFloat:    result:=SizeOf(Double);
   ftLargeInt: result:=SizeOf(int64);
@@ -964,6 +965,7 @@ begin
                 ftInteger  : F1.AsInteger:=F2.AsInteger;
                 ftDate     : F1.AsDateTime:=F2.AsDateTime;
                 ftTime     : F1.AsDateTime:=F2.AsDateTime;
+                ftDateTime : F1.AsDateTime:=F2.AsDateTime;
               end;
               end;
             Try

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

@@ -559,7 +559,7 @@ begin
       NewType := ftInteger;
       NewSize := 0;
       end;
-{$ifdef mysql50}
+{$if defined(mysql51) or defined(mysql50)}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}
     FIELD_TYPE_DECIMAL: if ADecimals < 5 then
@@ -867,7 +867,7 @@ begin
         VL := 0;
       Move(VL, Dest^, SizeOf(LargeInt));
       end;
-{$ifdef mysql50}
+{$if defined(mysql51) or defined(mysql50)}
     FIELD_TYPE_NEWDECIMAL,
 {$endif}      
     FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -735,9 +735,9 @@ begin
   // TODO: finish this
   case FieldDef.DataType of
     ftWideString,ftFixedWideChar: // mapped to TWideStringField
-      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size, @StrLenOrInd);
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size+sizeof(WideChar), @StrLenOrInd); //buffer must contain space for the null-termination character
     ftGuid, ftFixedChar,ftString: // are mapped to a TStringField (including TGuidField)
-      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size, @StrLenOrInd);
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
     ftSmallint:           // mapped to TSmallintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
     ftInteger,ftWord,ftAutoInc:     // mapped to TLongintField
@@ -1023,12 +1023,12 @@ begin
     // convert type
     // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
     case DataType of
-      SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize+1; end;
-      SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize+1; end;
+      SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize; end;
+      SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize; end;
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
-      SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=(ColumnSize+1)*sizeof(Widechar); end;
-      SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=(ColumnSize+1)*sizeof(Widechar); end;
+      SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
+      SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
 {$ENDIF}
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
@@ -1063,7 +1063,7 @@ begin
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
-      SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=ColumnSize+1; end;
+      SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=ColumnSize; end;
 {$ENDIF}
     else
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -561,10 +561,11 @@ begin
       res := pqexec(tr.PGConn,pchar('deallocate prepst'+nr));
       if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
         begin
+          pqclear(res);
+          DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
+        end
+      else
         pqclear(res);
-        DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
-        end;
-      pqclear(res);
       end;
     FPrepared := False;
     end;
@@ -641,9 +642,12 @@ begin
         s := Statement;
       res := pqexec(tr.PGConn,pchar(s));
       if (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
-        pqclear(res);
+        begin
+          pqclear(res); 
+          res:=nil;
+        end;
       end;
-    if not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
+    if assigned(res) and not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
       begin
       s := PQerrorMessage(tr.PGConn);
       pqclear(res);

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -99,7 +99,7 @@ Var
 implementation
 
 uses
-  dbconst, sysutils, dateutils;
+  dbconst, sysutils, dateutils,FmtBCD;
  
 type
 
@@ -395,6 +395,8 @@ begin
                   System.Delete(FD,1,fi);
                   fi:=pos(')',FD);
                   size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
+                  if size1>4 then
+                    ft1 := ftFMTBcd;
                   end
                 else size1 := 4;
                 end;
@@ -489,6 +491,9 @@ var
  i64: int64;
  int1,int2: integer;
  str1: string;
+ bcd: tBCD;
+ StoreDecimalPoint: tDecimalPoint;
+ bcdstr: FmtBCDStringtype;
  ar1,ar2: TStringArray;
  st    : psqlite3_stmt;
 
@@ -526,6 +531,27 @@ begin
               if int1 > 0 then 
                  move(sqlite3_column_text(st,fnum)^,buffer^,int1);
               end;
+    ftFmtBCD: begin
+              int1:= sqlite3_column_bytes(st,fnum);
+              if int1>255 then
+                int1:=255;
+              if int1 > 0 then
+                begin
+                SetLength(bcdstr,int1);
+                move(sqlite3_column_text(st,fnum)^,bcdstr[1],int1);
+                StoreDecimalPoint:=FmtBCD.DecimalPoint;
+                // sqlite always uses the point as decimal-point
+                FmtBCD.DecimalPoint:=DecimalPoint_is_Point;
+                if not TryStrToBCD(bcdstr,bcd) then
+                  // sqlite does the same, if the value can't be interpreted as a
+                  // number in sqlite3_column_int, return 0
+                  bcd := 0;
+                FmtBCD.DecimalPoint:=StoreDecimalPoint;
+                end
+              else
+                bcd := 0;
+              pBCD(buffer)^:= bcd;
+              end;
     ftMemo,
     ftBlob: CreateBlob:=True;
   else { Case }

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -27,7 +27,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50];
           '',
           'DECIMAL(18,4)',
           'DATE',
-          'TIMESTAMP',
+          'TIME',
           'TIMESTAMP',
           '',
           '',
@@ -54,7 +54,7 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50];
           '',
           '',
           'TIMESTAMP',
-          '',
+          'NUMERIC(18,6)',
           '',
           ''
         );

packages/fcl-db/tests/testdbbasics.pas

@@ -54,8 +54,10 @@ type
     procedure TestSupportFloatFields;
     procedure TestSupportLargeIntFields;
     procedure TestSupportDateFields;
+    procedure TestSupportTimeFields;
     procedure TestSupportCurrencyFields;
     procedure TestSupportBCDFields;
+    procedure TestSupportfmtBCDFields;
     procedure TestSupportFixedStringFields;
 
     procedure TestAppendOnEmptyDataset;
@@ -145,7 +147,7 @@ type
 
 implementation
 
-uses bufdataset, variants, strutils, sqldb;
+uses bufdataset, variants, strutils, sqldb, FmtBCD;
 
 type THackDataLink=class(TdataLink);
 
@@ -1916,6 +1918,31 @@ begin
   ds.close;
 end;
 
+procedure TTestDBBasics.TestSupportTimeFields;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+    s          : string;
+    millisecond: word;
+    second     : word;
+    minute     : word;
+    hour       : word;
+begin
+  TestfieldDefinition(ftTime,8,ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    // Format the datetime in the format hh:nn:ss:zzz, where the hours can be bigger then 23.
+    DecodeTime(fld.AsDateTime,hour,minute,second,millisecond);
+    hour := hour + (trunc(Fld.AsDateTime) * 24);
+    s := Format('%.2d',[hour]) + ':' + format('%.2d',[minute]) + ':' + format('%.2d',[second]) + ':' + format('%.3d',[millisecond]);
+
+    AssertEquals(testTimeValues[i],s);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 procedure TTestDBBasics.TestSupportCurrencyFields;
 
 var i          : byte;
@@ -1953,6 +1980,24 @@ begin
   ds.close;
 end;
 
+procedure TTestDBBasics.TestSupportfmtBCDFields;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+
+begin
+  TestfieldDefinition(ftFMTBcd,sizeof(TBCD),ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    AssertEquals(testFmtBCDValues[i],Fld.AsString);
+    AssertEquals(testFmtBCDValues[i],Fld.AsBCD);
+    AssertEquals(StrToFloat(testFmtBCDValues[i]),Fld.AsFloat);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 procedure TTestDBBasics.TestSupportFixedStringFields;
 var i          : byte;
     ds         : TDataset;

packages/fcl-db/tests/toolsunit.pas

@@ -7,7 +7,7 @@ unit ToolsUnit;
 interface
 
 uses
-  Classes, SysUtils, DB, testdecorator;
+  Classes, SysUtils, DB, testdecorator, FmtBCD;
   
 Const MaxDataSet = 35;
   
@@ -95,6 +95,7 @@ const
   testValuesCount = 25;
   testFloatValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678,2.4,3.2,0.4,23);
   testCurrencyValues : Array[0..testValuesCount-1] of currency = (-100,-65.5,-54.34,-43.34,-2.50,-0.2,45.40,0.3,45.4,127,128,255,256,45,0.3,45.4,127,128,255,256,45,1234.56,43.23,43.43,99.88);
+  testFmtBCDValues : Array[0..testValuesCount-1] of string = ('-100','-65.5','-54.3333','-43.3334','-2.5','-0.234567','45.4','0.3','45.414585','127','128','255','256','45','0.3','45.4','127','128','255','256','45','1234.56789','43.23','43.500001','99.88');
   testIntValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxInt+1,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt-1,MaxInt,100,130,150,-150,-132,234);
   testSmallIntValues : Array[0..testValuesCount-1] of smallint = (-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,100,110,120,130,150,-150,-132,234,231,42);
   testLargeIntValues : Array[0..testValuesCount-1] of LargeInt = ( -$7fffffffffffffff,-$7ffffffffffffffe,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,$7fffffffffffffff-1,$7fffffffffffffff,235253244);
@@ -156,6 +157,35 @@ const
     '1900-01-01'
   );
 
+  testTimeValues : Array[0..testValuesCount-1] of string = (
+    '10:45:12:000',
+    '00:00:00:000',
+    '24:00:00:000',
+    '33:25:15:000',
+    '04:59:16:000',
+    '05:45:59:000',
+    '16:35:42:000',
+    '14:45:52:000',
+    '12:45:12:000',
+    '18:45:22:000',
+    '19:45:12:000',
+    '14:45:14:000',
+    '16:45:12:000',
+    '11:45:12:000',
+    '15:35:12:000',
+    '16:45:12:000',
+    '13:55:12:000',
+    '13:46:12:000',
+    '15:35:12:000',
+    '17:25:12:000',
+    '19:45:12:000',
+    '10:54:12:000',
+    '12:25:12:000',
+    '20:15:12:000',
+    '12:25:12:000'
+  );
+
+
 var dbtype,
     dbconnectorname,
     dbconnectorparams,
@@ -255,6 +285,8 @@ begin
   if DBConnectorRefCount>0 then exit;
   testValues[ftString] := testStringValues;
   testValues[ftFixedChar] := testStringValues;
+  testValues[ftTime] := testTimeValues;
+  testValues[ftFMTBcd] := testFmtBCDValues;
   for i := 0 to testValuesCount-1 do
     begin
     testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);

packages/fcl-passrc/examples/test_parser.pp

@@ -1,7 +1,151 @@
+{   This is a test-program for the fcl-passrc package (except writer-class).
+
+    Please notice that i have done this to find out how good the parser workes,
+    it is not thought to be a good example to use the fcl-passrc package but
+    may give you hints on using it.
+
+    It is done to test the source of these units for usability, completeness and
+    bugs. It is base on the fcl-passrc exampe.
+    It workes like a pretty-printer to compare the output of this program with
+    the original code, but is not thought to be a real pretty-printer as
+    e.g. the semicolons can sometimes not be set at the place they sould be
+    (this imformation is not available from the parsing-engine, as a parser
+    should only give you a positiv result if the source is valid, otherwise
+    you get a negative result).
+    Also the output is not always in the same order as in input as this
+    information is not available easily.
+    
+    !!!Do not expect this program to produce executeable output!!!
+
+    Status: -workes with one Unit or Program
+            -Some type declarations missing
+            -string[n] the [n] part missing -> missing in parser
+            -array of const -> missing in parser
+            -Hints deprecated, etc. missing sometimes
+            -the parser splits x,y:atype
+              x:atype
+              y:atype
+             i tryed to put them together again
+            - () missing in statements: () expression and typecast
+            -missing forward class declaration like x=class
+            -incomplete !
+
+            parser: -ugly ''' quotation from scanner, why not #39 ?
+                    -see comments in the program for hints
+                    -incomplete !
+
+    Usage: call with one complete filename of a Unit or Program
+           defaults for the parser are 'linux' and 'i386'
+
+    Output: is 'pretty-printed' to stdout or unformated
+            The unformated output is thought to be diffed with the original
+            source to see differences caused by the parser (a tool to unformat
+            a souce file is in progress but not finished jet).
+
+    Bugs: 1. In case of unimplemented statements (like up to now asm) the parser
+             cause a excemtion to abort the program hard.
+          2. Missing implementaion in this program should not print out anything
+             or result in not pascal conform output.
+
+    Hit: The parser uses directives given in the source file.
+
+   Hints to read the code:
+    There are comments in the code with hints and marks of possible bugs.
+    During development some code was modified for true order output but the
+    old code is still available as a comment as it is easier to understand.
+    This is programmed using 'recursive' calls. Most options in functions are
+    for printing the output.
+    There is no writer-class used to keep it simple and see what is done.
+    All output is produced by direct writing to stdout, this cause problems in
+    furter development; a function result as string may be more usable.
+
+    The parser was written to be used for unit interface and was expanded to
+    work with program and implementation too. It does nearly no seperate
+    things for programs, they are adapted to the unit scheme (see main).
+
+    The order will change in following case:
+     -function with forward declaration (also overloading etc.)
+
+
+  Inheritance (only the important ones):
+
+    TInterfaceSection, TImplementationSection, TProgramSection
+     |
+    TPasSection
+     |
+    TPasDeclarations
+     |
+    TPasElement
+     |
+    TPasElementBase
+     |
+    TObject
+
+    TInitializationSection, TFinalizationSection
+     |
+    TPasImplBlock
+     |
+    TPasImplElement
+     |
+    TPasElement
+     |
+    TPasElementBase
+     |
+    TObject
+
+    TPasProgram
+     |
+    TPasModule
+     |
+    TPasElement
+     |
+    TPasElementBase
+     |
+    TObject
+
+  Dependance Structure :
+
+    TPasPackage = class(TPasElement)
+      |
+    Modules: TList;
+
+    TPasModule = class(TPasElement)
+      |-InterfaceSection: TInterfaceSection;
+      |  |-Declarations -> forward part, unit only
+      |
+      |-ImplementationSection: TImplementationSection;
+      |  |-Declarations -> full declaration, unit and program
+      |     |-Functions: TList;
+      |        |-TPasFunction = class(TPasProcedureBase)
+      |           |-Body: TProcedureBody;
+      |              |-Declarations -> declaration and sub function
+      |              |-Body: TPasImplBlock; -> procedure block
+      |
+      |-InitializationSection: TInitializationSection;
+      |  |-TPasImplBlock.Elements: TList; -> main block
+      |
+      |-FinalizationSection: TFinalizationSection;
+         |-TPasImplBlock.Elements: TList; -> unit only
+
+    Declarations = class(TPasElement)
+      |-Declarations: TList; -> the following are all in here
+      |-ResStrings: TList;
+      |-Types: TList;
+      |-Consts: TList;
+      |-Classes: TList;
+      |-Functions: TList;
+      |-Variables: TList;
+      |-Properties: TList;
+    }
+
+
+program test_parser1;
 {$mode objfpc}{$H+}
 
 uses SysUtils, Classes, PParser, PasTree;
 
+//# types the parser needs
+
 type
   { We have to override abstract TPasTreeContainer methods.
     See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
@@ -31,43 +175,1779 @@ begin
   Result := nil;
 end;
 
+
+//# main var
 var
   M: TPasModule;
   E: TPasTreeContainer;
   I: Integer;
-  Decls: TList;
-  cmdl : string;
+  cmdl, TargetOS, TargetCPU : string;
+  isim, //is Impleamentation, only for GetTPasProcedureBody
+  Unformated:boolean; // no Formating in output
+  
+
+//# tools
+
+ function GetIndent(indent:integer):String;
+   var i:integer;
+  begin
+   Result:='';
+   if not Unformated then 
+      for i:=1 to indent do Result:=Result+' ';
+  end;
+
+ //delete ugly quoting '''STRING'''
+ function DelQuot(s:String):String;
+    var i:integer;
+    const s1=#39#39#39;
+   begin
+    Result:='';
+    i:=pos(s1,s);
+    while i > 0 do
+     begin
+      if i > 0 then delete(s,i,2);
+      i:=pos(s1,s);
+     end; 
+    //if i > 0 then delete(s,i,2);
+    Result:=s;
+   end;
+
+ //LeadingSpace only valid if Formated output (as this will be one line in output)
+ //UnFormated: all is printed in a new line
+ procedure WriteFmt(LeadingSpace:boolean; s:String; Semicolon:boolean);
+  begin
+   if Semicolon then s:=s+';';
+   if Unformated then writeln(s)
+    else if LeadingSpace then write(' ',s)
+     else write(s);
+  end;
+
+//# parsing output
+
+function GetTPasImplBlock(lb:TPasImplBlock; indent,declistby:integer;
+                           LastNoSem,NoFirstIndent:boolean):boolean; forward;
+
+function GetTPasImplElement(le:TPasImplElement; lindent:integer;
+                             lLastNoSem,NoFirstIndent:boolean):boolean; forward;
+
+procedure GetDecls(Decl:TPasDeclarations; indent:integer); forward;
+//procedure PrintDecls(Decl:TPasDeclarations; indent:integer); forward;
+
+//# most is for implementation or implblocks except the expr things
+
+function ReturnTPasMemberHints(h:TPasMemberHints):String;
+ begin
+  Result:='';
+  if hDeprecated    in h then Result:=' deprecated'; 
+  if hLibrary       in h then Result:=Result+' library';
+  if hPlatform      in h then Result:=Result+' platform';
+  if hExperimental  in h then Result:=Result+' experimental';
+  if hUnimplemented in h then Result:=Result+' unimplemented';
+ end;      
+   
+function GetTPasMemberHints(h:TPasMemberHints):Boolean;
+ begin
+  Result:=false;
+  if hDeprecated in h then begin write(' deprecated'); Result:=true; end;
+  if hLibrary in h then begin write(' library'); Result:=true; end;
+  if hPlatform in h then begin write(' platform'); Result:=true; end;
+  if hExperimental in h then begin write(' experimental'); Result:=true; end;
+  if hUnimplemented in h then begin write(' unimplemented'); Result:=true; end;
+ end;   
+
+
+
+
+function GetTPasExprKind(lpek:TPasExprKind):String;
+ begin
+  Result:='';
+  case lpek of
+    pekIdent:Result:='ID';
+    pekNumber:Result:='NUMBER';
+    pekString:Result:='STRING';
+    pekSet:Result:='SET';
+    pekNil:Result:='NIL';
+    pekBoolConst:Result:='BOOL';
+    pekRange:Result:='RANGE';
+    pekUnary:Result:='UNARY';
+    pekBinary:Result:='BINARY';
+    pekFuncParams:Result:='FUNCPAR';
+    pekArrayParams:Result:='ARRAYPAR';
+    pekListOfExp:Result:='EXPLIST';
+  end;
+ end;
+
+procedure GetTPasExpr(lex:TPasExpr);
+ var lex1:TpasExpr;
+     lpe:TParamsExpr;
+     l:integer;
+     lbk,rbk,sep:string;
+     lav:TArrayValues;
+     lrv:TRecordValues;
+     rvi:TRecordValuesItem;
+
+
+ function GetExpKind(ek:TPasExprKind; var lbrak,rbrak:string):string;
+  begin
+   lbrak:='';
+   rbrak:='';
+   Result:='';
+   case ek of
+    pekIdent:Result:='ID';
+    pekNumber:Result:='NU';
+    pekString:begin lbrak:=#39; rbrak:=#39; Result:=#39; end;
+    pekSet:begin lbrak:='['; rbrak:=']'; Result:=','; end;
+    pekNil:Result:='NIL';
+    pekBoolConst:Result:='';
+    pekRange:Result:='..';
+    pekUnary:Result:='';
+    pekBinary:Result:='';
+    pekFuncParams:begin lbrak:='('; rbrak:=')'; Result:=','; end;
+    pekArrayParams:begin lbrak:='['; rbrak:=']'; Result:=','; end;
+    pekListOfExp:Result:=',';
+    pekInherited:Result:=' InheriteD';
+    pekSelf:Result:=' SelF';
+   end;
+  end;
+
+ function GetOp(lop:TExprOpCode):string;
+  begin
+   Result:='';
+   case lop of
+    eopNone:Result:='';
+    eopAdd:Result:='+';
+    eopSubtract:Result:='-';
+    eopMultiply:Result:='*';
+    eopDivide:Result:='/';
+    eopDiv:Result:=' div ';
+    eopMod:Result:=' mod ';
+    eopPower:Result:='^';
+    eopShr:Result:=' shr ';
+    eopSHl:Result:=' shl ';
+    eopNot:Result:=' not ';
+    eopAnd:Result:=' and ';
+    eopOr:Result:=' or ';
+    eopXor:Result:=' xor ';
+    eopEqual:Result:='=';
+    eopNotEqual:Result:='<>';
+    eopLessThan:Result:='<';
+    eopGreaterThan:Result:='>';
+    eopLessthanEqual:Result:='<=';
+    eopGreaterThanEqual:Result:='>=';
+    eopIn:Result:=' in ';
+    eopIs:Result:=' is ';
+    eopAs:Result:=' as ';
+    eopSymmetricaldifference:Result:='><';
+    eopAddress:Result:='@';
+    eopDeref:Result:='^';
+    eopSubIdent:Result:='.';
+   end;
+  end;
+
+ begin
+  if lex is TBinaryExpr then //compined constants
+   begin
+    sep:=GetExpKind(lex.Kind,lbk,rbk);
+    //write('|');
+    write(lbk);
+    GetTPasExpr(TBinaryExpr(lex).left);
+    write(GetOp(TBinaryExpr(lex).OpCode));
+    write(sep);
+    GetTPasExpr(TBinaryExpr(lex).right);
+    write(rbk);
+    //write('|');
+    //write(' [',lex.Name,' ',GetTPasExprKind(lex.Kind),']');
+   end
+    else
+     begin
+      //write('UNARY');
+      if lex is TUnaryExpr then
+       begin
+        lex1:=TUnaryExpr(lex).Operand;
+        if lex.OpCode = eopDeref then
+         begin
+          GetTPasExpr(lex1);
+          write(GetOp(lex.OpCode)); //unary last, only: p^
+         end
+        else
+         begin
+          write(GetOp(lex.OpCode)); //unary first: -1
+          GetTPasExpr(lex1);
+         end;
+       end;
+      if lex is TPrimitiveExpr then write(TPrimitiveExpr(lex).Value) //simple constant
+      else
+      if lex is TBoolConstExpr then write(TBoolConstExpr(lex).Value)
+      else
+      if lex is TNilExpr then write('nil')
+      else
+      if lex is TInheritedExpr then write('Inherited ')
+      else
+      if lex is TSelfExpr then write('Self')
+      else
+      if lex is TParamsExpr then //writeln(param1,param2,..,paramn);
+        begin
+         //write(' PAREX ');
+         lpe:=TParamsExpr(lex);
+         GetTPasExpr(lpe.Value);
+         if length(lpe.Params) >0 then
+          begin
+           sep:=GetExpKind(lpe.Kind,lbk,rbk);
+           write(lbk); //write('(');
+           for l:=0 to High(lpe.Params)-1 do
+            begin
+             GetTPasExpr(lpe.Params[l]);
+             write(sep); //seperator
+            end;
+           GetTPasExpr(lpe.Params[High(lpe.Params)]);
+           write(rbk);//write(')');
+          end
+         else
+          begin //funcion()
+           sep:=GetExpKind(lpe.Kind,lbk,rbk);
+           write(lbk,rbk);
+          end;
+        end
+      else if lex is TArrayValues then  //const AnArrayConst: Array[1..3] of Integer = (1,2,3);
+        begin
+         write('(');
+         lav:=TArrayValues(lex);
+         if length(lav.Values) > 0 then
+          begin
+           for l:=0 to high(lav.Values)-1 do
+            begin
+             GetTPasExpr(TPasExpr(lav.Values[l]));
+             write(',');
+            end;
+           GetTPasExpr(TPasExpr(lav.Values[high(lav.Values)]));
+          end;
+         write(')');
+        end
+      else if lex is TRecordValues then
+        begin
+         write('(');
+         lrv:=TRecordValues(lex);
+         if length(lrv.Fields) > 0 then
+          begin
+           for l:=0 to high(lrv.Fields)-1 do
+            begin
+             rvi:=TRecordValuesItem(lrv.Fields[l]);
+             write(rvi.Name,':');
+             GetTPasExpr(rvi.ValueExp);
+             write(';');
+            end;
+           rvi:=TRecordValuesItem(lrv.Fields[high(lrv.Fields)]);
+           write(rvi.Name,':');
+           GetTPasExpr(rvi.ValueExp);
+          end;
+         write(')');
+        end
+      else
+       begin
+        //?
+        //writeln('{ Unknown Expression: ');
+        //if assigned(lex) then GetTPasExprKind(lex.Kind);
+        //writeln('}');
+       end;
+     end;
+ end;
+
+
+//NoFirstIndent only for block in case:
+procedure GetTPasSmt(lsmt:TPasImplStatement; lindent:integer; DoNoSem,NoFirstIndent:boolean);
+ var l:integer;
+     lics:TPasImplCaseStatement;
+     DoSem:boolean;
+     liwd:TPasImplWithDo;
+     liwhd:TPasImplWhileDo;
+     lieo:TPasImplExceptOn;
+     lifl:TPasImplForLoop;
+     lir:TPasImplRaise;
+      s,s1:String;//s1 only first line of block statement
+
+begin
+  DoSem:=true;
+  s:=GetIndent(lindent);
+  if NoFirstIndent then s1:=' ' else s1:=s;
+  if lsmt is TPasImplSimple then
+    begin
+     write(s1); GetTPasExpr(TPasImplSimple(lsmt).expr);
+     //DoSem:=true;
+    end
+   else if lsmt is TPasImplAssign then
+    begin
+     write(s1); GetTPasExpr(TPasImplAssign(lsmt).left);
+     write(':= ');
+     GetTPasExpr(TPasImplAssign(lsmt).right);
+     //DoSem:=true;
+    end
+   else if lsmt is TPasImplCaseStatement then
+    begin
+     lics:=TPasImplCaseStatement(lsmt);
+     if lics.Expressions.Count>0 then
+      begin
+       write(s);
+       for l:=0 to lics.Expressions.Count-2 do
+          write(DelQuot(lics.Expressions[l]),',');
+       write(DelQuot(lics.Expressions[lics.Expressions.Count-1]),': '); // !!bug too much ' in expression
+       //if not assigned(lics.Body) then writeln('TPasImplCaseStatement missing BODY');
+       //if assigned(lics.Body) and (TPasImplBlock(lics.Body).Elements.Count >0) then
+       //  GetTPasImplBlock(TPasImplBlock(lics.Body),lindent+1,0,false,true)
+       //    else GetTPasImplBlock(TPasImplBlock(lics),lindent+1,0,false,true);  // !!bug missing body, assigned but empty
+        if assigned(lics.Body) then
+         begin
+          if not GetTPasImplElement(lics.Body,lindent+1,false,true) then ;//writeln(';');
+         end
+          else writeln(';');
+      end;
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplWithDo then
+    begin
+     liwd:=TPasImplWithDo(lsmt);   // !!Bug: missing with do at following with do !solved see Bug
+     write(s1,'with ',liwd.Name);
+     if liwd.Expressions.Count>0 then
+      begin
+       for l:=0 to liwd.Expressions.Count-2 do
+         write(liwd.Expressions[l],',');
+       write(liwd.Expressions[liwd.Expressions.Count-1]);
+      end;
+     writeln(' do');
+     //if TPasImplBlock(liwd.Body).Elements.Count >0  then
+       //GetTPasImplBlock(TPasImplBlock(liwd.Body),0); // !!Bug: BODY Not used
+       //else
+     GetTPasImplBlock(TPasImplBlock(liwd),lindent+1,0,false,false);
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplWhileDo then
+    begin
+     liwhd:=TPasImplWhileDo(lsmt);
+     writeln(s1,'while ',DelQuot(liwhd.Condition),' do');
+     //if not GetTPasImplBlock(TPasImplBlock(liwhd.Body),0) then // !!Bug: BODY Not used
+     GetTPasImplBlock(TPasImplBlock(liwhd),lindent,0,DoNoSem,false); //OK for all constructs
+     DoNoSem:=false; //?
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplExceptOn then
+    begin
+     lieo:=TPasImplExceptOn(lsmt);
+     writeln(s,'on ',lieo.VariableName,': ',lieo.TypeName,' do');
+     if TPasImplBlock(lieo.Body) is TPasImplRaise then
+      begin
+       write(s,'raise ');//raise is in TPasImplBlock in this case
+       GetTPasImplBlock(TPasImplBlock(lieo.Body),lindent+1,0,false,true);
+      end
+       else GetTPasImplBlock(TPasImplBlock(lieo.Body),lindent+1,0,false,false);
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplForLoop then
+    begin
+     lifl:=TPasImplForLoop(lsmt);
+     //TODO variable
+     write(s1,'for ',lifl.VariableName,':= ',lifl.StartValue,' ');
+     if lifl.Down then write('down');
+     writeln('to ',lifl.EndValue,' do');
+     GetTPasImplBlock(TPasImplBlock(lifl),lindent+1,0,false,false);
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplRaise then
+    begin
+     write(s1,'raise ');
+     lir:=TPasImplRaise(lsmt);
+     if not GetTPasImplBlock(TPasImplBlock(lir),lindent,0,DoNoSem,true) then
+      writeln(';');
+     DoNoSem:=false;
+     DoSem:=false;
+    end
+   else
+    begin
+     if assigned(lsmt.Elements) then
+      begin
+       writeln('{ Unknown SMT(s): '); //,lsmt.Name,' ',lsmt.ElementTypeName);
+       for l:=0 to lsmt.Elements.Count-1 do
+         write(s,' SMT ',l,' ',TPasElement(lsmt.Elements[l]).Name);
+       writeln('}');
+      end;
+     DoSem:=false;
+    end;
+  if not DoNoSem then
+   begin
+    if DoSem then writeln(';');
+   end
+    else writeln;
+end;
+
+
+ //result: result of TPasImplBlock or valid element
+ //NoFirstIndent only for block in case:
+ function GetTPasImplElement(le:TPasImplElement; lindent:integer;
+                             lLastNoSem,NoFirstIndent:boolean):boolean;
+  var liie:TPasImplIfElse;
+      lico:TPasImplCaseOf;
+      lice:TPasImplCaseElse;
+      liru:TPasImplRepeatUntil;
+      lit:TPasImplTry;
+      //lic:TPasImplCommand;
+      s,s1:String;//s1 only first line of block statement
+
 begin
-  if Paramcount<1 then
+  Result:=true;
+  s:=GetIndent(lindent);
+  if NoFirstIndent then s1:=' ' else s1:=s;
+    if le is TPasImplStatement then
+      begin
+       if NoFirstIndent then lindent:=0;
+       GetTPasSmt(TPasImplStatement(le),lindent+1,lLastNoSem,NoFirstIndent);
+      end
+     else if le is TPasImplIfElse then
+      begin
+       liie:=TPasImplIfElse(le);
+       write(s1,'if ',DelQuot(liie.Condition),' then ');
+       if assigned(liie.ElseBranch) then
+        begin
+         writeln;
+         GetTPasImplElement(liie.IfBranch,lindent+1,true,false);
+         writeln(s,'else');// {if}');
+         GetTPasImplElement(liie.ElseBranch,lindent+1,lLastNoSem,false);
+        end
+       else
+        begin //no else part
+         if assigned(liie.IfBranch) then
+          begin
+           writeln;
+           if not GetTPasImplElement(liie.IfBranch,lindent+1,false,false) then
+             writeln(';');
+          end
+           else writeln(';'); //empty if then;
+        end;
+      end
+     else if le is TPasImplCaseOf then
+      begin
+       lico:=TPasImplCaseOf(le);
+       writeln(s1,'case ',lico.Expression,' of ');
+       if assigned(lico.ElseBranch) then //workaround duplicate bug
+        begin                            //reduce count of CaseOf as CaseElse is in there
+         lice:=lico.ElseBranch;
+         GetTPasImplBlock(TPasImplBlock(lico),lindent+1,1,false,false);
+        end
+          else GetTPasImplBlock(TPasImplBlock(lico),lindent+1,0,false,false); // !! else duplicate in here
+       if assigned(lico.ElseBranch) then
+        begin
+         writeln(s,'else');//' {case}');
+         lice:=lico.ElseBranch;
+         GetTPasImplBlock(TPasImplBlock(lice),lindent+1,0,false,false);
+        end;
+       if lLastNoSem then writeln(s,'end')//' {case}')
+        else writeln(s,'end;');// {case}');
+       //Result:=false; ??? GetTPasImplBlock
+      end
+     else if le is TPasImplRepeatUntil then
+      begin
+        liru:=TPasImplRepeatUntil(le);
+        writeln(s1,'repeat');
+        GetTPasImplBlock(TPasImplBlock(liru),lindent+1,0,false,false);
+        write(s,'until ',DelQuot(liru.Condition));
+        if lLastNoSem then writeln
+         else writeln(';');
+      end
+     else if le is TPasImplTryFinally then
+      begin
+       writeln(s,'finally');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+      end
+     else if le is TPasImplTryExcept then
+      begin
+       writeln(s,'except');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+      end
+     else if le is TPasImplTryExceptElse then
+      begin
+       writeln(s,'else');// {try}');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+      end
+     else if le is TPasImplTry then
+      begin
+       lit:=TPasImplTry(le);
+       writeln(s1,'try');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+       if assigned(lit.FinallyExcept) then
+          GetTPasImplElement(TPasImplElement(lit.FinallyExcept),lindent+1,false,false);
+       if assigned(lit.ElseBranch) then
+          GetTPasImplElement(TPasImplElement(lit.ElseBranch),lindent+1,false,false);
+       if lLastNoSem then writeln(s,'end')// {try} ') //there is no ImplBeginBlock
+        else writeln(s,'end;');// {try} ');
+      end
+     else if le is TPasImplCommand then
+      begin
+       //ignore because empty
+       // lic:=TPasImplCommand(le);
+       // writeln(' CMD ',lic.Command,' ',lic.Name,' ',lic.ElementTypeName);
+      end
+     else if le is TPasImplLabelMark then
+      begin
+       writeln(s1,'label ',TPasImplLabelMark(le).LabelId,';');
+      end
+     else if le is TPasImplBlock then
+      begin
+       //IfElse, case:
+       Result:=GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,lLastNoSem,NoFirstIndent);
+      end
+     else
+      begin
+       Result:=false;
+       //writeln(s,';');
+       //writeln(' EL ',l);//,' ',le.Name)//,' ',le.ElementTypeName,' ',le.FullName);
+      end;
+ end;
+     
+// indent: indent from page left side
+// DecListBy: dec(elements.count) because of case duplicate else bug
+// LastNoSem: only true on last expr before else in a if clause
+// NoFirstIndent: if line was started by other block like in case at -> 1:Noindent;
+// Result: true if elements not empty
+function GetTPasImplBlock(lb:TPasImplBlock; indent,declistby:integer;
+                           LastNoSem,NoFirstIndent:boolean):boolean;
+   var l,n:integer;
+       lbe:TPasImplElement;
+       NoSem:boolean;
+       ls:String;     
+
+begin
+  Result:=false;
+  NoSem:=false;
+  ls:=GetIndent(indent);
+  if not assigned(lb) then exit;
+  //if lb is TPasImplRaise then writeln('RAISE');
+  if assigned(lb.Elements) then
+   begin
+    if lb is TPasImplBeginBlock then
+     begin
+      NoSem:=LastNoSem;
+      LastNoSem:=false;
+      if NoFirstIndent then
+       begin
+        writeln('begin');////NFI');
+        NoFirstIndent:=false;
+       end
+        else writeln(ls,'begin');
+      inc(indent);
+     end;
+
+    if lb.Elements.Count >0 then
+     begin
+      Result:=true;
+      n:=lb.Elements.Count-1;
+      //workaround CaseOf duplicate bug
+      if (declistby >0)and(lb.Elements.Count >declistby) then dec(n,declistby);
+      for l:=0 to n do
+       begin
+        lbe:=TPasImplElement(lb.Elements[l]);
+        //write(l:2,'/',n:2,' '); //No of curent element, max element
+        if ((l = 0)and NoFirstIndent) then
+         begin //index0
+          if l=n then GetTPasImplElement(lbe,0,LastNoSem,false)
+           else GetTPasImplElement(lbe,0,false,false)
+         end
+        else if l<>n then GetTPasImplElement(lbe,indent,false,false) //other index
+        else GetTPasImplElement(lbe,indent,LastNoSem,false); //indexn
+       end;
+     end
+    else
+     begin //block is empty
+      //write(ls,' {!EMPTY!}');
+       {if not NoSem then
+        begin
+         if lb is TPasImplBeginBlock then writeln //empty compound need no ;
+          else writeln(';')
+        end
+         else
+          writeln;}
+     end;
+    if lb is TPasImplBeginBlock then
+      if not NoSem then writeln(ls,'end;')// {Block}') 
+        else writeln(ls,'end');// {Block}');
+   end
+    else
+      writeln(';'); //writeln(' {!empty!};')
+end;
+
+
+//# Declarations (type,var,const,..)
+
+procedure GetTPasArrayType(lpat:TPasArrayType);
+ begin
+  if lpat.IsPacked then write('packed ');
+  write('Array');
+  if lpat.IndexRange <> '' then write('[',lpat.IndexRange,']');
+  if assigned(lpat.ElType) then write(' of ',lpat.ElType.Name);
+   // BUG: of const missing in Procedure ConstArrayArgProc(A: Array of const); pparser: 643
+ end;
+
+//write out one variable or constant declaration, also used in types
+//In spite of the use of GetPasVariables this is still used !
+procedure GetTPasVar(lpv:TPasVariable; lindent:integer; NoLF:boolean);//BUG string[] pparser: 482
+   var i,j:integer;
+       //lppt:TPasProcedureType;
+       //lpa:TPasArgument;
+       //lpat:TPasArrayType;
+       s,s1:string;
+       prct:TPasRecordType;
+
+  begin
+   if not Assigned(lpv) then exit;
+   s:=GetIndent(lindent);
+   write(s,lpv.Name);//,'  ',lpv.value,' ',lpv.Modifiers,' ',lpv.AbsoluteLocation);
+   if assigned(lpv.VarType) then
+     begin
+       //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
+       //,TPasType(lpa.ArgType).Name,' ');//,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
+       // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
+       //     else write(':? ');
+       write(': ');
+       if lpv.VarType is TPasArrayType then
+        begin
+         GetTPasArrayType(TPasArrayType(lpv.VarType));
+        end
+       else if lpv.VarType is TPasSetType then
+        begin
+         write('set of ',TPasSetType(lpv.VarType).EnumType.Name);
+        end
+       else
+        begin
+          if lpv.VarType is TPasPointerType then
+                write('^',TPasPointerType(lpv.VarType).DestType.Name)
+          else if lpv.VarType is TPasRecordType then //var record
+           begin
+            j:=lindent+Length(lpv.Name)+4;
+            s1:=GetIndent(j);
+            prct:=TPasRecordType(lpv.VarType);
+            if prct.IsBitPacked then write('bitpacked ');
+            if prct.IsPacked then write('packed ');
+            writeln('Record');
+            for i:=0 to prct.Members.Count-1 do
+             begin
+              GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+             end;
+            write(s1,'end');
+           end
+          else
+           begin
+            write(TPasType(lpv.VarType).Name);
+            //if TPasType(lpv.VarType) is TPasAliasType then write(TPasAliasType(lpv.VarType).Name);
+           end;
+        end;
+     end;
+   if lpv.Value <> '' then write('=',lpv.Value);
+   if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
+     begin
+      write('=');
+      GetTPasExpr(lpv.Expr);
+     end;
+     
+   if lpv.Modifiers <>'' then //Modifiers starts with ;
+    begin
+     write(' ',lpv.Modifiers,';');
+     if GetTPasMemberHints(lpv.Hints) then write(';');
+    end
+   else
     begin
-     // remember to put the whole cmdline in quotes, and
-     // to always add some path options. Even if only -Fu. -Fi.
-      writeln('usage: test_parser <commandline>');
-      halt;
+     GetTPasMemberHints(lpv.Hints);
+     write(';');
     end;
-  cmdl:=paramstr(1);
-  if paramcount>1 then
-    for i:=2 to paramcount do
-      cmdl:=cmdl+' '+paramstr(i);
+   if not NoLF then writeln;
+  end;
+  
+//write out a list of variables only
+//more compact than the output of seperate calls of GetTPasVar
+procedure GetPasVariables(vl:TList; lindent:integer; NoLF,NoSEM:boolean);
+   var v,i,j:integer;
+       s,s1:string;
+       prct:TPasRecordType;
+       lpv:TPasVariable;
+       
+       same:boolean;
+       samestr,tmpstr:Ansistring;
+       samevar:array of integer;
+       svi:integer;
+
+  begin
+   if vl.Count <= 0 then exit; 
+   s:=GetIndent(lindent);
+   //> compare all variable types as string to find the ones with same type
+   samestr:='';
+   svi:=0;
+   SetLength(samevar,vl.count);
+   for v:=0 to vl.count-1 do
+    begin
+     tmpstr:=''; 
+     same:=true;   
+     lpv:=TPasVariable(vl[v]);
+     //write(s,lpv.Name);
+     if assigned(lpv.VarType) then
+      begin
+       tmpstr:=tmpstr+': ';
+       if lpv.VarType is TPasArrayType then
+         begin
+          //GetTPasArrayType(TPasArrayType(lpv.VarType));
+          tmpstr:=tmpstr+'array'+TPasArrayType(lpv.VarType).IndexRange;
+          if assigned(TPasArrayType(lpv.VarType).ElType) then
+           tmpstr:=tmpstr+TPasArrayType(lpv.VarType).ElType.Name;
+         end
+       else if lpv.VarType is TPasSetType then
+         begin
+          tmpstr:=tmpstr+'set of '+TPasSetType(lpv.VarType).EnumType.Name;
+         end
+       else
+        begin
+         if lpv.VarType is TPasPointerType then
+            tmpstr:=tmpstr+'^'+TPasPointerType(lpv.VarType).DestType.Name
+         else if lpv.VarType is TPasRecordType then //var record
+           begin
+            prct:=TPasRecordType(lpv.VarType);
+            if prct.IsBitPacked then tmpstr:=tmpstr+'bitpacked ';
+            if prct.IsPacked then tmpstr:=tmpstr+'packed ';
+            tmpstr:=tmpstr+'Record ';
+            for i:=0 to prct.Members.Count-1 do
+             begin
+              //todo
+              //GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+             end;
+            tmpstr:=tmpstr+'end';
+           end
+         else
+          begin
+            tmpstr:=tmpstr+TPasType(lpv.VarType).Name;
+          end;
+        end;
+      end
+        else same:=false;
+     if lpv.Value <> '' then same:=false;//=
+     if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
+      begin
+       same:=false;//=
+      end;
+     if lpv.Modifiers <>'' then //Modifiers starts with ;
+      begin
+       tmpstr:=tmpstr+' '+lpv.Modifiers+';';
+       tmpstr:=tmpstr+ReturnTPasMemberHints(lpv.Hints);
+      end
+     else
+      begin
+       tmpstr:=tmpstr+ReturnTPasMemberHints(lpv.Hints);
+      end;
+  //if v = 0 then begin samestr:=tmpstr; end;
+     if (not same)or(samestr <> tmpstr) then
+       begin
+        samestr:=tmpstr;
+        inc(svi);
+       end;
+     samevar[v]:=svi;
+   end;
+   //compare <
+   //now print them
+   svi:=-1; 
+   for v:=0 to vl.count-1 do
+    begin
+     lpv:=TPasVariable(vl[v]);
+     if not Assigned(lpv) then continue;
+     if svi <> samevar[v] then
+       begin
+        svi:=samevar[v];
+        if v>0 then writeln;
+        write(s,lpv.Name);//variblenname
+       end
+        else write(lpv.Name);
+     if (v < vl.Count-1)and(samevar[v+1]=svi) then write(',')
+      else
+       begin
+        if assigned(lpv.VarType) then
+         begin
+           write(': ');
+           if lpv.VarType is TPasArrayType then
+            begin
+             GetTPasArrayType(TPasArrayType(lpv.VarType));
+            end
+           else if lpv.VarType is TPasSetType then
+            begin
+             write('set of ',TPasSetType(lpv.VarType).EnumType.Name);
+            end
+           else
+            begin
+             if lpv.VarType is TPasPointerType then
+                write('^',TPasPointerType(lpv.VarType).DestType.Name)
+             else if lpv.VarType is TPasRecordType then //var record
+              begin
+               j:=lindent+Length(lpv.Name)+4;
+               s1:=GetIndent(j);
+               prct:=TPasRecordType(lpv.VarType);
+               if prct.IsBitPacked then write('bitpacked ');
+               if prct.IsPacked then write('packed ');
+               writeln('Record');
+               {for i:=0 to prct.Members.Count-1 do
+                 begin
+                  GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+                 end;}
+               if prct.Members.Count > 0 then
+                 GetPasVariables(prct.Members,j+1,false,false);
+               write(s1,'end');
+              end
+             else
+              begin
+               write(TPasType(lpv.VarType).Name);
+              end;
+            end;
+         end;
+        if lpv.Value <> '' then write('=',lpv.Value);
+        if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
+         begin
+          write('=');
+          GetTPasExpr(lpv.Expr);
+         end;
+
+        if lpv.Modifiers <>'' then //Modifiers starts with ;
+         begin
+          write(' ',lpv.Modifiers,';');
+          if GetTPasMemberHints(lpv.Hints) then write(';');
+         end
+        else
+         begin
+          GetTPasMemberHints(lpv.Hints);
+          if (v < vl.Count-1) then write(';')
+            else if (not NoSEM) then write(';');
+         end;
+	   //if not NoLF then writeln;
+       end;
+     end;
+    if not NoLF then writeln;
+  end;  
+  
+
+procedure GetTypes(pe:TPasElement; lindent:integer);
+  var i,j,k:integer;
+      s,s1,s2:string;
+      pet:TPasEnumType;
+      pev:TPasEnumValue;
+
+      prt:TPasRangeType;
+      prct:TPasRecordType;
+      pv:TPasVariant;
+      pst:TPasSetType;
+
+
+  function GetVariantRecord(pe:TPasElement; lindent:integer):boolean;
+    var i,j,k:integer;
+        prct:TPasRecordType;
+        pv:TPasVariant;
+        s,s1:string;
+
+   begin
+    Result:=false;
+    j:=lindent+Length(pe.Name)+2;
+    s:=GetIndent(lindent);
+    s1:=GetIndent(lindent+2);
+    prct:=TPasRecordType(pe);
+    {Now i use GetPasVariables for more compact output
+     for i:=0 to prct.Members.Count-1 do
+     begin
+      GetTPasVar(TPasVariable(prct.Members[i]),1,true);
+     end;}
+    if prct.Members.Count > 0 then GetPasVariables(prct.Members,1,true,true);  
+    if assigned(prct.Variants) then
+     begin
+      Result:=true;
+      writeln(';');
+      write(s,'case ');
+      if prct.VariantName <>'' then write(prct.VariantName,'=');
+      write(TPasType(prct.VariantType).Name);
+      writeln(' of');
+      if assigned(prct.Variants)then
+       if prct.Variants.Count >0 then
+        begin
+         for i:=0 to prct.Variants.Count-1 do
+          begin
+           pv:=TPasVariant(prct.Variants[i]);
+           write(s1,pv.Name);
+           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
+           write(': (');
+           if GetVariantRecord(TPasElement(pv.Members),j+1) then
+             writeln(s1,');')
+              else writeln(');');
+          end;
+        end;
+     end;
+   end;
+
+ begin
+  s:=GetIndent(lindent);
+  write(s,pe.Name,'=');
+  if pe is TPasArrayType then
+   begin
+     GetTPasArrayType(TPasArrayType(pe));
+     writeln(';');
+   end
+  else if pe is TPasEnumType then
+   begin
+    pet:=TPasEnumType(pe);
+    write('(');
+    if pet.Values.Count > 0 then
+     begin
+      for j:=0 to pet.Values.Count-2 do
+       begin
+        pev:=TPasEnumValue(pet.Values[j]);
+        write(pev.name,',');
+        //pev.Value ?
+        //pev.AssignedValue ?
+        //pev.IsValueUsed ?
+       end;
+      pev:=TPasEnumValue(pet.Values[pet.Values.Count-1]);
+      write(pev.name);
+     end;
+    writeln(');');
+   end
+  else if pe is TPasFileType then
+   begin
+    writeln('file of ',TPasFileType(pe).ElType.Name,';');
+   end
+  else if pe is TPasProcedureType then
+   begin
+    writeln('procedure');
+   end
+  else if pe is TPasPointerType then
+   begin
+    //writeln('pointer');
+    writeln('^',TPasPointerType(pe).DestType.Name,';');
+   end
+  else if pe is TPasRangeType then
+   begin
+    prt:=TPasRangeType(pe);
+    writeln(prt.RangeStart,'..',prt.RangeEnd,';');
+   end
+  else if pe is TPasRecordType then
+   begin
+    j:=lindent+Length(pe.Name)+2;
+    s1:=GetIndent(j);
+    s2:=GetIndent(j+1);
+    prct:=TPasRecordType(pe);
+    if prct.IsBitPacked then write('bitpacket ');
+    if prct.IsPacked then write('packet');
+    writeln('record');
+    {Now i use GetPasVariables for more compact output
+     for i:=0 to prct.Members.Count-1 do
+     begin
+      GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+     end;}
+    GetPasVariables(prct.Members,j+2,false,false);
+    if assigned(prct.Variants) then
+     begin
+      write(s1,'case ');
+      if prct.VariantName <>'' then write(prct.VariantName,'=');
+        write(TPasType(prct.VariantType).Name);
+      writeln(' of');
+      if assigned(prct.Variants)then
+       if prct.Variants.Count >0 then
+        begin
+         for i:=0 to prct.Variants.Count-1 do
+          begin
+           pv:=TPasVariant(prct.Variants[i]);
+           write(s2,pv.Name);
+           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
+           write(': (');
+           if GetVariantRecord(TPasElement(pv.Members),j+2) then
+             writeln(s2,');')
+              else writeln(');');
+          end;
+        end;
+     end;
+    writeln(s1,'end;');
+   end
+  else if pe is TPasSetType then
+   begin
+    pst:=TPasSetType(pe);
+    writeln('set of ',pst.EnumType.Name,';');
+   end
+  else if pe is TPasClassOfType then writeln('Class of ',TPasClassOfType(pe).DestType.Name,';')
+  else
+   begin
+    
+    writeln('{ Unknown TYPE(s): ');
+    writeln(s,pe.Name);
+    writeln('}');
+    writeln;
+   end;
+ end;
+
+
+ function GetTPasArgumentAccess(acc:TArgumentAccess):String;
+  begin
+   Result:='';
+   case acc of
+     //argDefault:Result:='default'; //normal proccall is default
+     argConst:Result:='const';
+     argVar:Result:='var';
+     argOut:Result:='out';
+   end;
+  end;
+
+ procedure GetTCallingConvention(cc:TCallingConvention);  //TODO: test it
+  begin
+   case cc of
+     //ccDefault:write(' default;'); //normal proccall is default
+     ccRegister:WriteFmt(true,'Register;',false);
+     ccPascal  :WriteFmt(true,'Pascal;',false);
+     ccCDecl   :WriteFmt(true,'CDecl;',false);
+     ccStdCall :WriteFmt(true,'StdCall;',false);
+     ccOldFPCCall:WriteFmt(true,'OldFPCall;',false);
+     ccSafeCall:WriteFmt(true,'SaveCall;',false);
+   end;
+  end;
+  
+ procedure GetHiddenModifiers(Mfs:TProcedureModifiers);
+  begin
+   if pmInline in Mfs then WriteFmt(true,'inline;',false);
+   if pmAssembler in Mfs then WriteFmt(true,'assembler;',false);
+   if pmVarargs in Mfs then WriteFmt(true,'varargs;',false);
+   if pmCompilerProc in Mfs then WriteFmt(true,'compilerproc;',false);
+   if pmExtdecl in Mfs then WriteFmt(true,'extdecl;',false);
+  end; 
+
+  procedure GetTPasProcedure(lpp:TPasProcedure; indent:integer);
+   var l:integer;
+       lppt:TPasProcedureType;
+       lpa:TPasArgument;
+       s:String;
+       
+       same:boolean;
+       samevar:array of integer;//same index same type
+       aktaa:TArgumentAccess;
+       aktname,tmpname:String;
+       svi:integer;
+
+  begin
+   if not Assigned(lpp) then exit;
+   s:=GetIndent(indent);
+   if lpp is TPasConstructor then write(s,'Constructor ')
+    else if TPasElement(lpp) is TPasConstructorImpl then write(s,'Constructor ')
+    else if lpp is TPasDestructor then write(s,'Destructor ')
+    else if TPasElement(lpp) is TPasDestructorImpl then write(s,'Destructor ')
+    else if lpp is TPasClassProcedure then write(s,'Class Procedure ') //pparser.pp: 3221
+    else if lpp is TPasClassFunction then write(s,'Class Function ')
+    else if lpp is TPasFunction then write(s,'Function ')
+      else write(s,'Procedure ');
+   write(lpp.Name);//,' ',lpp.TypeName);
+   if assigned(lpp.ProcType) then
+    begin
+     lppt:=lpp.ProcType;
+     if assigned(lppt.Args) and (lppt.Args.Count > 0) then
+      begin
+       write('(');
+       if lppt.Args.Count > 0 then 
+        begin
+         //produce more compact output than the commented block below
+         //>find same declaration
+         //look ahead what is the same
+         SetLength(samevar,lppt.Args.Count);
+         svi:=0;
+         aktname:='';
+         for l:=0 to lppt.Args.Count-1 do
+          begin
+           same:=true;
+           tmpname:='';
+           lpa:=TPasArgument(lppt.Args.Items[l]);
+           if assigned(lpa.ArgType) then
+            begin
+             if lpa.ArgType is TPasArrayType then
+              begin
+                if assigned(TPasArrayType(lpa.ArgType).ElType) then tmpname:=TPasArrayType(lpa.ArgType).ElType.Name;
+              end
+               else tmpname:=TPasType(lpa.ArgType).Name;
+            end;
+           if l=0 then begin aktaa:=lpa.Access; aktname:=tmpname; end;   
+           if lpa.Access <> aktaa then begin same:=false; aktaa:=lpa.Access; end;//access type 
+           if (tmpname = '')or(tmpname <> aktname) then begin same:=false; aktname:=tmpname; end;//type name
+           if lpa.Value <> '' then same:=false;//var=value
+           if not same then inc(svi); 
+           samevar[l]:=svi;
+          end; 
+        //find same declaration<  
+        svi:=-1;
+        same:=false;
+        for l:=0 to lppt.Args.Count-1 do
+         begin
+          lpa:=TPasArgument(lppt.Args.Items[l]);
+          if svi <> samevar[l] then
+           begin
+            svi:=samevar[l];
+            if lpa.Access <> argDefault then write(GetTPasArgumentAccess(lpa.Access),' '); 
+            write(lpa.Name);//variblenname
+           end
+             else write(lpa.Name); 
+          if (l < lppt.Args.Count-1)and(samevar[l+1]=svi) then write(',')
+           else
+            begin
+             if assigned(lpa.ArgType) then
+              begin
+               write(': ');
+               if lpa.ArgType is TPasArrayType then
+                GetTPasArrayType(TPasArrayType(lpa.ArgType))
+                 else write(TPasType(lpa.ArgType).Name);
+              end;
+             if lpa.Value <> '' then write('=',lpa.Value);
+             if l< lppt.Args.Count-1 then write('; ');
+           end;    
+         end; 
+       {//simple version duplicates declarations of same type
+        for l:=0 to lppt.Args.Count-1 do
+        begin
+         lpa:=TPasArgument(lppt.Args.Items[l]);
+          if lpa.Access <> argDefault then write(GetTPasArgumentAccess(lpa.Access),' '); 
+         write(lpa.Name);//variblenname
+         if assigned(lpa.ArgType) then
+          begin
+           //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
+           //,TPasType(lpa.ArgType).Name,' ');
+           //,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
+           // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
+           //     else write(':? ');
+           write(': ');
+           if lpa.ArgType is TPasArrayType then
+            begin
+             GetTPasArrayType(TPasArrayType(lpa.ArgType));
+            end
+             else  write(TPasType(lpa.ArgType).Name);
+          end;
+         if lpa.Value <> '' then write('=',lpa.Value);
+         if l< lppt.Args.Count-1 then write('; ');
+        end;}
+        end;
+       write(')');
+      end;
+     if lppt.IsOfObject then write(' of Object'); 
+     if (TPasElement(lpp) is TPasFunction)or(TPasElement(lpp) is TPasClassFunction) then 
+         write(': ',TPasFunctionType(lpp.ProcType).ResultEl.ResultType.Name);
+    end;
+   //writeln(';');
+   WriteFmt(false,'',true);
+   if lpp.IsVirtual then WriteFmt(true,'virtual;',false);
+   if lpp.IsOverload then WriteFmt(true,'overload;',false);
+   if lpp.IsAbstract then WriteFmt(true,'abstract;',false);
+   if lpp.IsDynamic then WriteFmt(true,'dynamic;',false);
+   if lpp.IsOverride then WriteFmt(true,'override;',false);
+   if lpp.IsExported then WriteFmt(true,'exported;',false);
+   if lpp.IsExternal then WriteFmt(true,'external;',false);
+   //pparser 2360: everyting behind external is ignored !!!
+   if lpp.IsMessage then
+    begin
+      write('message ');
+      if lpp.MessageType = pmtString then writeln(false,lpp.MessageName,true)
+       else WriteFmt(false,lpp.MessageName,true);//pmtInteger
+    end;
+   if lpp.IsReintroduced then WriteFmt(true,'reintroduce;',false);
+   if lpp.IsStatic then WriteFmt(true,'static;',false);
+   if lpp.IsForward then WriteFmt(true,'forward;',false);
+   GetHiddenModifiers(lpp.Modifiers);
+   GetTCallingConvention(lpp.CallingConvention);
+   if GetTPasMemberHints(TPasElement(lpp).Hints) then WriteFmt(false,'',true); //BUG ? missing hints
+   if not Unformated then writeln;
+  end;
+
+ procedure GetTPasProcedureBody(pb:TProcedureBody; indent:integer);
+   var j:integer;
+       pd:TPasDeclarations;
+       pib:TPasImplBlock;
+  begin
+   if assigned(pb) then
+    begin
+     if assigned(pb.Body)then
+      begin
+       if assigned(TPasDeclarations(pb).Functions)then
+        begin
+         pd:=TPasDeclarations(pb);
+         if isim then
+          begin
+           //writeln;
+           GetDecls(pd,indent+1);     //~recursion
+           //PrintDecls(pd,indent+1); //~recursion
+          end
+         else
+          if pd.Functions.Count >0 then //sub-functions
+           begin
+            for j:=0 to pd.Functions.Count-1 do
+              GetTPasProcedure(TPasProcedure(pd.Functions[j]),indent+1);
+           end;
+        end;
+       pib:=TPasImplBlock(pb.Body);
+       if assigned(pib) then
+        begin
+          GetTPasImplBlock(pib,indent,0,false,false); //indent depend on sub function level
+          if not Unformated then writeln; //('//block');
+        end;
+      end;
+    end;
+  end;
+
+ procedure GetTpasOverloadedProc(pop:TPasOverloadedProc; indent:integer);
+   var pp:TPasProcedure;
+       j:integer;
+  begin
+   if assigned(pop) then
+    begin
+     if pop.Overloads.Count >0 then
+      begin
+       for j:=0  to pop.Overloads.Count-1 do
+        begin
+         pp:=TPasProcedure(pop.Overloads[j]);
+         GetTPasProcedure(pp,indent);
+         GetTPasProcedureBody(pp.Body,indent);
+        end;
+      end;
+    end;
+  end;
+
+ function GetVisibility(v:TPasMemberVisibility):String;
+  begin
+   Result:='';
+   case v of
+    //visDefault:Result:='default';
+    visPrivate:Result:='private';
+    visProtected:Result:='protected';
+    visPublic:Result:='public';
+    visPublished:Result:='published';
+    visAutomated:Result:='automated';
+    visStrictPrivate:Result:='strictprivate';
+    visStrictProtected:Result:='strictprotected';
+   end;
+  end;
+
+ procedure GetTPasClass(pc:TPasClassType; indent:integer);
+   var j,l:integer;
+       s,s1,s2:String;
+       lpe:TPasElement;
+       lpp:TPasProperty;
+       lpa:TPasArgument;
+       vis:TPasMemberVisibility;
+       vars:TList;
+       IsVar:boolean;
+
+  procedure PrintVars;
+   begin
+    if vars.Count > 0 then GetPasVariables(vars,indent+1,false,false);
+    IsVar:=False;
+    vars.Clear;
+   end;
+
+  begin
+   if assigned(pc) then
+    begin
+     s:=GetIndent(indent);
+     write(s,pc.Name,'=');
+     if pc.IsPacked then write('packed ');
+     case pc.ObjKind of
+      okObject:write('Object');
+      okClass:write('Class');
+      okInterface:write('Interface');
+     end;
+     if assigned(pc.AncestorType) and (pc.AncestorType.ElementTypeName <> '') then
+        write('(',pc.AncestorType.Name,')');
+
+     if pc.IsForward or pc.IsShortDefinition then //pparser.pp: 3417 :class(anchestor); is allowed !
+      begin
+       writeln(';');
+       exit;
+      end;  
+    //Members: TList;
+    //InterfaceGUID: String;
+    //ClassVars: TList; //is this always empty ?
+    //Modifiers: TStringList;
+    //Interfaces: TList;
+      s1:=GetIndent(indent+1);
+      s2:=GetIndent(indent+2);
+      if pc.Members.Count > 0 then
+       begin
+        writeln;
+        vars:=TList.Create;
+        IsVar:=false;
+        for j:=0 to pc.Members.Count-1 do
+         begin
+           lpe:=TPasElement(pc.Members[j]);
+
+           //Class visibility, written on change
+           if j=0 then
+            begin
+             vis:=lpe.Visibility;
+             if GetVisibility(vis) <> '' then writeln(s1,GetVisibility(vis));
+            end
+           else
+            if vis <> lpe.Visibility then
+             begin
+              if IsVar then PrintVars;
+              if lpe.Visibility <> visDefault then //Class Function = visDefault
+               begin
+                vis:=lpe.Visibility;
+                if GetVisibility(vis) <> '' then writeln(s1,GetVisibility(vis));
+               end;
+             end;
+
+           if lpe is TPasOverloadedProc then
+            begin
+             if IsVar then PrintVars;
+             GetTPasOverloadedProc(TPasOverloadedProc(lpe),indent+2);
+            end
+           else if lpe is TPasProcedure then //TPasClassProcedure and
+            begin         //TPasClassFunction are both child of TPasProcedure
+             if IsVar then PrintVars;
+             GetTPasProcedure(TPasProcedure(lpe),indent+2);
+            end
+           else if lpe is TPasProperty then
+            begin
+             if IsVar then PrintVars;
+             lpp:=TPasProperty(lpe);
+             write(s2,'property ',lpp.Name);
+             if lpp.Args.Count >0 then
+              begin
+               for l:=0 to lpp.Args.Count-1 do
+                begin
+                 lpa:=TPasArgument(lpp.Args.Items[l]);
+                 if GetTPasArgumentAccess(lpa.Access) <> '' then
+                   write('[',GetTPasArgumentAccess(lpa.Access),' ',lpa.Name)
+                    else write('[',lpa.Name); //variblename
+                 if assigned(lpa.ArgType) then
+                  begin
+                   //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
+                   //,TPasType(lpa.ArgType).Name,' ');
+                   //,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
+                   // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
+                   //     else write(':? ');
+                   write(': ');
+                   if lpa.ArgType is TPasArrayType then
+                    begin
+                     GetTPasArrayType(TPasArrayType(lpa.ArgType));
+                    end
+                     else  write(TPasType(lpa.ArgType).Name);
+                  end;
+                 if lpa.Value <> '' then write('=',lpa.Value);
+                 write(']');
+                end;
+              end;//args
+             if assigned(lpp.VarType) then
+              begin
+               write(': ',TPasType(lpp.VarType).Name);
+              end;
+             if lpp.IndexValue <> '' then write(' Index ',lpp.IndexValue);
+             if lpp.ReadAccessorName <> '' then write(' Read ',lpp.ReadAccessorName);
+             if lpp.WriteAccessorName <> '' then write(' Write ',lpp.WriteAccessorName);
+             if lpp.ImplementsName <> '' then write(' Implements ',lpp.ImplementsName);
+             if lpp.IsDefault then write(' Default ',lpp.DefaultValue);
+             if lpp.IsNodefault then write(' NoDefault');
+             if lpp.StoredAccessorName <> '' then write(' Stored ',lpp.StoredAccessorName);
+             GetTPasMemberHints(lpp.Hints);
+             writeln(';');
+            end
+           else if lpe is TPasVariable then
+            begin
+             //this is done with printvars
+             //GetTPasVar(TPasVariable(lpe),indent+1,false);
+             IsVar:=true;
+             vars.add(lpe);
+            end
+           else
+            begin
+             if IsVar then PrintVars;
+             writeln('{ Unknown Declaration(s) in Class/Object/Interface: ');
+             writeln(s,lpe.Name);
+             writeln('}');
+            end;
+         end;
+        //writeln(s,'end;');//'//class');
+         if IsVar then PrintVars;
+         vars.free;
+       end
+        else  writeln;//(';'); //x=class(y);
+     writeln(s,'end;');
+    end;
+  end;
+
+
+procedure GetDecls(Decl:TPasDeclarations; indent:integer);
+ var i,j:integer;
+     pe:TPasElement;
+     pp:TPasProcedure;
+     ps:TPasSection;
+     s:string;
+     x:(None,ResStrings,Types,Consts,Classes,Functions,Variables,Properties);
+     l:TList;
+
+  procedure PrintVars;
+   begin
+    if l.Count > 0 then GetPasVariables(l,indent+1,false,false);
+   end;
+
+begin
+ s:=GetIndent(indent);
+ x:=None;
+ if assigned(Decl)then
+  begin
+   l:=TList.Create;
+   pe:=TPasElement(Decl);
+   if pe is TPasSection then
+    begin
+     {(Decl is TInterfaceSection)or(Decl is TImplementationSection) or
+     (Decl is TProgramSection}
+     ps:=TPasSection(pe);
+     if ps.UsesList.Count >0 then
+      begin
+       write(s,'uses ');
+       ps:=TPasSection(Decl);
+       if not Unformated then begin writeln; write(s,'  '); end;
+       for i:=0 to ps.UsesList.Count-2 do
+        if UpCase(TPasElement(ps.UsesList[i]).Name) = 'SYSTEM' then continue //do not print system
+         else write(TPasElement(ps.UsesList[i]).Name,',');                   //as it is added by parser
+       writeln(TPasElement(ps.UsesList[ps.UsesList.Count-1]).Name,';');
+       if not Unformated then writeln;
+      end;
+    end;
+   if assigned(Decl.Declarations)and(Decl.Declarations.Count > 0) then
+   for j:=0 to Decl.Declarations.Count-1 do
+    begin
+     pe:=TPasElement(Decl.Declarations[j]);
+     if pe is TPasResString then
+       begin
+        if x = Variables then PrintVars;
+        if x <> ResStrings then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'ResourceString');
+          x:=ResStrings;
+         end;
+        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Value),';'); //too much '''
+       end
+     else if pe is TPasConst then
+       begin
+        if x = Variables then PrintVars;
+        if x <> Consts then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'const');
+          x:=Consts;
+         end;
+        GetTPasVar(TPasVariable(pe),indent+1,false);
+       end
+     else if pe is TPasVariable then
+       begin
+        if x <> Variables then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'var');
+          x:=Variables;
+          l.Clear;
+         end;
+        l.Add(pe);
+        //this is done with printvars
+        //GetTPasVar(TPasVariable(pe),indent+1,false);
+       end
+     else if pe is TPasClassType then
+       begin
+        if x = Variables then PrintVars;
+        if x <> Types then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'Type');
+          x:=Types;
+         end;
+        GetTPasClass(TPasClassType(pe),indent+1);
+       end
+     else if pe is TPasType then
+       begin
+        if x = Variables then PrintVars;
+        if x <> Types then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'Type');
+          x:=Types;
+         end;
+        GetTypes(TPasElement(pe),indent+1);
+       end
+     else if pe is TPasProcedureBase then
+       begin
+        if x = Variables then PrintVars;
+        if (x <> Functions)and not Unformated then writeln;
+        x:=Functions;
+        if pe is TPasOverloadedProc then
+          begin
+           GetTpasOverloadedProc(TPasOverloadedProc(pe),indent);
+          end
+         else
+          begin
+           pp:=TPasProcedure(pe);
+           GetTPasProcedure(pp,indent);
+           GetTPasProcedureBody(pp.Body,indent);
+          end;
+       end
+      else
+       begin
+        if x = Variables then PrintVars;
+        x:=None;
+        writeln('{ Unknown Declaration: ',pe.Name,' }');
+       end;
+    end;
+   if x = Variables then PrintVars;
+   l.Free;
+  end;
+end;
+
+{replaced by GetDecls
+ this does the same but not in true order
+
+procedure PrintDecls(Decl:TPasDeclarations; indent:integer);
+ var i:integer;
+     pe:TPasElement;
+     pp:TPasProcedure;
+     ps:TPasSection;
+     s:string;
+     istype:boolean;
+
+begin
+ istype:=false;
+ s:=GetIndent(indent);
+ if (Decl is TInterfaceSection)or(Decl is TImplementationSection) or
+     (Decl is TProgramSection) then
+  if TPasSection(Decl).UsesList.Count >0 then
+    begin
+     write(s,'uses ');
+     ps:=TPasSection(Decl);
+     if not Unformated then begin writeln; write(s,'  '); end;
+     for i:=0 to ps.UsesList.Count-2 do
+      if UpCase(TPasElement(ps.UsesList[i]).Name) = 'SYSTEM' then continue //do not print system
+       else write(TPasElement(ps.UsesList[i]).Name,',');                   //as it is added by parser
+     writeln(TPasElement(ps.UsesList[ps.UsesList.Count-1]).Name,';');
+     if not Unformated then writeln;
+    end;
+
+  if assigned(Decl.ResStrings) then
+    if Decl.ResStrings.Count >0 then
+     begin
+      writeln('ResourceString');
+      for i := 0 to Decl.ResStrings.Count - 1 do
+       begin
+        pe:=TPasElement(Decl.ResStrings[i]);
+        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Value),';'); //too much '''
+       end;
+      if not Unformated then writeln;
+     end;
+
+  if assigned(Decl.Consts)then
+    if Decl.Consts.Count >0 then
+     begin
+      writeln(s,'const');
+      for i:=0 to Decl.Consts.Count-1 do GetTPasVar(TPasVariable(Decl.Consts[i]),indent+1,false);
+      if not Unformated then writeln;
+     end;
+
+  if assigned(Decl.Types) then
+    if Decl.Types.Count >0 then
+     begin
+      writeln(s,'Type');
+      for i := 0 to Decl.Types.Count - 1 do
+       begin
+        GetTypes(TPasElement(Decl.Types[i]),indent+1);
+       end;
+      if not Unformated then writeln;
+      istype:=true; 
+     end;
+
+  if assigned(Decl.Classes) then
+    if Decl.Classes.Count >0 then
+     begin
+      if not istype then writeln('Type');
+      for i := 0 to Decl.Classes.Count - 1 do
+       begin
+        pe:=TPasElement(Decl.Classes[i]);
+        GetTPasClass(TPasClassType(pe),indent+1);
+        if not Unformated then writeln;
+       end;
+     end;
+
+  if assigned(Decl.Variables)then
+    if Decl.Variables.Count >0 then
+     begin
+       writeln(s,'var');
+       //Now i use GetPasVariables for more compact output
+       //for i:=0 to Decl.Variables.Count-1 do GetTPasVar(TPasVariable(Decl.Variables[i]),indent+1,false);
+       GetPasVariables(Decl.Variables,indent+1,false,false);
+       if not Unformated then writeln;
+     end;
+
+  if assigned(Decl.Functions) then
+   begin
+    for i := 0 to Decl.Functions.Count - 1 do
+     begin
+       pe:=TPasElement(Decl.Functions[i]);
+       if pe is TPasOverloadedProc then
+        begin
+         GetTpasOverloadedProc(TPasOverloadedProc(pe),indent);
+        end
+       else
+        begin
+         pp:=TPasProcedure(pe);
+         GetTPasProcedure(pp,indent);
+         GetTPasProcedureBody(pp.Body,indent);
+        end;
+     end;
+   end;
+end;   }
+
+//# parameter
+
+ procedure PrintUsage;
+  begin
+   writeln('usage: test_parser1 <Options> <Commandline> File');
+   writeln;
+   writeln(' <Options> : Options for test_parser1');
+   writeln('  -u  : Unformated output');
+   writeln('  -OS <os>   : <os>  = WINDOWS, LINUX (default), FREEBSD, NETBSD,');
+   writeln('                        SUNOS, BEOS, QNX, GO32V2');
+   writeln('  -CPU <cpu> : <cpu> = i386 (default), x86_64');
+   writeln(' <Commandline> : is the commandline for the parser');
+   writeln('  -d<define>        : <define> = Directive');
+   writeln('  -Fi<include_path> : <include_path> = ?');
+   writeln('  -I<include_path>  : <include_path> = ?');
+   writeln('  -Sd               : mode delphi');
+   writeln(' File : a pascal source file (Program or Unit)');
+  end;
+
+ procedure GetParam;
+  begin
+    if paramcount>0 then
+     begin
+      cmdl:='';
+      i:=1;
+      repeat
+        if paramstr(i) = '-h' then
+         begin
+          PrintUsage;
+          halt(0);
+         end
+        else if paramstr(i) = '-u' then Unformated:= true
+        else if paramstr(i) = '-OS' then
+         begin
+          if i < paramcount then
+           begin
+            inc(i);
+            TargetOS:=paramstr(i);
+            if (TargetOS = '')or(TargetOS[1] = '-') then halt(1);
+           end
+            else halt(1);
+         end
+        else if paramstr(i) = '-CPU' then
+         begin
+          if i < paramcount then
+           begin
+            inc(i);
+            TargetCPU:=paramstr(i);
+            if (TargetCPU = '')or(TargetCPU[1] = '-') then halt(1);
+           end
+            else halt(1);
+         end
+        else
+          cmdl:=cmdl+' '+paramstr(i);
+       inc(i);
+      until i > paramcount;
+     end;
+    if (Paramcount < 1)or(cmdl = '') then
+     begin
+      // remember to put the whole cmdline in quotes, and
+      // to always add some path options. Even if only -Fu. -Fi.
+       writeln('Error: No file for input given !');
+       PrintUsage;
+       halt(1);
+     end;
+  end;
+
+//# ***    main    ***
+
+begin
+  isim:=false;
+  Unformated:=false;//false to format output to be human readable
+  TargetOS:='linux';
+  TargetCPU:='i386';
+  GetParam;
+  //writeln(TargetOS,' ',TargetCPU,' ',cmdl);halt;
   E := TSimpleEngine.Create;
   try
     try
-      M := ParseSource(E, cmdl , 'linux', 'i386');
+      M := ParseSource(E, cmdl ,TargetOS ,TargetCPU);
     except
       on excep:EParserError do
         begin
-          writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename); 
+          writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename);
           raise;
+       end;
+    end;
+
+   if M is TPasProgram then
+    begin
+     writeln('Program ',M.Name,';');
+     if not Unformated then writeln;
+     if assigned(M.ImplementationSection) then
+       begin
+        isim:=true;
+        if not Unformated then writeln;
+        GetDecls(M.ImplementationSection as TPasDeclarations,0);
+        //PrintDecls(M.ImplementationSection as TPasDeclarations,0);
+       end;
+     if assigned(M.InitializationSection) then // MAIN BLOCK
+       begin
+        isim:=false;
+        if not Unformated then writeln;
+        writeln('begin');//writeln('begin {Begin MAIN Program}')
+        GetTPasImplBlock(M.InitializationSection as TPasImplBlock,1,0,false,false);
        end;  
-      end;      
-    { Cool, we successfully parsed the unit.
-      Now output some info about it. }
-    Decls := M.InterfaceSection.Declarations;
-    for I := 0 to Decls.Count - 1 do
-      Writeln('Interface item ', I, ': ', (TObject(Decls[I]) as TPasElement).Name);
+    end
+   else
+    begin
+      { Cool, we successfully parsed the unit.
+        Now output some info about it. }
+      writeln('Unit ',M.Name,';');
+      if not Unformated then writeln;
+      Writeln('Interface');
+      if not Unformated then writeln;
+      GetDecls(M.InterfaceSection as TPasDeclarations,0);
+      //PrintDecls(M.InterfaceSection as TPasDeclarations,0);
 
-    FreeAndNil(M);
-  finally 
-    FreeAndNil(E) 
+      if assigned(M.ImplementationSection) then
+       begin
+        isim:=true;
+        if not Unformated then writeln;
+        Writeln('Implementation');
+        if not Unformated then writeln;
+        GetDecls(M.ImplementationSection as TPasDeclarations,0);
+        //PrintDecls(M.ImplementationSection as TPasDeclarations,0);
+        if TPasElement(M.ImplementationSection) is TPasImplElement then writeln('{MAIN}');
+       end;
+      if assigned(M.InitializationSection) then //is this begin .. end. of a unit too ?
+       begin
+        isim:=true;
+        if not Unformated then writeln;
+        Writeln('Initialization');
+        if not Unformated then writeln;
+        GetTPasImplBlock(M.InitializationSection as TPasImplBlock,1,0,false,false);
+        if assigned(M.FinalizationSection) then
+         begin
+          isim:=true;
+          if not Unformated then writeln;
+          Writeln('Finalization');
+          if not Unformated then writeln;
+          GetTPasImplBlock(M.FinalizationSection as TPasImplBlock,1,0,false,false);
+         end;
+       end;
     end;
+    if not Unformated then writeln('end.')
+     else
+      begin
+       writeln('end');
+       writeln('.');
+      end;
+    FreeAndNil(M);
+  finally
+    FreeAndNil(E);
+  end;
 end.

packages/fcl-passrc/examples/testunit1.pp

@@ -0,0 +1,713 @@
+//This is only for testing the parser, it is not intended to be runable in a real
+//program but for checking the contructs to be parsed well.
+//All statements are written like testparser would print them out to diff the 
+//result with this file again to show differences. 
+//Based on /utils/fpdoc/testunit.pp
+{$mode objfpc}
+{$h+}
+unit testunit1;
+
+interface
+
+ uses 
+  SysUtils,Classes;
+
+ const
+  AnIntegerConst=1;
+  AStringConst='Hello, World!';
+  AFLoatconst=1.23;
+  ABooleanConst=True;
+  ATypedConst: Integer=3;
+  AnArrayConst: Array[1..3] of Integer=(1,2,3);
+  ARecordConst: TMethod=(Code:nil;Data:nil);
+  ASetConst=[true,false];
+  ADeprecatedConst=1 deprecated;
+   
+ Type
+  TAnEnumType=(one,two,three);
+  TASetType=set of TAnEnumType;
+  TAnArrayType=Array[1..10] of Integer;
+  TASubRangeType=one..two;
+  TABooleanArrayType=Array[Boolean] of Integer;  
+  TARecordType=record
+                   X,Y: Integer;
+                   Z: String;
+                      end;
+  TAVariantRecordType=record
+                          A: String;
+                          Case Integer of
+                        1: (X,Y : Integer);
+                        2: (phi,Omega : Real);
+                         end; 
+  TAVariantRecordType2=record
+                          A: String;
+                          Case Atype : Integer of
+                            1 : (X,Y : Integer);
+                            2 : (phi,Omega : Real);
+                          end; 
+                          
+  MyRec = Record  
+          X : Longint;  
+          Case byte of  
+            2 : (Y : Longint;  
+                 case byte of  
+                 3 : (Z : Longint);  
+                 );  
+          end;                           
+                          
+//  TADeprecatedType = Integer deprecated;
+
+  { TMyParentClass }
+
+  TMyParentClass=Class(TComponent)
+  Private 
+    FI: Integer;
+    Function GetA(AIndex: Integer): String;
+    Function GetIP(AIndex: integer): String;
+    procedure SetA(AIndex: Integer; const AValue: String);
+    procedure SetIP(AIndex: integer; const AValue: String);
+    Procedure WriteI(AI: Integer);
+    Function ReadI: Integer;
+  Protected
+    Procedure AProtectedMethod;
+    Property AProtectedProp: Integer Read FI Write FI;  
+  Public
+    Constructor Create(AOwner: TComponent); override;
+    Destructor Destroy; override;
+    Procedure AVirtualProc; virtual;
+    Procedure AnAbstractProc; virtual; abstract;
+    Procedure AMessageProc(var Msg);message 123;
+    Procedure AStringMessageProc(var Msg);message '123';
+    Procedure ADeprecatedProc; deprecated;
+    Procedure APlatformProc; Platform;
+    Property IntProp: Integer Read FI Write Fi;
+    Property IntROProp: Integer Read FI;
+    Property GetIntProp: Integer Read ReadI Write WriteI;
+    Property AnArrayProp[AIndex: Integer]: String Read GetA Write SetA;
+    Property AnIndexProp: String Index 1 Read GetIP Write SetIP;
+    Property AnIndexProp2: String Index 2 Read GetIP Write SetIP;
+  Published
+    Procedure SomePublishedMethod;
+  end;
+  
+  { TMyChildClass }
+
+  TMyChildClass=Class(TMyParentClass)
+  Public
+    Procedure AVirtualProc; Override;
+    Procedure AnAbstractProc; Override;
+  Published
+    Property AProtectedProp;
+  end;
+  
+ TPasFunctionType=Class(TPasProcedureType)
+  public
+    destructor Destroy; override;
+    Class Function TypeName: string; override;
+    Function ElementTypeName: string; override;
+    Function GetDeclaration(Full: boolean): string; override;
+  public
+    ResultEl: TPasResultElement;
+  end; 
+                        
+ var
+  ASimpleVar: Integer;  
+  ATypedVar: TMethod;
+  ARecordVar: Record
+                 A,B: Integer;
+               end;
+  AnArrayVar: Array[1..10] of Integer;
+  ATypedArray: Array[TanEnumType] of Integer;
+  AInitVar: Integer=1;
+  
+  ADeprecatedVar: Integer deprecated;
+  ACVarVar: Integer ; cvar;
+  AnExternalVar: Integer ;external name 'avar';
+  AnExternalLibVar: Integer ;external 'library' name 'avar';
+      
+ Procedure SimpleProc;
+ Procedure OverloadedProc(A: Integer);
+ Procedure OverloadedProc(B: String);
+ Function SimpleFunc: Integer;
+ Function OverloadedFunc(A: Integer): Integer;
+ Function OverloadedFunc(B: String): Integer;  
+
+ Procedure ConstArgProc(const A: Integer); 
+ Procedure VarArgProc(var A: Integer); 
+ Procedure OutArgProc(out A: Integer); 
+ Procedure UntypedVarArgProc(var A); 
+ Procedure UntypedConstArgProc(const A); 
+ Procedure UntypedOutArgProc(out A); 
+
+ Procedure ArrayArgProc(A: TAnArrayType);
+ Procedure OpenArrayArgProc(A: Array of string);
+ Procedure ConstArrayArgProc(A: Array of const);
+
+ Procedure externalproc; external;
+ Procedure externalnameProc; external name 'aname';
+ Procedure externallibnameProc; external 'alibrary' name 'aname';
+
+  
+Implementation
+
+
+ Procedure SimpleProc;
+
+ procedure  SubProc;
+  begin
+   s:= s+'a';
+  end;
+
+ begin
+  a:= 1;
+  c:= a+b;
+  for i:= 1 to 10 do 
+    write(a);
+ end;
+
+ Procedure OverloadedProc(A: Integer);
+ begin
+  if i=1 then ;
+ end;
+
+ Procedure OverloadedProc(B: String);
+ begin
+ end;
+
+ Function SimpleFunc: Integer;
+ begin
+ end;
+
+ Function OverloadedFunc(A: Integer): Integer; 
+ begin
+ end;
+
+ Function OverloadedFunc(B: String): Integer;  
+ begin
+ end;
+
+ Procedure ArrayArgProc(A: TAnArrayType);
+ begin
+ end;
+
+ Procedure OpenArrayArgProc(A: Array of String);
+ begin
+ end;
+
+ Procedure ConstArrayArgProc(A: Array of const);
+ begin
+ end;
+
+ Procedure ConstArgProc(const A: Integer); 
+ begin
+ end;
+
+ Procedure VarArgProc(var A: Integer); 
+ begin
+ end;
+
+ Procedure OutArgProc(out A: Integer); 
+ begin
+ end;
+
+ Procedure UntypedVarArgProc(var A); 
+ begin
+ end;
+
+ Procedure UntypedConstArgProc(const A); 
+ begin
+ end;
+
+ Procedure UntypedOutArgProc(out A); 
+ begin
+ end;
+
+{ TMyChildClass }
+ procedure TMyChildClass.AVirtualProc;
+ begin
+  inherited AVirtualProc;
+ end;
+
+ procedure TMyChildClass.AnAbstractProc;
+ procedure  SubCProc;
+  begin
+   sc:= sc+'ac';
+  end;
+
+ begin
+  // Cannot call ancestor
+ end;
+
+{ TMyParentClass }
+ procedure TMyParentClass.WriteI(AI: Integer);
+ begin
+ end;
+
+ Function TMyParentClass.GetA(AIndex: Integer): String;
+ begin
+ end;
+
+ Function TMyParentClass.GetIP(AIndex: integer): String;
+ begin
+ end;
+
+ procedure TMyParentClass.SetA(AIndex: Integer; const AValue: String);
+ begin
+ end;
+
+ procedure TMyParentClass.SetIP(AIndex: integer; const AValue: String);
+ begin
+ end;
+
+ Function TMyParentClass.ReadI: Integer;
+ begin
+ end;
+
+ procedure TMyParentClass.AProtectedMethod;
+ begin
+ end;
+
+ constructor TMyParentClass.Create(AOwner: TComponent);
+ begin
+  inherited Create(AOwner);
+ end;
+
+ destructor TMyParentClass.Destroy;
+ begin
+  inherited Destroy;
+ end;
+
+ procedure TMyParentClass.AVirtualProc;
+ begin
+ end;
+
+ procedure TMyParentClass.AMessageProc(var Msg);
+ begin
+ end;
+
+ procedure TMyParentClass.AStringMessageProc(var Msg);
+ begin
+ end;
+
+ procedure TMyParentClass.ADeprecatedProc;
+ begin
+ end;
+
+ procedure TMyParentClass.APlatformProc;
+ begin
+ end;
+
+ procedure TMyParentClass.SomePublishedMethod;
+ begin
+ end;
+ 
+ Class Function TPasFunctionType.TypeName: String;
+ begin
+  Result:= 'Function';
+ end;
+
+ procedure Statements;
+ const
+  cint=1;
+  cint1=-1;
+  creal=3.1415;
+  Addi=1+2;
+  Subs=2-3;
+  Muti=3*3;
+  Divi=3/5;
+  //Powe=2^3;
+  Modu=5 mod 3;
+  IDiv=5 div 3;
+  fals= not TRUE;
+  cand=true and false;
+  cor=true or false;
+  cxor=true xor false;
+  lt=2<3;
+  gt=3>2;
+  let=2<=3;
+  get=3>=2;
+  LeftShift=2 shl 3;
+  RightShift=2 shr 3;
+  ConstString='01'+'ab';
+
+ Type
+  Passenger=Record
+                Name: String[30];
+                Flight: String[10];
+  end;
+
+ Type 
+  AR=record
+      X,Y: LongInt;
+     end;
+  //PAR = Record;
+ var
+  TheCustomer: Passenger;
+  L: ^LongInt;
+  P: PPChar;
+  S,T: Ar;
+      
+ begin
+  X:= X+Y;
+  //EparserError on C++ style
+  //X+=Y;      { Same as X := X+Y, needs -Sc command line switch}
+  //x-=y;
+  //X/=2;      { Same as X := X/2, needs -Sc command line switch}
+  //x*=y;
+  Done:= False;
+  Weather:= Good;
+  //MyPi := 4* Tan(1); warum * ?
+  L^:= 3;
+  P^^:= 'A';
+  Usage;
+  WriteLn('Pascal is an easy language !');
+  Doit();
+  //label jumpto;
+  //Jumpto :
+  //  Statement;
+  //Goto jumpto;
+
+  Case i of
+    3: DoSomething;
+    1..5: DoSomethingElse;
+  end;
+
+  Case C of  
+    'a': WriteLn('A pressed');
+    'b': WriteLn('B pressed');
+    'c': WriteLn('C pressed');
+  else  
+   WriteLn('unknown letter pressed : ',C);
+  end;
+
+  Case C of
+    'a','e','i','o','u': WriteLn('vowel pressed');
+    'y': WriteLn('This one depends on the language');
+  else
+   WriteLn('Consonant pressed');
+  end;
+
+  Case Number of
+    1..10: WriteLn('Small number');
+    11..100: WriteLn('Normal, medium number');
+  else
+   WriteLn('HUGE number');
+  end;
+
+  case block of
+    1: begin
+	writeln('1');
+	end;
+    2: writeln('2');
+  else
+    writeln('3');
+    writeln('4');
+  end;
+
+  If exp1 Then
+    If exp2 then
+      Stat1
+  else
+    stat2;
+
+  If exp3 Then
+      begin
+      If exp4 then
+	Stat5
+      else
+	stat6
+      end;
+
+  If exp7 Then
+    begin
+    If exp8 then
+	Stat9
+    end
+  else
+    stat2;
+
+ if i is integer then
+  begin
+    write('integer');
+  end
+  else 
+    if i is real then 
+  begin
+    write('real');
+  end
+  else 
+    write('0'); 
+
+  if Today in[Monday..Friday] then
+    WriteLn('Must work harder')
+  else
+    WriteLn('Take a day off.');
+
+  for Day:= Monday to Friday do 
+    Work;
+  for I:= 100 downto 1 do
+    WriteLn('Counting down : ',i);
+  for I:= 1 to 7*dwarfs do 
+    KissDwarf(i);
+
+  for i:= 0 to 10 do
+    begin
+    j:= 2+1;
+    write(i,j);
+    end;
+
+  repeat
+    WriteLn('I =',i);
+    I:= I+2;
+  until I>100;
+    
+  repeat
+    X:= X/2;
+  until x<10e-3;
+
+  I:= I+2;
+  while i<=100 do
+    begin
+     WriteLn('I =',i);
+     I:= I+2;
+    end;
+    X:= X/2;
+    while x>=10e-3 do 
+      dec(x);
+
+    while x>0 do 
+    while y>0 do 
+      begin
+	dec(x);
+	dec(y);
+      end;
+
+    while x>0 do
+    if x>2 then 
+     dec(x)
+    else 
+     dec(x,2);
+
+      X:= 2+3;
+
+    TheCustomer.Name:= 'Michael';
+    TheCustomer.Flight:= 'PS901';
+
+    With TheCustomer do
+      begin
+       Name:= 'Michael';
+       Flight:= 'PS901';
+      end;
+
+  With A,B,C,D do
+   Statement;
+
+    With A do
+     With B do
+      With C do
+       With D do 
+        Statement;
+
+    S.X:= 1;S.Y:= 1;
+    T.X:= 2;T.Y:= 2;
+    With S,T do
+      WriteLn(X,' ',Y);
+
+    {asm
+      Movl $1,%ebx
+      Movl $0,%eax
+      addl %eax,%ebx
+    end; ['EAX','EBX'];}
+
+    try
+	try
+	  M:= ParseSource(E,cmdl,'linux','i386');
+	except
+	  on excep: EParserError do
+	    begin
+	      writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename);
+	      raise ;
+	  end;
+	end;
+	Decls:= M.InterfaceSection.Declarations;
+	for I:= 0 to Decls.Count-1 do
+	  Writeln('Interface item ',I,': ');
+
+	FreeAndNil(M);
+    finally
+	FreeAndNil(E)
+   end;
+   
+   raise EParserError.Create(Format(SParserErrorAtToken, [Msg, CurTokenName]) {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif},Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
+    
+    // try else
+ end;
+
+ procedure Expression;
+ begin
+  A:= a+b *c /(-e+f)*3 div 2 + 4 mod 5 - 2 shl 3 + 3 shr 1 ;
+  b:= (a and not b) or c xor d;
+  u:= i<=2 or a<>b or j>=3;
+  u:= i=1 or a>b or b<a or i<>2;
+  u:= i in [1..2];
+
+ If F=@AddOne Then  
+  WriteLn('Functions are equal');
+
+ If F()=Addone then  
+  WriteLn('Functions return same values ');
+
+ z:= [today,tomorrow];
+ z:= [Monday..Friday,Sunday];
+ z:= [2,3*2,6*2,9*2];
+ z:= ['A'..'Z','a'..'z','0'..'9'];
+
+ x:= Byte('A');
+ x:= Char(48);
+ x:= boolean(1);
+ x:= longint(@Buffer);
+ x:= Integer('A');
+ x:= Char(4875);
+ x:= Word(@Buffer);
+
+ B:= Byte(C);
+ Char(B):= C;
+
+ TWordRec(W).L:= $FF;
+ TWordRec(W).H:= 0;
+ S:= TObject(P).ClassName;
+
+ P:= @MyProc; //warum @ ? fix pparser 769 ?
+
+ Dirname:= Dirname+'\';
+
+ W:= [mon,tue]+[wed,thu,fri]; // equals [mon,tue,wed,thu,fri]
+ W:= [mon,tue,wed]-[wed];     // equals [mon,tue]
+ W:= [mon,tue,wed]*[wed,thu,fri]; // equals [wed] warum * ?
+
+ (C as TEdit).Text:= 'Some text';
+ C:= O as TComponent;
+
+ if A is TComponent then ;
+ If A is B then ;
+
+ Inherited ;
+ Inherited Test;
+
+  if true then
+    Inherited
+  else
+    DoNothing;
+
+  if true then
+    Inherited Test
+  else
+    DoNothing;
+
+   Inherited P:= 3;  
+   Inherited SetP1(3); 
+   Result:= Char(P and $FF);  
+   Result:= Char((Inherited P) and $FF);  
+   Inherited P:= Ord(AValue);
+   Result:= Inherited InterPretOption(Cmd,Arg);
+
+  raise Exception.Create(SErrMultipleSourceFiles);
+
+  if Filename<>'' then
+	  raise Exception.Create(SErrMultipleSourceFiles);
+
+  if Filename<>'' then
+	  raise Exception.Create(SErrMultipleSourceFiles)
+	else
+	  Filename:= s;
+
+  Self.Write(EscapeText(AText)); 
+  TObject.Create(Self);
+ end;
+
+ constructor TPasPackage.Create(const AName: String; AParent: TPasElement);
+ begin
+  if (Length(AName)>0)and(AName[1]<>'#') then
+   Inherited Create('#'+AName,AParent)
+  else
+   Inherited Create(AName,AParent);
+  Modules:= TList.Create;
+ end;         
+
+ Function TPascalScanner.FetchToken: TToken;
+ var
+  IncludeStackItem: TIncludeStackItem;
+
+ begin
+  while true do
+  begin
+    Result:= DoFetchToken;
+     if FCurToken=tkEOF then
+      if FIncludeStack.Count>0 then
+      begin
+        CurSourceFile.Free;
+        IncludeStackItem:= TIncludeStackItem(FIncludeStack[FIncludeStack.Count-1]);
+        FIncludeStack.Delete(FIncludeStack.Count-1);
+        FCurSourceFile:= IncludeStackItem.SourceFile;
+        FCurFilename:= IncludeStackItem.Filename;
+        FCurToken:= IncludeStackItem.Token;
+        FCurTokenString:= IncludeStackItem.TokenString;
+        FCurLine:= IncludeStackItem.Line;
+        FCurRow:= IncludeStackItem.Row;
+        TokenStr:= IncludeStackItem.TokenStr;
+        IncludeStackItem.Free;
+        Result:= FCurToken;
+      end 
+    else
+      break
+    else
+      if not PPIsSkipping then
+        break;
+  end;
+ end;  
+
+ Procedure IFS;
+ begin
+  if true then
+   repeat
+   until false
+  else
+    Noting;
+ end;           
+
+
+ Procedure IFS(x: integer); overload;
+ begin
+  if true then
+    case x of
+     1: writeln;
+     2: write;
+   else 
+    writeln('#');
+   end
+  else
+    Noting;
+ end;
+
+ Procedure IFS1; 
+ begin
+  if true then
+    while true do
+     Something
+  else
+    Noting;
+ end;
+
+ Procedure IFS3;
+ begin
+  if true then
+   if true then 
+    write
+   else 
+    writeln;
+ end; 
+
+Initialization
+ 
+  hallo:= valid;
+end.

packages/fcl-passrc/src/pastree.pp

@@ -121,7 +121,7 @@ type
   end;
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst, pekRange,
-     pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp);
+     pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp, pekInherited, pekSelf);
 
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -178,6 +178,20 @@ type
     function GetDeclaration(full : Boolean) : string; override;
   end;
 
+  { TInheritedExpr }
+
+  TInheritedExpr = class(TPasExpr)
+    constructor Create(AParent : TPasElement); overload;
+    function GetDeclaration(full : Boolean) : string; override;
+  end;
+
+  { TSelfExpr }
+
+  TSelfExpr = class(TPasExpr)
+    constructor Create(AParent : TPasElement); overload;
+    function GetDeclaration(full : Boolean) : string; override;
+  end;
+
   { TParamsExpr }
 
   TParamsExpr = class(TPasExpr)
@@ -454,6 +468,7 @@ type
     AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
     IsPacked: Boolean;        // 12/04/04 - Dave - Added
     IsForward : Boolean;
+    IsShortDefinition: Boolean;//class(anchestor); without end
     Members: TList;     // array of TPasElement objects
     InterfaceGUID : string; // 15/06/07 - Inoussa
 
@@ -1346,6 +1361,7 @@ constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
   IsPacked := False;                     // 12/04/04 - Dave - Added
+  IsShortDefinition := False;
   Members := TList.Create;
   Modifiers := TStringList.Create;
   ClassVars := TList.Create;
@@ -1388,7 +1404,7 @@ var
 begin
   for i := 0 to Args.Count - 1 do
     TPasArgument(Args[i]).Release;
-  Args.Free;
+  FreeAndNil(Args);
   inherited Destroy;
 end;
 
@@ -1726,12 +1742,14 @@ begin
   Result:=TPasImplAssign.Create('', Self);
   Result.left:=left;
   Result.right:=right;
+  AddElement(Result);
 end;
 
 function TPasImplBlock.AddSimple(exp:TPasExpr):TPasImplSimple;
 begin
   Result:=TPasImplSimple.Create('', Self);
   Result.expr:=exp;
+  AddElement(Result);
 end;
 
 function TPasImplBlock.CloseOnSemicolon: boolean;
@@ -2661,13 +2679,29 @@ begin
   Fields[i].ValueExp:=Value;
 end;
 
-{ TArrayValues }
+{ TNilExpr }
 
 Function TNilExpr.GetDeclaration(Full :Boolean):AnsiString;
 begin
   Result:='Nil';
 end;
 
+{ TInheritedExpr }
+
+Function TInheritedExpr.GetDeclaration(Full :Boolean):AnsiString;
+begin
+  Result:='Inherited';
+end;
+
+{ TSelfExpr }
+
+Function TSelfExpr.GetDeclaration(Full :Boolean):AnsiString;
+begin
+  Result:='Self';
+end;
+
+{ TArrayValues }
+
 Function TArrayValues.GetDeclaration(Full: Boolean):AnsiString;
 
 Var
@@ -2712,6 +2746,20 @@ begin
   inherited Create(AParent,pekNil, eopNone);
 end;
 
+{ TInheritedExpr }
+
+constructor TInheritedExpr.Create(AParent : TPasElement);
+begin
+  inherited Create(AParent,pekInherited, eopNone);
+end;
+
+{ TSelfExpr }
+
+constructor TSelfExpr.Create(AParent : TPasElement);
+begin
+  inherited Create(AParent,pekSelf, eopNone);
+end;
+
 { TPasLabels }
 
 constructor TPasLabels.Create(const AName:string;AParent:TPasElement);

packages/fcl-passrc/src/pparser.pp

@@ -766,6 +766,40 @@ begin
     tkfalse, tktrue:    x:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
     tknil:              x:=TNilExpr.Create(Aparent);
     tkSquaredBraceOpen: x:=ParseParams(AParent,pekSet);
+    tkinherited: begin
+      //inherited; inherited function
+      x:=TInheritedExpr.Create(AParent);
+      NextToken;
+      if (length(CurTokenText)>0) and (CurTokenText[1] in ['A'..'_']) then begin
+        b:=TBinaryExpr.Create(AParent,x, DoParseExpression(AParent), eopNone);
+        if not Assigned(b.right) then Exit; // error
+        x:=b;
+        UngetToken;
+      end
+       else UngetToken;
+    end;
+    tkself: begin
+      x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText); //function(self);
+      x:=TSelfExpr.Create(AParent);
+      NextToken;
+      if CurToken = tkDot then begin // self.Write(EscapeText(AText));
+        optk:=CurToken;
+        NextToken;
+        b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
+        if not Assigned(b.right) then Exit; // error
+        x:=b;
+      end
+       else UngetToken;
+    end;
+    tkAt: begin
+      // P:=@function;
+      NextToken;
+      if (length(CurTokenText)=0) or not (CurTokenText[1] in ['A'..'_']) then begin
+        UngetToken;
+        ParseExc(SParserExpectedIdentifier);
+      end;
+      x:=TPrimitiveExpr.Create(AParent,pekString, '@'+CurTokenText);
+    end;
     tkCaret: begin
       // ^A..^_ characters. See #16341
       NextToken;
@@ -2714,6 +2748,27 @@ begin
           // empty then => add dummy command
           CurBlock.AddCommand('');
         end;
+        if TPasImplIfElse(CurBlock).ElseBranch<>nil then
+        begin
+          // this and the following 3 may solve TPasImplIfElse.AddElement BUG
+          // ifs without begin end
+          // if .. then
+          //  if .. then
+          //   else
+          // else
+          CloseBlock;
+          CloseStatement(false);
+        end;
+      end else if (CurBlock is TPasImplWhileDo) then
+      begin
+        //if .. then while .. do smt else ..
+        CloseBlock;
+        UngetToken;
+      end else if (CurBlock is TPasImplRaise) then
+      begin
+        //if .. then Raise Exception else ..
+        CloseBlock;
+        UngetToken;
       end else if (CurBlock is TPasImplTryExcept) then
       begin
         CloseBlock;
@@ -2795,16 +2850,17 @@ begin
             repeat
               Expr:=ParseExpression(Parent);
               //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
-              if CurBlock is TPasImplCaseStatement then
-                TPasImplCaseStatement(CurBlock).Expressions.Add(Expr)
-              else
-                CurBlock:=TPasImplCaseOf(CurBlock).AddCase(Expr);
               NextToken;
               if CurToken=tkDotDot then
               begin
                 Expr:=Expr+'..'+ParseExpression(Parent);
                 NextToken;
               end;
+              // do not miss '..'
+              if CurBlock is TPasImplCaseStatement then
+                TPasImplCaseStatement(CurBlock).Expressions.Add(Expr)
+              else
+                CurBlock:=TPasImplCaseOf(CurBlock).AddCase(Expr);
               //writeln(i,'CASE after value Token=',CurTokenText);
               if CurToken=tkColon then break;
               if CurToken<>tkComma then
@@ -2932,7 +2988,7 @@ begin
         begin
           // assign statement
           NextToken;
-          right:=ParseExpIdent(Parent);
+          right:=DoParseExpression(nil); // this may solve TPasImplWhileDo.AddElement BUG
           CmdElem:=CurBlock.AddAssign(left, right);
           UngetToken;
         end;
@@ -2943,7 +2999,7 @@ begin
           // label mark. todo: check mark identifier in the list of labels
           CmdElem:=CurBlock.AddLabelMark(TPrimitiveExpr(left).Value);
           left.Free;
-        end
+        end;
       else
         // simple statement (function call)
         CmdElem:=CurBlock.AddSimple(left);
@@ -3130,36 +3186,62 @@ function TPasParser.ParseClassDecl(Parent: TPasElement;
 var
   CurVisibility: TPasMemberVisibility;
 
-  procedure ProcessMethod(const MethodTypeName: String; HasReturnValue: Boolean);
+  procedure ProcessMethod(ProcType: TProcType);
   var
     Owner: TPasElement;
     Proc: TPasProcedure;
-    s: String;
+    s,Name: String;
     pt: TProcType;
+    HasReturnValue: Boolean;
+
   begin
+    HasReturnValue:=false;
     ExpectIdentifier;
-    Owner := CheckIfOverloaded(TPasClassType(Result), CurTokenString);
-    if HasReturnValue then
+    Name := CurTokenString;
+    Owner := CheckIfOverloaded(TPasClassType(Result), Name);
+    case ProcType of
+     ptFunction:
     begin
-      Proc := TPasFunction(CreateElement(TPasFunction, CurTokenString, Owner,
+         Proc := TPasFunction(CreateElement(TPasFunction, Name, Owner,
         CurVisibility));
       Proc.ProcType := Engine.CreateFunctionType('', 'Result', Proc, True,
         Scanner.CurFilename, Scanner.CurRow);
-    end else
+        HasReturnValue:=true;
+       end;
+     ptClassFunction:
     begin
-      // !!!: The following is more than ugly
-      if MethodTypeName = 'constructor' then
-        Proc := TPasConstructor(CreateElement(TPasConstructor, CurTokenString,
-          Owner, CurVisibility))
-      else if MethodTypeName = 'destructor' then
-        Proc := TPasDestructor(CreateElement(TPasDestructor, CurTokenString,
-          Owner, CurVisibility))
+         Proc := TPasClassFunction(CreateElement(TPasClassFunction, Name, Owner));
+         Proc.ProcType := Engine.CreateFunctionType('', 'Result', Proc, True,
+          Scanner.CurFilename, Scanner.CurRow);
+         HasReturnValue:=true;
+       end;
+     ptClassProcedure:
+       begin
+         Proc := TPasClassProcedure(CreateElement(TPasClassProcedure, Name, Owner));
+         Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
+          Proc, CurVisibility));
+       end;
+     ptConstructor:
+       begin
+        Proc := TPasConstructor(CreateElement(TPasConstructor, Name,
+          Owner, CurVisibility));
+        Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
+          Proc, CurVisibility));
+       end;
+     ptDestructor:
+       begin
+        Proc := TPasDestructor(CreateElement(TPasDestructor, Name,
+          Owner, CurVisibility));
+        Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
+          Proc, CurVisibility));
+       end;
       else
-        Proc := TPasProcedure(CreateElement(TPasProcedure, CurTokenString,
+        Proc := TPasProcedure(CreateElement(TPasProcedure, Name,
           Owner, CurVisibility));
       Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
         Proc, CurVisibility));
     end;
+    
     if Owner.ClassType = TPasOverloadedProc then
       TPasOverloadedProc(Owner).Overloads.Add(Proc)
     else
@@ -3302,6 +3384,8 @@ begin
     end
     else
       TPasClassType(Result).isForward:=CurToken=tkSemicolon;
+    if CurToken = tkSemicolon then
+       TPasClassType(Result).IsShortDefinition:=true;
 
     if CurToken <> tkSemicolon then
     begin
@@ -3364,13 +3448,19 @@ begin
 
             end;
           tkProcedure:
-            ProcessMethod('procedure', False);
+            ProcessMethod(ptProcedure);
           tkFunction:
-            ProcessMethod('function', True);
+            ProcessMethod(ptFunction);
           tkConstructor:
-            ProcessMethod('constructor', False);
+            ProcessMethod(ptConstructor);
           tkDestructor:
-            ProcessMethod('destructor', False);
+            ProcessMethod(ptDestructor);
+          tkclass:
+            begin
+             NextToken;
+             if CurToken = tkprocedure then ProcessMethod(ptClassProcedure)
+              else ProcessMethod(ptClassFunction);
+            end;               
           tkProperty:
             begin
               ExpectIdentifier;

packages/fcl-web/src/base/custfcgi.pp

@@ -21,7 +21,7 @@ unit custfcgi;
 Interface
 
 uses
-  Classes,SysUtils, httpdefs,custweb, custcgi, fastcgi;
+  Classes,SysUtils, httpdefs, Sockets, custweb, custcgi, fastcgi;
 
 Type
   { TFCGIRequest }
@@ -60,9 +60,7 @@ Type
 
   TFCGIResponse = Class(TCGIResponse)
   private
-    FNoPadding: Boolean;
     FPO: TProtoColOptions;
-    FStripCL: Boolean;
     procedure Write_FCGIRecord(ARecord : PFCGI_Header);
   Protected
     Procedure DoSendHeaders(Headers : TStrings); override;
@@ -75,6 +73,8 @@ Type
              Response : TFCgiResponse;
              end;
 
+  { TFCgiHandler }
+
   TFCgiHandler = class(TWebHandler)
   Private
     FOnUnknownRecord: TUnknownRecordEvent;
@@ -87,7 +87,9 @@ Type
     FPort: integer;
     function Read_FCGIRecord : PFCGI_Header;
   protected
-    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
+    function  ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest;  out AResponse: TResponse): boolean; virtual;
+    procedure SetupSocket(var IAddress: TInetSockAddr;  var AddressLength: tsocklen); virtual;
+    function  WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
   Public
     constructor Create(AOwner: TComponent); override;
@@ -126,14 +128,15 @@ ResourceString
   SListenFailed     = 'Failed to listen to port %d. Socket Error: %d';
   SErrReadingSocket = 'Failed to read data from socket. Error: %d';
   SErrReadingHeader = 'Failed to read FastCGI header. Read only %d bytes';
+  SErrWritingSocket = 'Failed to write data to socket. Error: %d';
 
 Implementation
 
-uses
 {$ifdef CGIDEBUG}
-  dbugintf,
+uses
+  dbugintf;
 {$endif}
-  Sockets;
+
 
 {$undef nosignal}
 
@@ -315,9 +318,13 @@ begin
   P:=PByte(Arecord);
   Repeat
     BytesWritten := sockets.fpsend(TFCGIRequest(Request).Handle, P, BytesToWrite, NoSignalAttr);
+    If (BytesWritten<0) then
+      begin
+      // TODO : Better checking for closed connection, EINTR
+      Raise HTTPError.CreateFmt(SErrWritingSocket,[BytesWritten]);
+      end;
     Inc(P,BytesWritten);
     Dec(BytesToWrite,BytesWritten);
-//    Assert(BytesWritten=BytesToWrite);
   until (BytesToWrite=0) or (BytesWritten=0);
 end;
 
@@ -346,15 +353,18 @@ begin
     pl := 8-(cl mod 8);
   ARespRecord:=nil;
   Getmem(ARespRecord,8+cl+pl);
-  FillChar(ARespRecord^,8+cl+pl,0);
-  ARespRecord^.header.version:=FCGI_VERSION_1;
-  ARespRecord^.header.reqtype:=FCGI_STDOUT;
-  ARespRecord^.header.paddingLength:=pl;
-  ARespRecord^.header.contentLength:=NtoBE(cl);
-  ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
-  move(str[1],ARespRecord^.ContentData,cl);
-  Write_FCGIRecord(PFCGI_Header(ARespRecord));
-  Freemem(ARespRecord);
+  try
+    FillChar(ARespRecord^,8+cl+pl,0);
+    ARespRecord^.header.version:=FCGI_VERSION_1;
+    ARespRecord^.header.reqtype:=FCGI_STDOUT;
+    ARespRecord^.header.paddingLength:=pl;
+    ARespRecord^.header.contentLength:=NtoBE(cl);
+    ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
+    move(str[1],ARespRecord^.ContentData,cl);
+    Write_FCGIRecord(PFCGI_Header(ARespRecord));
+  finally
+    Freemem(ARespRecord);
+  end;
 end;
 
 procedure TFCGIResponse.DoSendContent;
@@ -392,14 +402,17 @@ begin
       pl := 8-(cl mod 8);
     ARespRecord:=Nil;
     Getmem(ARespRecord,8+cl+pl);
-    ARespRecord^.header.version:=FCGI_VERSION_1;
-    ARespRecord^.header.reqtype:=FCGI_STDOUT;
-    ARespRecord^.header.paddingLength:=pl;
-    ARespRecord^.header.contentLength:=NtoBE(cl);
-    ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
-    move(Str[BS+1],ARespRecord^.ContentData,cl);
-    Write_FCGIRecord(PFCGI_Header(ARespRecord));
-    Freemem(ARespRecord);
+    try
+      ARespRecord^.header.version:=FCGI_VERSION_1;
+      ARespRecord^.header.reqtype:=FCGI_STDOUT;
+      ARespRecord^.header.paddingLength:=pl;
+      ARespRecord^.header.contentLength:=NtoBE(cl);
+      ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
+      move(Str[BS+1],ARespRecord^.ContentData,cl);
+      Write_FCGIRecord(PFCGI_Header(ARespRecord));
+    finally
+      Freemem(ARespRecord);
+    end;
     Inc(BS,cl);
   Until (BS=L);
   FillChar(EndRequest,SizeOf(FCGI_EndRequestRecord),0);
@@ -452,6 +465,30 @@ begin
 end;
 
 function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
+{ $DEFINE DUMPRECORD}
+{$IFDEF DUMPRECORD}
+  Procedure DumpFCGIRecord (Var Header :FCGI_Header; ContentLength : word; PaddingLength : byte; ResRecord : Pointer);
+
+  Var
+    s : string;
+    I : Integer;
+
+  begin
+      Writeln('Dumping record ', Sizeof(Header),',',Contentlength,',',PaddingLength);
+      For I:=0 to Sizeof(Header)+ContentLength+PaddingLength-1 do
+        begin
+        Write(Format('%:3d ',[PByte(ResRecord)[i]]));
+        If PByte(ResRecord)[i]>30 then
+          S:=S+char(PByte(ResRecord)[i]);
+        if (I mod 16) = 0 then
+           begin
+           writeln('  ',S);
+           S:='';
+           end;
+        end;
+      Writeln('  ',S)
+  end;
+{$ENDIF DUMPRECORD}
 
   function ReadBytes(ReadBuf: Pointer; ByteAmount : Word) : Integer;
 
@@ -477,12 +514,11 @@ function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
   end;
 
 var Header : FCGI_Header;
-    {I,}BytesRead : integer;
+    BytesRead : integer;
     ContentLength : word;
     PaddingLength : byte;
     ResRecord : pointer;
     ReadBuf : pointer;
-    s : string;
 
 
 begin
@@ -490,119 +526,141 @@ begin
   ResRecord:=Nil;
   ReadBuf:=@Header;
   BytesRead:=ReadBytes(ReadBuf,Sizeof(Header));
-  If (BytesRead<>Sizeof(Header)) then
+  If (BytesRead=0) then
+    Exit // Connection closed gracefully.
+    // TODO : if connection closed gracefully, the request should no longer be handled.
+    // Need to discard request/response
+  else If (BytesRead<>Sizeof(Header)) then
     Raise HTTPError.CreateFmt(SErrReadingHeader,[BytesRead]);
   ContentLength:=BetoN(Header.contentLength);
   PaddingLength:=Header.paddingLength;
   Getmem(ResRecord,BytesRead+ContentLength+PaddingLength);
-  PFCGI_Header(ResRecord)^:=Header;
-  ReadBuf:=ResRecord+BytesRead;
-  BytesRead:=ReadBytes(ReadBuf,ContentLength);
-  ReadBuf:=ReadBuf+BytesRead;
-  BytesRead:=ReadBytes(ReadBuf,PaddingLength);
-  Result := ResRecord;
-{
-  Writeln('Dumping record ', Sizeof(Header),',',Contentlength,',',PaddingLength);
-  For I:=0 to Sizeof(Header)+ContentLength+PaddingLength-1 do
+  try
+    PFCGI_Header(ResRecord)^:=Header;
+    ReadBuf:=ResRecord+BytesRead;
+    BytesRead:=ReadBytes(ReadBuf,ContentLength);
+    If (BytesRead=0) then
+      begin
+      FreeMem(resRecord);
+      Exit // Connection closed gracefully.
+      // TODO : properly handle connection close
+      end;
+    ReadBuf:=ReadBuf+BytesRead;
+    BytesRead:=ReadBytes(ReadBuf,PaddingLength);
+    If (BytesRead=0) then
+      begin
+      FreeMem(resRecord);
+      Exit // Connection closed gracefully.
+      // TODO : properly handle connection close
+      end;
+    Result := ResRecord;
+  except
+    FreeMem(resRecord);
+    Raise;
+  end;
+end;
+
+procedure TFCgiHandler.SetupSocket(var IAddress : TInetSockAddr; Var AddressLength : tsocklen);
+
+begin
+  AddressLength:=Sizeof(IAddress);
+  Socket := fpsocket(AF_INET,SOCK_STREAM,0);
+  if Socket=-1 then
+    raise EFPWebError.CreateFmt(SNoSocket,[socketerror]);
+  IAddress.sin_family:=AF_INET;
+  IAddress.sin_port:=htons(Port);
+  if FAddress<>'' then
+    Iaddress.sin_addr := StrToHostAddr(FAddress)
+  else
+    IAddress.sin_addr.s_addr:=0;
+  if fpbind(Socket,@IAddress,AddressLength)=-1 then
+    begin
+    CloseSocket(socket);
+    Socket:=0;
+    Terminate;
+    raise Exception.CreateFmt(SBindFailed,[port,socketerror]);
+    end;
+  if fplisten(Socket,1)=-1 then
+    begin
+    CloseSocket(socket);
+    Socket:=0;
+    Terminate;
+    raise Exception.CreateFmt(SListenFailed,[port,socketerror]);
+    end;
+end;
+
+function TFCgiHandler.ProcessRecord(AFCGI_Record  : PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean;
+
+var
+  ARequestID    : word;
+  ATempRequest  : TFCGIRequest;
+begin
+  Result:=False;
+  ARequestID:=BEtoN(AFCGI_Record^.requestID);
+  if AFCGI_Record^.reqtype = FCGI_BEGIN_REQUEST then
+    begin
+    if ARequestID>FRequestsAvail then
+      begin
+      inc(FRequestsAvail,10);
+      SetLength(FRequestsArray,FRequestsAvail);
+      end;
+    assert(not assigned(FRequestsArray[ARequestID].Request));
+    assert(not assigned(FRequestsArray[ARequestID].Response));
+    ATempRequest:=TFCGIRequest.Create;
+    ATempRequest.RequestID:=ARequestID;
+    ATempRequest.Handle:=FHandle;
+    ATempRequest.ProtocolOptions:=Self.Protocoloptions;
+    ATempRequest.OnUnknownRecord:=Self.OnUnknownRecord;
+    FRequestsArray[ARequestID].Request := ATempRequest;
+    end;
+  if (ARequestID>FRequestsAvail) then
+    begin
+    // TODO : ARequestID can be invalid. What to do ?
+    // in each case not try to access the array with requests.
+    end
+  else if FRequestsArray[ARequestID].Request.ProcessFCGIRecord(AFCGI_Record) then
     begin
-    Write(Format('%:3d ',[PByte(ResRecord)[i]]));
-    If PByte(ResRecord)[i]>30 then
-      S:=S+char(PByte(ResRecord)[i]);
-    if (I mod 16) = 0 then
-       begin
-       writeln('  ',S);
-       S:='';
-       end;
+    ARequest:=FRequestsArray[ARequestID].Request;
+    FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
+    FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
+    AResponse:=FRequestsArray[ARequestID].Response;
+    Result := True;
     end;
-  Writeln('  ',S)
-}
 end;
 
 function TFCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+
 var
   IAddress      : TInetSockAddr;
   AddressLength : tsocklen;
-  ARequestID    : word;
   AFCGI_Record  : PFCGI_Header;
-  ATempRequest  : TFCGIRequest;
 
 begin
   Result := False;
-  AddressLength:=Sizeof(IAddress);
-
   if Socket=0 then
-    begin
     if Port<>0 then
-      begin
-      Socket := fpsocket(AF_INET,SOCK_STREAM,0);
-      if Socket=-1 then
-        raise EFPWebError.CreateFmt(SNoSocket,[socketerror]);
-      IAddress.sin_family:=AF_INET;
-      IAddress.sin_port:=htons(Port);
-      if FAddress<>'' then
-        Iaddress.sin_addr := StrToHostAddr(FAddress)
-      else
-        IAddress.sin_addr.s_addr:=0;
-      if fpbind(Socket,@IAddress,AddressLength)=-1 then
-        begin
-        CloseSocket(socket);
-        Socket:=0;
-        raise Exception.CreateFmt(SBindFailed,[port,socketerror]);
-        end;
-      if fplisten(Socket,1)=-1 then
-        begin
-        CloseSocket(socket);
-        Socket:=0;
-        raise Exception.CreateFmt(SListenFailed,[port,socketerror]);
-        end;
-      end
+      SetupSocket(IAddress,AddressLength)
     else
       Socket:=StdInputHandle;
-    end;
-
   if FHandle=THandle(-1) then
     begin
     FHandle:=fpaccept(Socket,psockaddr(@IAddress),@AddressLength);
     if FHandle=THandle(-1) then
+      begin
+      Terminate;
       raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
+      end;
     end;
-
   repeat
-  AFCGI_Record:=Read_FCGIRecord;
-  if assigned(AFCGI_Record) then
+    AFCGI_Record:=Read_FCGIRecord;
+    if assigned(AFCGI_Record) then
     try
-      ARequestID:=BEtoN(AFCGI_Record^.requestID);
-      if AFCGI_Record^.reqtype = FCGI_BEGIN_REQUEST then
-        begin
-        if ARequestID>FRequestsAvail then
-          begin
-          inc(FRequestsAvail,10);
-          SetLength(FRequestsArray,FRequestsAvail);
-          end;
-        assert(not assigned(FRequestsArray[ARequestID].Request));
-        assert(not assigned(FRequestsArray[ARequestID].Response));
-
-        ATempRequest:=TFCGIRequest.Create;
-        ATempRequest.RequestID:=ARequestID;
-        ATempRequest.Handle:=FHandle;
-        ATempRequest.ProtocolOptions:=Self.Protocoloptions;
-        ATempRequest.OnUnknownRecord:=Self.OnUnknownRecord;
-        FRequestsArray[ARequestID].Request := ATempRequest;
-        end;
-      if FRequestsArray[ARequestID].Request.ProcessFCGIRecord(AFCGI_Record) then
-        begin
-        ARequest:=FRequestsArray[ARequestID].Request;
-        FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
-        FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
-        AResponse:=FRequestsArray[ARequestID].Response;
-        Result := True;
-        Break;
-        end;
+      Result:=ProcessRecord(AFCGI_Record,ARequest,AResponse);
     Finally
       FreeMem(AFCGI_Record);
       AFCGI_Record:=Nil;
     end;
-  until (1<>1);
+  until Result;
 end;
 
 { TCustomFCgiApplication }

packages/fcl-web/src/base/websession.pp

@@ -332,6 +332,7 @@ begin
       begin
 {$ifdef cgidebug}SendDebug('Getting default session');{$endif}
       FSession:=GetDefaultSession;
+      FSession.FreeNotification(Self);
       end;
     Result:=FSession
     end;

packages/fcl-web/src/webdata/fpwebdata.pp

@@ -1663,6 +1663,7 @@ begin
       Exit;
       end;
     end;
+  P:=Nil;
   C:=FindComponent(AProviderName);
   {$ifdef wmdebug}SendDebug(Format('Searching provider "%s" 1 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif}
   If (C<>Nil) and (C is TFPCustomWebDataProvider) then
@@ -1675,7 +1676,9 @@ begin
       begin
       {$ifdef wmdebug}SendDebug(Format('Found providerdef "%s" 1 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif}
       P:=WebDataProviderManager.GetProvider(ADef,Self,AContainer);
-      end;
+      end
+    else
+      P:=Nil;
     end;
   {$ifdef wmdebug}SendDebug(Format('Searching provider "%s" 2 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif}
   Result:=P;

packages/fcl-web/src/webdata/sqldbwebdata.pp

@@ -44,6 +44,7 @@ Type
     Procedure DoApplyParams; override;
     Function SQLQuery : TSQLQuery;
     Function GetDataset : TDataset; override;
+    Function DoGetNewID : String; virtual;
     Function GetNewID : String;
     Function IDFieldValue : String; override;
     procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
@@ -273,7 +274,12 @@ Var
 
 begin
   ft:=GetParamtype(P,AValue);
-  If ft<>ftUnknown then
+  If (AValue='') and (not (ft in [ftString,ftFixedChar,ftWideString,ftFixedWideChar])) then
+    begin
+    P.Clear;
+    exit;
+    end;
+  If (ft<>ftUnknown) then
     begin
     try
       case ft of
@@ -358,7 +364,10 @@ begin
     if not B then
       begin
       If (P.Name=IDFieldName) and DoNewID then
-        SetTypedParam(P,GetNewID)
+        begin
+        GetNewID;
+        SetTypedParam(P,FLastNewID)
+        end
       else If Adaptor.TryFieldValue(P.Name,S) then
         SetTypedParam(P,S)
       else If Adaptor.TryParamValue(P.Name,S) then
@@ -394,12 +403,17 @@ begin
 {$ifdef wmdebug}SendDebug('Get dataset: done');{$endif}
 end;
 
-function TCustomSQLDBWebDataProvider.GetNewID: String;
-
+function TCustomSQLDBWebDataProvider.DoGetNewID: String;
 begin
   If Not Assigned(FOnGetNewID) then
     Raise EFPHTTPError.CreateFmt(SErrNoNewIDEvent,[Self.Name]);
   FOnGetNewID(Self,Result);
+end;
+
+function TCustomSQLDBWebDataProvider.GetNewID: String;
+
+begin
+  Result:=DoGetNewID;
   FLastNewID:=Result;
 end;
 

packages/fcl-xml/src/sax_html.pp

@@ -429,6 +429,18 @@ begin
   WStrLower(result);
 end;
 
+function RightTrimmedLength(const s: SAXString): Integer;
+begin
+  result := Length(s);
+  while IsXmlWhitespace(s[result]) do Dec(result);
+end;
+
+function TagPos(elTag: THTMLElementTag; s: SAXString): Integer;
+begin
+  WStrLower(s);
+  Result := Pos(HTMLElementProps[elTag].Name, s);
+end;
+
 procedure THTMLReader.EnterNewScannerContext(NewContext: THTMLScannerContext);
 var
   Attr: TSAXAttributes;
@@ -455,45 +467,60 @@ begin
     scTag:
       if Length(TokenText) > 0 then
       begin
-        Attr := nil;
-        if TokenText[Length(fTokenText)]='/' then  // handle xml/xhtml style empty tag
+        { ignore possibly unescaped markup in SCRIPT and STYLE }
+        if (FNesting > 0) and (FStack[FNesting-1] in [etScript,etStyle]) and
+          not (
+           (TokenText[1] = '/') and
+           (RightTrimmedLength(TokenText)=Length(HTMLElementProps[FStack[FNesting-1]].Name)+1) and
+           (TagPos(FStack[FNesting-1], TokenText) = 2)
+          )
+          and (TokenText[1] <> '!') then
         begin
-          setlength(fTokenText,length(fTokenText)-1);
-          // Do NOT combine to a single line, as Attr is an output value!
-          TagName := SplitTagString(TokenText, Attr);
-          AutoClose(TagName);
-          DoStartElement('', TagName, '', Attr);
-          DoEndElement('', TagName, '');
+          FTokenText := '<'+FTokenText+'>';
+          DoCharacters(PSAXChar(TokenText), 0, Length(TokenText));
         end
-        else if TokenText[1] = '/' then
+        else
         begin
-          Delete(FTokenText, 1, 1);
-          TagName := SplitTagString(TokenText, Attr);
-          elTag := LookupTag(TagName);
-          i := FNesting-1;
-          while (i >= 0) and (FStack[i] <> elTag) and
-            (efEndTagOptional in HTMLElementProps[FStack[i]].Flags) do
-            Dec(i);
-          if (i>=0) and (FStack[i] = elTag) then
-            while FStack[FNesting-1] <> elTag do
-            begin
-              DoEndElement('', HTMLElementProps[FStack[FNesting-1]].Name, '');
-              namePop;
-            end;
+          Attr := nil;
+          if TokenText[Length(fTokenText)]='/' then  // handle xml/xhtml style empty tag
+          begin
+            setlength(fTokenText,length(fTokenText)-1);
+            // Do NOT combine to a single line, as Attr is an output value!
+            TagName := SplitTagString(TokenText, Attr);
+            AutoClose(TagName);
+            DoStartElement('', TagName, '', Attr);
+            DoEndElement('', TagName, '');
+          end
+          else if TokenText[1] = '/' then
+          begin
+            Delete(FTokenText, 1, 1);
+            TagName := SplitTagString(TokenText, Attr);
+            elTag := LookupTag(TagName);
+            i := FNesting-1;
+            while (i >= 0) and (FStack[i] <> elTag) and
+              (efEndTagOptional in HTMLElementProps[FStack[i]].Flags) do
+              Dec(i);
+            if (i>=0) and (FStack[i] = elTag) then
+              while FStack[FNesting-1] <> elTag do
+              begin
+                DoEndElement('', HTMLElementProps[FStack[FNesting-1]].Name, '');
+                namePop;
+              end;
 
-          DoEndElement('', TagName, '');
-          namePop;
-        end
-        else if TokenText[1] <> '!' then
-        begin
-          // Do NOT combine to a single line, as Attr is an output value!
-          TagName := SplitTagString(TokenText, Attr);
-          AutoClose(TagName);
-          namePush(TagName);
-          DoStartElement('', TagName, '', Attr);
+            DoEndElement('', TagName, '');
+            namePop;
+          end
+          else if TokenText[1] <> '!' then
+          begin
+            // Do NOT combine to a single line, as Attr is an output value!
+            TagName := SplitTagString(TokenText, Attr);
+            AutoClose(TagName);
+            namePush(TagName);
+            DoStartElement('', TagName, '', Attr);
+          end;
+          if Assigned(Attr) then
+            Attr.Free;
         end;
-        if Assigned(Attr) then
-          Attr.Free;
       end;
   end;
   FScannerContext := NewContext;

packages/fcl-xml/src/xmlread.pp

@@ -249,12 +249,13 @@ type
     FElementDef: TElementDecl;
     FCurCP: TContentParticle;
     FFailed: Boolean;
+    FSaViolation: Boolean;
+    FContentType: TElementContentType;       // =ctAny when FElementDef is nil
     function IsElementAllowed(Def: TElementDecl): Boolean;
     function Incomplete: Boolean;
   end;
 
   TNodeDataDynArray = array of TNodeData;
-  TDOMNodeDynArray = array of TDOMNode_WithChildren;
   TValidatorDynArray = array of TElementValidator;
 
   TXMLReadState = (rsProlog, rsDTD, rsAfterDTD, rsRoot, rsEpilog);
@@ -280,19 +281,16 @@ type
     FEntityValue: TWideCharBuf;
     FName: TWideCharBuf;
     FTokenStart: TLocation;
-    FStandalone: Boolean;          // property of Doc ?
+    FStandalone: Boolean;
     FNamePages: PByteArray;
     FDocType: TDTDModel;
     FPEMap: THashTable;
     FForwardRefs: TFPList;
-    FCurrContentType: TElementContentType;
-    FSaViolation: Boolean;
     FDTDStartPos: PWideChar;
     FIntSubset: TWideCharBuf;
     FAttrTag: Cardinal;
     FDTDProcessed: Boolean;
     FFragmentMode: Boolean;
-    FToken: TXMLToken;
     FNext: TXMLToken;
     FCurrEntity: TEntityDecl;
     FIDMap: THashTable;
@@ -336,7 +334,7 @@ type
     function  SkipUntilSeq(const Delim: TSetOfChar; c1: WideChar; c2: WideChar = #0): Boolean;
     procedure CheckMaxChars(ToAdd: Cardinal);
     function AllocNodeData(AIndex: Integer): PNodeData;
-    function AllocAttributeData(AName: PHashItem): PNodeData;
+    function AllocAttributeData: PNodeData;
     function AllocAttributeValueChunk(APrev: PNodeData): PNodeData;
     procedure CleanupAttribute(aNode: PNodeData);
     procedure CleanupAttributes;
@@ -349,7 +347,7 @@ type
     FPrefixedAttrs: Integer;
     FSpecifiedAttrs: Integer;
     FNodeStack: TNodeDataDynArray;
-    FCursorStack: TDOMNodeDynArray;
+    FValidatorNesting: Integer;
     FValidators: TValidatorDynArray;
     FAttrChunks: TFPList;
     FFreeAttrChunk: PNodeData;
@@ -376,23 +374,23 @@ type
     function  ExpectName: WideString;                                   // [5]
     function ParseLiteral(var ToFill: TWideCharBuf; aType: TLiteralType;
       Required: Boolean): Boolean;
-    function ExpectAttValue(attrData: PNodeData; NonCDATA: Boolean): Boolean; // [10]
+    procedure ExpectAttValue(attrData: PNodeData; NonCDATA: Boolean);   // [10]
     procedure ParseComment(discard: Boolean);                           // [15]
     procedure ParsePI;                                                  // [16]
-    procedure CreatePINode;
+    function CreatePINode: TDOMNode;
     procedure ParseXmlOrTextDecl(TextDecl: Boolean);
     procedure ExpectEq;
     procedure ParseDoctypeDecl;                                         // [28]
     procedure ParseMarkupDecl;                                          // [29]
     procedure ParseStartTag;                                            // [39]
     procedure ParseEndTag;                                              // [42]
-    procedure DoStartElement;
+    function DoStartElement: TDOMElement;
     procedure HandleEntityStart;
     procedure HandleEntityEnd;
     procedure ResolveEntity;
     procedure DoStartEntity;
     procedure ParseAttribute(ElDef: TElementDecl);
-    procedure ParseContent;                                             // [43]
+    procedure ParseContent(parent: TDOMNode_WithChildren);              // [43]
     function  Read: Boolean;
     function  ResolvePredefined: Boolean;
     function  EntityCheck(NoExternals: Boolean = False): TEntityDecl;
@@ -406,7 +404,7 @@ type
     procedure BadPENesting(S: TErrorSeverity = esError);
     procedure ParseEntityDecl;
     procedure ParseAttlistDecl;
-    procedure ExpectChoiceOrSeq(CP: TContentParticle);
+    procedure ExpectChoiceOrSeq(CP: TContentParticle; MustEndIn: TObject);
     procedure ParseElementDecl;
     procedure ParseNotationDecl;
     function ResolveResource(const ASystemID, APublicID, ABaseURI: WideString; out Source: TXMLCharSource): Boolean;
@@ -416,19 +414,14 @@ type
 
     procedure PushVC(aElDef: TElementDecl);
     procedure PopVC;
-    procedure UpdateConstraints;
     procedure ValidateDTD;
     procedure ValidateCurrentNode;
     procedure ValidationError(const Msg: string; const args: array of const; LineOffs: Integer = -1);
     procedure ValidationErrorWithName(const Msg: string; LineOffs: Integer = -1);
     procedure DTDReloadHook;
     procedure ConvertSource(SrcIn: TXMLInputSource; out SrcOut: TXMLCharSource);
-    // Some SAX-alike stuff (at a very early stage)
-    procedure DoText(ch: PWideChar; Count: Integer; Whitespace: Boolean=False);
-    procedure DoComment(ch: PWideChar; Count: Integer);
-    procedure DoCDSect(ch: PWideChar; Count: Integer);
+    function DoCDSect(ch: PWideChar; Count: Integer): TDOMNode;
     procedure DoNotationDecl(const aName, aPubID, aSysID: WideString);
-    procedure DoEntityReference;
   public
     doc: TDOMDocument;
     constructor Create; overload;
@@ -1249,7 +1242,6 @@ begin
   FNamePages := @NamePages;
   SetLength(FNodeStack, 16);
   SetLength(FValidators, 16);
-  SetLength(FCursorStack, 16);
 end;
 
 constructor TXMLReader.Create(AParser: TDOMParser);
@@ -1324,15 +1316,16 @@ begin
   FNameTable := doc.Names;
   FState := rsProlog;
   FNesting := 0;
+  FValidatorNesting := 0;
   FCurrNode := @FNodeStack[0];
-  FCursorStack[0] := doc;
   FFragmentMode := False;
   NSPrepare;
   Initialize(ASource);
   if FSource.FXMLVersion <> xmlVersionUnknown then
     TDOMTopNodeEx(TDOMNode(doc)).FXMLVersion := FSource.FXMLVersion;
   TDOMTopNodeEx(TDOMNode(doc)).FXMLEncoding := FSource.FXMLEncoding;
-  ParseContent;
+  FNext := xtText;
+  ParseContent(doc);
 
   if FState < rsRoot then
     FatalError('Root element is missing');
@@ -1352,13 +1345,14 @@ begin
   FNameTable := doc.Names;
   FState := rsRoot;
   FNesting := 0;
+  FValidatorNesting := 0;
   FCurrNode := @FNodeStack[0];
-  FCursorStack[0] := AOwner as TDOMNode_WithChildren;
   FFragmentMode := True;
-  FXML11 := doc.InheritsFrom(TXMLDocument) and (TXMLDocument(doc).XMLVersion = '1.1');
+  FXML11 := doc.XMLVersion = '1.1';
   NSPrepare;
   Initialize(ASource);
-  // See comment in EntityCheck()
+  { Get doctype from the owner's document, but only if it is not already assigned
+   (It is set directly when parsing children of an Entity, see LoadEntity procedure) }
   if FDocType = nil then
   begin
     DoctypeNode := TDOMDocumentTypeEx(doc.DocType);
@@ -1370,7 +1364,8 @@ begin
     TDOMTopNodeEx(AOwner).FXMLVersion := FSource.FXMLVersion;
     TDOMTopNodeEx(AOwner).FXMLEncoding := FSource.FXMLEncoding;
   end;
-  ParseContent;
+  FNext := xtText;
+  ParseContent(aOwner as TDOMNode_WithChildren);
 end;
 
 function TXMLReader.CheckName(aFlags: TCheckNameFlags): Boolean;
@@ -1563,9 +1558,9 @@ const
 { Parse attribute literal, producing plain string value in AttrData.FValueStr.
   If entity references are encountered and FExpandEntities=False, also builds
   a node chain starting from AttrData.FNext. Node chain is built only for the
-  first level. If NonCDATA=True, additionally normalizes whitespace in string value.
-  Returns True if value actually needed normalization }
-function TXMLReader.ExpectAttValue(AttrData: PNodeData; NonCDATA: Boolean): Boolean;
+  first level. If NonCDATA=True, additionally normalizes whitespace in string value. }
+
+procedure TXMLReader.ExpectAttValue(AttrData: PNodeData; NonCDATA: Boolean);
 var
   wc: WideChar;
   Delim: WideChar;
@@ -1637,9 +1632,9 @@ begin
     end;
   end;
   if nonCDATA then
-    BufNormalize(FValue, Result)
+    BufNormalize(FValue, attrData^.FDenormalized)
   else
-    Result := False;
+    attrData^.FDenormalized := False;
   SetString(attrData^.FValueStr, FValue.Buffer, FValue.Length);
 end;
 
@@ -1740,14 +1735,8 @@ begin
     FatalError('External entity reference is not allowed in attribute value', cnt);
 
   if not Result.FResolved then
-  begin
-    // To build children of the entity itself, we must parse it "out of context"
-    // However, care must be taken to properly pass the DTD to InnerReader.
-    // We now have doc.DocumentType=nil while DTD is being parsed,
-    // which can break parsing 2+ level entities in default attribute values.
-
     LoadEntity(Result);
-  end;
+
   // at this point we know the charcount of the entity being included
   if Result.FCharCount >= cnt then
     CheckMaxChars(Result.FCharCount - cnt);
@@ -1930,17 +1919,13 @@ begin
     FNameTable.FindOrAdd(FName.Buffer, FName.Length));
 end;
 
-procedure TXMLReader.CreatePINode;
+function TXMLReader.CreatePINode: TDOMNode;
 var
   NameStr, ValueStr: WideString;
-  PINode: TDOMProcessingInstruction;
 begin
   SetString(NameStr, FName.Buffer, FName.Length);
   SetString(ValueStr, FValue.Buffer, FValue.Length);
-  // SAX: ContentHandler.ProcessingInstruction(Name, Value);
-
-  PINode := Doc.CreateProcessingInstruction(NameStr, ValueStr);
-  FCursorStack[FNesting].InternalAppend(PINode);
+  result := Doc.CreateProcessingInstruction(NameStr, ValueStr);
 end;
 
 const
@@ -2158,10 +2143,9 @@ begin
   end;
 end;
 
-procedure TXMLReader.ExpectChoiceOrSeq(CP: TContentParticle);                  // [49], [50]
+procedure TXMLReader.ExpectChoiceOrSeq(CP: TContentParticle; MustEndIn: TObject);     // [49], [50]
 var
   Delim: WideChar;
-  CurrentEntity: TObject;
   CurrentCP: TContentParticle;
 begin
   Delim := #0;
@@ -2169,13 +2153,7 @@ begin
     CurrentCP := CP.Add;
     SkipWhitespace;
     if CheckForChar('(') then
-    begin
-      CurrentEntity := FSource.FEntity;
-      ExpectChoiceOrSeq(CurrentCP);
-      if CurrentEntity <> FSource.FEntity then
-        BadPENesting;
-      FSource.NextChar;
-    end
+      ExpectChoiceOrSeq(CurrentCP, FSource.FEntity)
     else
       CurrentCP.Def := FindOrCreateElDef;
 
@@ -2195,6 +2173,10 @@ begin
         FatalError(Delim);
     FSource.NextChar; // skip delimiter
   until False;
+  if MustEndIn <> FSource.FEntity then
+    BadPENesting;
+  FSource.NextChar;
+
   if Delim = '|' then
     CP.CPType := ctChoice
   else
@@ -2259,10 +2241,7 @@ begin
       else       // Children section [47]
       begin
         Typ := ctChildren;
-        ExpectChoiceOrSeq(CP);
-        if CurrentEntity <> FSource.FEntity then
-          BadPENesting;
-        FSource.NextChar;
+        ExpectChoiceOrSeq(CP, CurrentEntity);
         CP.CPQuant := ParseQuantity;
       end;
     except
@@ -2551,7 +2530,7 @@ begin
     if FSource.FBuf^ = '?' then
     begin
       ParsePI;
-      CreatePINode;
+      doc.AppendChild(CreatePINode);
     end
     else
     begin
@@ -2678,11 +2657,13 @@ end;
 procedure TXMLReader.ValidateCurrentNode;
 var
   ElDef: TElementDecl;
+  AttDef: TAttributeDef;
+  attr: PNodeData;
+  i: Integer;
 begin
   case FCurrNode^.FNodeType of
     ntElement:
       begin
-        { TODO: pushing *validation* context must be moved here }
         if (FNesting = 1) and (not FFragmentMode) then
         begin
           if Assigned(FDocType) then
@@ -2697,38 +2678,71 @@ begin
         if (ElDef = nil) or (ElDef.ContentType = ctUndeclared) then
           DoErrorPos(esError, 'Using undeclared element ''%s''',[FCurrNode^.FQName^.Key], FCurrNode^.FLoc);
 
-        if not FValidators[FNesting-1].IsElementAllowed(ElDef) then
+        if not FValidators[FValidatorNesting].IsElementAllowed(ElDef) then
           DoErrorPos(esError, 'Element ''%s'' is not allowed in this context',[FCurrNode^.FQName^.Key], FCurrNode^.FLoc);
+
+        PushVC(ElDef);
+
+        { Validate attributes }
+        for i := 1 to FAttrCount do
+        begin
+          attr := @FNodeStack[FNesting+i];
+          AttDef := TAttributeDef(attr^.FTypeInfo);
+          if AttDef = nil then
+            DoErrorPos(esError, 'Using undeclared attribute ''%s'' on element ''%s''',
+              [attr^.FQName^.Key, FCurrNode^.FQName^.Key], attr^.FLoc)
+          else if ((AttDef.DataType <> dtCdata) or (AttDef.Default = adFixed)) then
+          begin
+            if FStandalone and AttDef.ExternallyDeclared then
+              { TODO: perhaps should use different and more descriptive messages }
+              if attr^.FDenormalized then
+                DoErrorPos(esError, 'Standalone constraint violation', attr^.FLoc2)
+              else if i > FSpecifiedAttrs then
+                DoError(esError, 'Standalone constraint violation');
+
+            // TODO: what about normalization of AttDef.Value? (Currently it IS normalized)
+            if (AttDef.Default = adFixed) and (AttDef.Data^.FValueStr <> attr^.FValueStr) then
+              DoErrorPos(esError, 'Value of attribute ''%s'' does not match its #FIXED default',[attr^.FQName^.Key], attr^.FLoc2);
+            if not ValidateAttrSyntax(AttDef, attr^.FValueStr) then
+              DoErrorPos(esError, 'Attribute ''%s'' type mismatch', [attr^.FQName^.Key], attr^.FLoc2);
+            ValidateAttrValue(AttDef, attr);
+          end;
+        end;
       end;
 
     ntEndElement:
       begin
-        if FValidators[FNesting].Incomplete then
+        if FValidators[FValidatorNesting].Incomplete then
           ValidationError('Element ''%s'' is missing required sub-elements', [FCurrNode^.FQName^.Key], -1);
+        if FValidatorNesting > 0 then
+          Dec(FValidatorNesting);
       end;
 
-    ntText, ntWhitespace:
-      case FCurrContentType of
+    ntText, ntSignificantWhitespace:
+      case FValidators[FValidatorNesting].FContentType of
         ctChildren:
           if FCurrNode^.FNodeType = ntText then
             ValidationError('Character data is not allowed in element-only content',[])
           else
-            if FSaViolation then
+          begin
+            if FValidators[FValidatorNesting].FSaViolation then
               StandaloneError(-1);
+            FCurrNode^.FNodeType := ntWhitespace;
+          end;
         ctEmpty:
           ValidationError('Character data is not allowed in EMPTY elements', []);
       end;
 
     ntCDATA:
-      if FCurrContentType = ctChildren then
+      if FValidators[FValidatorNesting].FContentType = ctChildren then
         ValidationError('CDATA sections are not allowed in element-only content',[]);
 
     ntProcessingInstruction:
-      if FCurrContentType = ctEmpty then
+      if FValidators[FValidatorNesting].FContentType = ctEmpty then
         ValidationError('Processing instructions are not allowed within EMPTY elements', []);
 
     ntComment:
-      if FCurrContentType = ctEmpty then
+      if FValidators[FValidatorNesting].FContentType = ctEmpty then
         ValidationError('Comments are not allowed within EMPTY elements', []);
 
     ntDocumentType:
@@ -2736,11 +2750,6 @@ begin
   end;
 end;
 
-procedure TXMLReader.DoEntityReference;
-begin
-  FCursorStack[FNesting].AppendChild(doc.CreateEntityReference(FCurrNode^.FQName^.Key));
-end;
-
 procedure TXMLReader.HandleEntityStart;
 begin
   { FNesting+1 is available due to overallocation in AllocNodeData() }
@@ -2753,13 +2762,12 @@ end;
 
 procedure TXMLReader.HandleEntityEnd;
 begin
-  FValidators[FNesting-1] := FValidators[FNesting];
-  FCursorStack[FNesting-1] := FCursorStack[FNesting];
   ContextPop(True);
-  PopVC;
+  if FNesting > 0 then Dec(FNesting);
   FCurrNode := @FNodeStack[FNesting+1];
   FCurrNode^.FNodeType := ntEndEntity;
   // TODO: other properties of FCurrNode
+  FNext := xtText;
 end;
 
 procedure TXMLReader.ResolveEntity;
@@ -2776,7 +2784,8 @@ procedure TXMLReader.DoStartEntity;
 var
   src: TXMLCharSource;
 begin
-  PushVC(nil);
+  Inc(FNesting);
+  FCurrNode := AllocNodeData(FNesting);
   if Assigned(FCurrEntity) then
     ContextPush(FCurrEntity)
   else
@@ -2786,34 +2795,26 @@ begin
     src.Kind := skManualPop;
     Initialize(src);
   end;
-
-  { Compensate for an extra entry in node stack }
-  FValidators[FNesting] := FValidators[FNesting-1];
-  FCursorStack[FNesting] := FCursorStack[FNesting-1];
-  UpdateConstraints;
   FNext := xtText;
 end;
 
-procedure TXMLReader.DoStartElement;
+function TXMLReader.DoStartElement: TDOMElement;
 var
-  NewElem: TDOMElement;
   Attr: TDOMAttr;
   i: Integer;
 begin
   with FCurrNode^.FQName^ do
-    NewElem := doc.CreateElementBuf(PWideChar(Key), Length(Key));
-  FCursorStack[FNesting-1].InternalAppend(NewElem);
-  FCursorStack[FNesting] := NewElem;
+    Result := doc.CreateElementBuf(PWideChar(Key), Length(Key));
   if Assigned(FCurrNode^.FNsUri) then
-    NewElem.SetNSI(FCurrNode^.FNsUri^.Key, FCurrNode^.FColonPos+1);
+    Result.SetNSI(FCurrNode^.FNsUri^.Key, FCurrNode^.FColonPos+1);
 
   for i := 1 to FAttrCount do
   begin
     Attr := LoadAttribute(doc, @FNodeStack[FNesting+i]);
-    NewElem.SetAttributeNode(Attr);
+    Result.SetAttributeNode(Attr);
     // Attach element to ID map entry if necessary
     if Assigned(FNodeStack[FNesting+i].FIDEntry) then
-      FNodeStack[FNesting+i].FIDEntry^.Data := NewElem;
+      FNodeStack[FNesting+i].FIDEntry^.Data := Result;
   end;
 end;
 
@@ -2866,37 +2867,55 @@ const
   );
 
   textNodeTypes: array[Boolean] of TXMLNodeType = (
-    ntWhitespace,
+    ntSignificantWhitespace,
     ntText
   );
 
-procedure TXMLReader.ParseContent;
+procedure TXMLReader.ParseContent(parent: TDOMNode_WithChildren);
+var
+  cursor: TDOMNode_WithChildren;
+  element: TDOMElement;
 begin
-  FNext := xtText;
+  cursor := parent;
   while Read do
   begin
     if FValidate then
       ValidateCurrentNode;
+
     case FCurrNode^.FNodeType of
-      ntText, ntWhitespace:
-        DoText(FValue.Buffer, FValue.Length, FCurrNode^.FNodeType = ntWhitespace);
+      ntText:
+        cursor.InternalAppend(doc.CreateTextNodeBuf(FValue.Buffer, FValue.Length, False));
+
+      ntWhitespace, ntSignificantWhitespace:
+        if FPreserveWhitespace then
+          cursor.InternalAppend(doc.CreateTextNodeBuf(FValue.Buffer, FValue.Length, FCurrNode^.FNodeType = ntWhitespace));
+
       ntCDATA:
-        DoCDSect(FValue.Buffer, FValue.Length);
+        cursor.InternalAppend(DoCDSect(FValue.Buffer, FValue.Length));
+
       ntProcessingInstruction:
-        CreatePINode;
+        cursor.InternalAppend(CreatePINode);
+
       ntComment:
-        DoComment(FCurrNode^.FValueStart, FCurrNode^.FValueLength);
+        if not FIgnoreComments then
+          cursor.InternalAppend(doc.CreateCommentBuf(FCurrNode^.FValueStart, FCurrNode^.FValueLength));
+
       ntElement:
-        DoStartElement;
-      ntEndElement:
-        ;
-      ntDocumentType:
         begin
-          if not FCanonical then
-            doc.AppendChild(TDOMDocumentType.Create(doc, FDocType));
+          element := DoStartElement;
+          cursor.InternalAppend(element);
+          cursor := element;
         end;
+
+      ntEndElement:
+          cursor := TDOMNode_WithChildren(cursor.ParentNode);
+
+      ntDocumentType:
+        if not FCanonical then
+          cursor.InternalAppend(TDOMDocumentType.Create(doc, FDocType));
+
       ntEntityReference:
-        DoEntityReference;
+        cursor.InternalAppend(doc.CreateEntityReference(FCurrNode^.FQName^.Key));
     end;
   end;
 end;
@@ -2911,7 +2930,6 @@ begin
   if FNext = xtPopEmptyElement then
   begin
     FNext := xtPopElement;
-    FToken := xtEndElement;
     FCurrNode^.FNodeType := ntEndElement;
     if FAttrCleanupFlag then
       CleanupAttributes;
@@ -3020,7 +3038,6 @@ begin
         if FCDSectionsAsText then
           Continue;
         SetNodeInfoWithValue(ntCDATA);
-        FToken := xtCDSect;
         FNext := xtText;
         Result := True;
         Exit;
@@ -3033,7 +3050,7 @@ begin
       if FState <> rsRoot then
         FatalError('Illegal at document level');
 
-      if FCurrContentType = ctEmpty then
+      if FValidators[FValidatorNesting].FContentType = ctEmpty then
         ValidationError('References are illegal in EMPTY elements', []);
 
       if ParseRef(FValue) or ResolvePredefined then
@@ -3054,8 +3071,13 @@ begin
     end;
     if FValue.Length <> 0 then
     begin
+      if FState <> rsRoot then
+        if nonWs then
+          FatalError('Illegal at document level', -1)
+        else
+          Break;
+
       SetNodeInfoWithValue(textNodeTypes[nonWs]);
-      if nonWs then FToken := xtText else FToken := xtWhitespace;
       FNext := tok;
       Result := True;
       Exit;
@@ -3065,7 +3087,6 @@ begin
   else   // not (FNext in [xtText, xtCDSect])
     tok := FNext;
 
-  FToken := tok;
   FNext := xtText;
 
   case tok of
@@ -3124,8 +3145,9 @@ begin
   FAttrCount := 0;
   FPrefixedAttrs := 0;
   FSpecifiedAttrs := 0;
-  PushVC(ElDef);           // this increases FNesting
 
+  Inc(FNesting);
+  FCurrNode := AllocNodeData(FNesting);
   FCurrNode^.FQName := ElName;
   FCurrNode^.FNodeType := ntElement;
   FCurrNode^.FColonPos := FColonPos;
@@ -3170,10 +3192,7 @@ begin
     begin
       b := TBinding(FCurrNode^.FPrefix^.Data);
       if not (Assigned(b) and (b.uri <> '')) then
-      begin
-        FTokenStart := FCurrNode^.FLoc;
-        FatalError('Unbound element name prefix "%s"', [FCurrNode^.FPrefix^.Key],-1);
-      end;
+        DoErrorPos(esFatal, 'Unbound element name prefix "%s"', [FCurrNode^.FPrefix^.Key],FCurrNode^.FLoc);
       FCurrNode^.FNsUri := FNameTable.FindOrAdd(PWideChar(b.uri), Length(b.uri));
     end
     else
@@ -3226,22 +3245,11 @@ var
   attrData: PNodeData;
   AttDef: TAttributeDef;
   i: Integer;
-  normalized: Boolean;
-
-procedure CheckValue;
-begin
-  // TODO: what about normalization of AttDef.Value? (Currently it IS normalized)
-  if (AttDef.Default = adFixed) and (AttDef.Data^.FValueStr <> attrData^.FValueStr) then
-    ValidationError('Value of attribute ''%s'' does not match its #FIXED default',[attrData^.FQName^.Key], -1);
-  if not ValidateAttrSyntax(AttDef, attrData^.FValueStr) then
-    ValidationError('Attribute ''%s'' type mismatch', [attrData^.FQName^.Key], -1);
-  ValidateAttrValue(AttDef, attrData);
-end;
-
 begin
   CheckName;
   attrName := FNameTable.FindOrAdd(FName.Buffer, FName.Length);
-  attrData := AllocAttributeData(attrName);
+  attrData := AllocAttributeData;
+  attrData^.FQName := attrName;
   attrData^.FColonPos := FColonPos;
   StoreLocation(attrData^.FLoc);
   Dec(attrData^.FLoc.LinePos, FName.Length);
@@ -3250,10 +3258,7 @@ begin
   if Assigned(ElDef) then
   begin
     AttDef := ElDef.GetAttrDef(attrName);
-    if AttDef = nil then
-      ValidationError('Using undeclared attribute ''%s'' on element ''%s''',
-        [attrName^.Key, FNodeStack[FNesting].FQName^.Key], FName.Length)
-    else
+    if Assigned(AttDef) then
       AttDef.Tag := FAttrTag;  // indicates that this one is specified
   end
   else
@@ -3284,15 +3289,9 @@ begin
   end;
 
   ExpectEq;
-  normalized := ExpectAttValue(attrData, Assigned(AttDef) and (AttDef.DataType <> dtCDATA));
+  ExpectAttValue(attrData, Assigned(AttDef) and (AttDef.DataType <> dtCDATA));
+  attrData^.FLoc2 := FTokenStart;
 
-  if Assigned(AttDef) and ((AttDef.DataType <> dtCdata) or (AttDef.Default = adFixed)) then
-  begin
-    if normalized and FStandalone and AttDef.ExternallyDeclared then
-      StandaloneError(-1);
-
-    CheckValue;
-  end;
   if Assigned(attrData^.FNsUri) then
   begin
     if (not AddBinding(attrData)) and FCanonical then
@@ -3348,9 +3347,7 @@ begin
     begin
       case AttDef.Default of
         adDefault, adFixed: begin
-          if FStandalone and AttDef.ExternallyDeclared then
-            StandaloneError;
-          attrData := AllocAttributeData(nil);
+          attrData := AllocAttributeData;
           attrData^ := AttDef.Data^;
           if FCanonical then
             attrData^.FIsDefault := False;
@@ -3396,13 +3393,13 @@ begin
    (nsUri = FStduri_xmlns) then
   begin
     if (Pfx = FStdPrefix_xml) or (Pfx = FStdPrefix_xmlns) then
-      FatalError('Illegal usage of reserved prefix ''%s''', [Pfx^.Key])
+      DoErrorPos(esFatal, 'Illegal usage of reserved prefix ''%s''', [Pfx^.Key], attrData^.FLoc)
     else
-      FatalError('Illegal usage of reserved namespace URI ''%s''', [attrData^.FValueStr]);
+      DoErrorPos(esFatal, 'Illegal usage of reserved namespace URI ''%s''', [attrData^.FValueStr], attrData^.FLoc2);
   end;
 
   if (attrData^.FValueStr = '') and not (FXML11 or (Pfx^.Key = '')) then
-    FatalError('Illegal undefining of namespace');  { position - ? }
+    DoErrorPos(esFatal, 'Illegal undefining of namespace', attrData^.FLoc2);
 
   Result := (Pfx^.Data = nil) or (TBinding(Pfx^.Data).uri <> attrData^.FValueStr);
   if Result then
@@ -3426,10 +3423,7 @@ begin
     Pfx := attrData^.FPrefix;
     b := TBinding(Pfx^.Data);
     if not (Assigned(b) and (b.uri <> '')) then
-    begin
-      FTokenStart := attrData^.FLoc;
-      FatalError('Unbound attribute name prefix "%s"', [Pfx^.Key], -1);
-    end;
+      DoErrorPos(esFatal, 'Unbound attribute name prefix "%s"', [Pfx^.Key], attrData^.FLoc);
 
     { detect duplicates }
     J := attrData^.FColonPos+1;
@@ -3500,7 +3494,7 @@ begin
   case AttrDef.DataType of
     dtId: begin
       if not AddID(attrData) then
-        ValidationError('The ID ''%s'' is not unique', [attrData^.FValueStr], -1);
+        DoErrorPos(esError, 'The ID ''%s'' is not unique', [attrData^.FValueStr], attrData^.FLoc2);
     end;
 
     dtIdRef, dtIdRefs: begin
@@ -3542,42 +3536,15 @@ begin
         DoErrorPos(esError, 'Notation ''%s'' is not declared', [Value], Loc);
 end;
 
-procedure TXMLReader.DoText(ch: PWideChar; Count: Integer; Whitespace: Boolean);
-var
-  TextNode: TDOMText;
-begin
-  if FState <> rsRoot then
-    if not Whitespace then
-      FatalError('Illegal at document level', -1)
-    else
-      Exit;  
-
-  if (Whitespace and (not FPreserveWhitespace)) or (Count = 0) then
-    Exit;
-
-  TextNode := Doc.CreateTextNodeBuf(ch, Count, Whitespace and (FCurrContentType = ctChildren));
-  FCursorStack[FNesting].InternalAppend(TextNode);
-end;
-
-procedure TXMLReader.DoComment(ch: PWideChar; Count: Integer);
-var
-  Node: TDOMComment;
-begin
-  if (not FIgnoreComments) and (FState <> rsDTD) then
-  begin
-    Node := Doc.CreateCommentBuf(ch, Count);
-    FCursorStack[FNesting].InternalAppend(Node);
-  end;
-end;
 
-procedure TXMLReader.DoCDSect(ch: PWideChar; Count: Integer);
+function TXMLReader.DoCDSect(ch: PWideChar; Count: Integer): TDOMNode;
 var
   s: WideString;
 begin
   Assert(not FCDSectionsAsText, 'Should not be called when CDSectionsAsText=True');
 
   SetString(s, ch, Count);
-  FCursorStack[FNesting].InternalAppend(doc.CreateCDATASection(s));
+  result := doc.CreateCDATASection(s);
 end;
 
 procedure TXMLReader.DoNotationDecl(const aName, aPubID, aSysID: WideString);
@@ -3610,14 +3577,10 @@ begin
     aNodeData^.FIDEntry := e;
 end;
 
-function TXMLReader.AllocAttributeData(AName: PHashItem): PNodeData;
+function TXMLReader.AllocAttributeData: PNodeData;
 begin
   Result := AllocNodeData(FNesting + FAttrCount + 1);
   Result^.FNodeType := ntAttribute;
-  Result^.FQName := AName;
-  Result^.FPrefix := nil;
-  Result^.FNsUri := nil;
-  Result^.FIDEntry := nil;
   Result^.FIsDefault := False;
   Inc(FAttrCount);
 end;
@@ -3629,6 +3592,9 @@ begin
     SetLength(FNodeStack, AIndex * 2 + 2);
 
   Result := @FNodeStack[AIndex];
+  Result^.FPrefix := nil;
+  Result^.FNsUri := nil;
+  Result^.FIDEntry := nil;
 end;
 
 function TXMLReader.AllocAttributeValueChunk(APrev: PNodeData): PNodeData;
@@ -3694,22 +3660,23 @@ end;
 
 procedure TXMLReader.PushVC(aElDef: TElementDecl);
 begin
-  Inc(FNesting);
-  FCurrNode := AllocNodeData(FNesting);
-  FCurrNode^.FPrefix := nil;
-  FCurrNode^.FNsUri := nil;
-  FCurrNode^.FIDEntry := nil;
+  Inc(FValidatorNesting);
+  if FValidatorNesting >= Length(FValidators) then
+    SetLength(FValidators, FValidatorNesting * 2);
 
-  if FNesting >= Length(FCursorStack) then
+  with FValidators[FValidatorNesting] do
   begin
-    SetLength(FCursorStack, FNesting * 2);
-    SetLength(FValidators, FNesting * 2);
+    FElementDef := aElDef;
+    FCurCP := nil;
+    FFailed := False;
+    FContentType := ctAny;
+    FSaViolation := False;
+    if Assigned(aElDef) then
+    begin
+      FContentType := aElDef.ContentType;
+      FSaViolation := FStandalone and aElDef.ExternallyDeclared;
+    end;
   end;
-
-  FValidators[FNesting].FElementDef := aElDef;
-  FValidators[FNesting].FCurCP := nil;
-  FValidators[FNesting].FFailed := False;
-  UpdateConstraints;
 end;
 
 procedure TXMLReader.PopVC;
@@ -3718,24 +3685,9 @@ begin
     FState := rsEpilog;
   if FNesting > 0 then Dec(FNesting);
   FCurrNode := @FNodeStack[FNesting];
-  UpdateConstraints;
   FNext := xtText;
 end;
 
-procedure TXMLReader.UpdateConstraints;
-begin
-  if FValidate and Assigned(FValidators[FNesting].FElementDef) then
-  begin
-    FCurrContentType := FValidators[FNesting].FElementDef.ContentType;
-    FSaViolation := FStandalone and (FValidators[FNesting].FElementDef.ExternallyDeclared);
-  end
-  else
-  begin
-    FCurrContentType := ctAny;
-    FSaViolation := False;
-  end;
-end;
-
 { TElementValidator }
 
 function TElementValidator.IsElementAllowed(Def: TElementDecl): Boolean;

packages/fcl-xml/src/xmlutils.pp

@@ -158,6 +158,7 @@ type
     FValueStart: PWideChar;
     FValueLength: Integer;
     FIsDefault: Boolean;
+    FDenormalized: Boolean;        // Whether attribute value changes by normalization
   end;
 
 { TNSSupport provides tracking of prefix-uri pairs and namespace fixup for writer }

packages/fpmkunit/src/fpmkunit.pp

@@ -27,6 +27,14 @@ unit fpmkunit;
 
 Interface
 
+{$IFDEF OS2}
+ {$DEFINE NO_UNIT_PROCESS}
+{$ENDIF OS2}
+
+{$IFDEF GO32V2}
+ {$DEFINE NO_UNIT_PROCESS}
+{$ENDIF GO32V2}
+
 {$ifndef NO_UNIT_PROCESS}
   {$define HAS_UNIT_PROCESS}
 {$endif NO_UNIT_PROCESS}
@@ -1154,6 +1162,7 @@ Const
                                 Helpers
 ****************************************************************************}
 
+{$ifdef HAS_UNIT_PROCESS}
 function ExecuteFPC(Verbose: boolean; const Path: string; const ComLine: string; ConsoleOutput: TMemoryStream): integer;
 var
   P: TProcess;
@@ -1255,6 +1264,7 @@ begin
     P.Free;
   end;
 end;
+{$endif HAS_UNIT_PROCESS}
 
 function ParsecompilerOutput(M: TMemoryStream; Verbose: boolean): string;
 type
@@ -3500,7 +3510,11 @@ begin
       // We should check cmd for spaces, and move all after first space to args.
       ConsoleOutput := TMemoryStream.Create;
       try
+        {$ifdef HAS_UNIT_PROCESS}
         E:=ExecuteFPC(Verbose, cmd, args, ConsoleOutput);
+        {$else}
+        E:=ExecuteProcess(cmd,args);
+        {$endif}
         If (E<>0) and (not IgnoreError) then
           begin
             if trim(Args)<>'' then

packages/fpvectorial/src/avisocncgcodewriter.pas

@@ -36,6 +36,10 @@ var
   i, j: Integer;
   Str: string;
   APath: TPath;
+  CurSegment: T2DSegment;
+  Cur3DSegment: T3DSegment;
+  Cur2DBezierSegment: T2DBezierSegment;
+  Cur3DBezierSegment: T3DBezierSegment;
 begin
   AStrings.Clear;
 
@@ -51,25 +55,39 @@ begin
     // levanta a broca
     AStrings.Add('P01 // Sobe a cabeça de gravação');
     // vai para o ponto inicial
+    CurSegment := T2DSegment(APath.Points);
     AStrings.Add(Format('G01 X%f Y%f',
-      [APath.Points[0].X, APath.Points[0].Y]));
+      [CurSegment.X, CurSegment.Y]));
     AStrings.Add('P02 // Abaixa a cabeça de gravação');
 
     for j := 1 to APath.Len - 1 do
     begin
-      case APath.Points[j].SegmentType of
+      CurSegment := T2DSegment(CurSegment.Next);
+      case CurSegment.SegmentType of
       st2DLine: AStrings.Add(Format('G01 X%f Y%f',
-         [APath.Points[j].X, APath.Points[j].Y]));
-      st3DLine: AStrings.Add(Format('G01 X%f Y%f Z%f',
-         [APath.Points[j].X, APath.Points[j].Y, APath.Points[j].Z]));
-      st2DBezier: AStrings.Add(Format('B02 X%f Y%f X%f Y%f X%f Y%f',
-         [APath.Points[j].X2, APath.Points[j].Y2,
-          APath.Points[j].X3, APath.Points[j].Y3,
-          APath.Points[j].X, APath.Points[j].Y]));
-      st3DBezier: AStrings.Add(Format('B03 X%f Y%f Z%f X%f Y%f Z%f X%f Y%f Z%f',
-         [APath.Points[j].X2, APath.Points[j].Y2, APath.Points[j].Z2,
-          APath.Points[j].X3, APath.Points[j].Y3, APath.Points[j].Z3,
-          APath.Points[j].X, APath.Points[j].Y, APath.Points[j].Z]));
+         [CurSegment.X, CurSegment.Y]));
+      st3DLine:
+      begin
+        Cur3DSegment := T3DSegment(CurSegment);
+        AStrings.Add(Format('G01 X%f Y%f Z%f',
+         [Cur3DSegment.X, Cur3DSegment.Y, Cur3DSegment.Z]));
+      end;
+      st2DBezier:
+      begin
+        Cur2DBezierSegment := T2DBezierSegment(CurSegment);
+        AStrings.Add(Format('B02 X%f Y%f X%f Y%f X%f Y%f',
+         [Cur2DBezierSegment.X2, Cur2DBezierSegment.Y2,
+          Cur2DBezierSegment.X3, Cur2DBezierSegment.Y3,
+          Cur2DBezierSegment.X, Cur2DBezierSegment.Y]));
+      end;
+      st3DBezier:
+      begin
+        Cur3DBezierSegment := T3DBezierSegment(CurSegment);
+        AStrings.Add(Format('B03 X%f Y%f Z%f X%f Y%f Z%f X%f Y%f Z%f',
+         [Cur3DBezierSegment.X2, Cur3DBezierSegment.Y2, Cur3DBezierSegment.Z2,
+          Cur3DBezierSegment.X3, Cur3DBezierSegment.Y3, Cur3DBezierSegment.Z3,
+          Cur3DBezierSegment.X, Cur3DBezierSegment.Y, Cur3DBezierSegment.Z]));
+      end;
       end;
     end;
   end;