reintegration merge trunk

git-svn-id: branches/interfacertti@31422 -

.gitattributes

@@ -52,25 +52,6 @@ compiler/aasmdata.pas svneol=native#text/plain
 compiler/aasmsym.pas svneol=native#text/plain
 compiler/aasmtai.pas svneol=native#text/plain
 compiler/aggas.pas svneol=native#text/plain
-compiler/agjasmin.pas svneol=native#text/plain
-compiler/alpha/aasmcpu.pas svneol=native#text/plain
-compiler/alpha/agaxpgas.pas svneol=native#text/plain
-compiler/alpha/aoptcpu.pas svneol=native#text/plain
-compiler/alpha/aoptcpub.pas svneol=native#text/plain
-compiler/alpha/aoptcpuc.pas svneol=native#text/plain
-compiler/alpha/aoptcpud.pas svneol=native#text/plain
-compiler/alpha/cgcpu.pas svneol=native#text/plain
-compiler/alpha/cpubase.pas svneol=native#text/plain
-compiler/alpha/cpuinfo.pas svneol=native#text/plain
-compiler/alpha/cpunode.pas svneol=native#text/plain
-compiler/alpha/cpupara.pas svneol=native#text/plain
-compiler/alpha/cpupi.pas svneol=native#text/plain
-compiler/alpha/cputarg.pas svneol=native#text/plain
-compiler/alpha/radirect.pas svneol=native#text/plain
-compiler/alpha/rasm.pas svneol=native#text/plain
-compiler/alpha/rgcpu.pas svneol=native#text/plain
-compiler/alpha/symcpu.pas svneol=native#text/plain
-compiler/alpha/tgcpu.pas svneol=native#text/plain
 compiler/aopt.pas svneol=native#text/plain
 compiler/aoptbase.pas svneol=native#text/plain
 compiler/aoptcs.pas svneol=native#text/plain
@@ -155,7 +136,6 @@ compiler/avr/rgcpu.pas svneol=native#text/plain
 compiler/avr/symcpu.pas svneol=native#text/plain
 compiler/blockutl.pas svneol=native#text/plain
 compiler/browcol.pas svneol=native#text/plain
-compiler/bsdcompile -text
 compiler/catch.pas svneol=native#text/plain
 compiler/ccharset.pas svneol=native#text/plain
 compiler/cclasses.pas svneol=native#text/plain
@@ -213,7 +193,6 @@ compiler/i386/cpunode.pas svneol=native#text/plain
 compiler/i386/cpupara.pas svneol=native#text/plain
 compiler/i386/cpupi.pas svneol=native#text/plain
 compiler/i386/cputarg.pas svneol=native#text/plain
-compiler/i386/csopt386.pas svneol=native#text/plain
 compiler/i386/daopt386.pas svneol=native#text/plain
 compiler/i386/hlcgcpu.pas svneol=native#text/plain
 compiler/i386/i386att.inc svneol=native#text/plain
@@ -250,7 +229,6 @@ compiler/i386/r386std.inc svneol=native#text/plain
 compiler/i386/ra386att.pas svneol=native#text/plain
 compiler/i386/ra386int.pas svneol=native#text/plain
 compiler/i386/rgcpu.pas svneol=native#text/plain
-compiler/i386/rropt386.pas svneol=native#text/plain
 compiler/i386/symcpu.pas svneol=native#text/plain
 compiler/i8086/aoptcpu.pas svneol=native#text/plain
 compiler/i8086/aoptcpub.pas svneol=native#text/plain
@@ -300,11 +278,6 @@ compiler/i8086/ra8086int.pas svneol=native#text/plain
 compiler/i8086/rgcpu.pas svneol=native#text/plain
 compiler/i8086/symcpu.pas svneol=native#text/plain
 compiler/i8086/tgcpu.pas svneol=native#text/plain
-compiler/ia64/aasmcpu.pas svneol=native#text/plain
-compiler/ia64/cpubase.pas svneol=native#text/plain
-compiler/ia64/cpuinfo.pas svneol=native#text/plain
-compiler/ia64/ia64reg.dat svneol=native#text/plain
-compiler/ia64/symcpu.pas svneol=native#text/plain
 compiler/impdef.pas svneol=native#text/plain
 compiler/import.pas svneol=native#text/plain
 compiler/jvm/aasmcpu.pas svneol=native#text/plain
@@ -813,11 +786,6 @@ compiler/utils/ppuutils/ppuxml.pp svneol=native#text/plain
 compiler/utils/samplecfg svneol=native#text/plain
 compiler/verbose.pas svneol=native#text/plain
 compiler/version.pas svneol=native#text/plain
-compiler/vis/aasmcpu.pas svneol=native#text/plain
-compiler/vis/cpubase.pas svneol=native#text/plain
-compiler/vis/cpuinfo.pas svneol=native#text/plain
-compiler/vis/cpunode.pas svneol=native#text/plain
-compiler/vis/cpupara.pas svneol=native#text/plain
 compiler/widestr.pas svneol=native#text/plain
 compiler/wpo.pas svneol=native#text/plain
 compiler/wpobase.pas svneol=native#text/plain
@@ -2577,6 +2545,9 @@ packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-process/fpmake.pp svneol=native#text/plain
+packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
+packages/fcl-process/src/amicommon/process.inc svneol=native#text/plain
+packages/fcl-process/src/amicommon/simpleipc.inc svneol=native#text/plain
 packages/fcl-process/src/dbugintf.pp svneol=native#text/plain
 packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain
 packages/fcl-process/src/dummy/pipes.inc svneol=native#text/plain
@@ -3520,6 +3491,92 @@ packages/gnome1/src/zvt/libzvt.pp svneol=native#text/plain
 packages/gnome1/src/zvt/lists.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vt.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vtx.inc svneol=native#text/plain
+packages/googleapi/Makefile svneol=native#text/plain
+packages/googleapi/Makefile.fpc svneol=native#text/plain
+packages/googleapi/README.txt svneol=native#text/plain
+packages/googleapi/examples/generator/googleapiconv.lpi svneol=native#text/plain
+packages/googleapi/examples/generator/googleapiconv.pp svneol=native#text/plain
+packages/googleapi/fpmake.pp svneol=native#text/plain
+packages/googleapi/src/googleadexchangebuyer.pp svneol=native#text/plain
+packages/googleapi/src/googleadexchangeseller.pp svneol=native#text/plain
+packages/googleapi/src/googleadmin.pp svneol=native#text/plain
+packages/googleapi/src/googleadsense.pp svneol=native#text/plain
+packages/googleapi/src/googleadsensehost.pp svneol=native#text/plain
+packages/googleapi/src/googleanalytics.pp svneol=native#text/plain
+packages/googleapi/src/googleandroidenterprise.pp svneol=native#text/plain
+packages/googleapi/src/googleandroidpublisher.pp svneol=native#text/plain
+packages/googleapi/src/googleappsactivity.pp svneol=native#text/plain
+packages/googleapi/src/googleappstate.pp svneol=native#text/plain
+packages/googleapi/src/googleaudit.pp svneol=native#text/plain
+packages/googleapi/src/googleautoscaler.pp svneol=native#text/plain
+packages/googleapi/src/googlebase.pp svneol=native#text/plain
+packages/googleapi/src/googlebigquery.pp svneol=native#text/plain
+packages/googleapi/src/googleblogger.pp svneol=native#text/plain
+packages/googleapi/src/googlebooks.pp svneol=native#text/plain
+packages/googleapi/src/googlecalendar.pp svneol=native#text/plain
+packages/googleapi/src/googlecivicinfo.pp svneol=native#text/plain
+packages/googleapi/src/googleclient.pp svneol=native#text/plain
+packages/googleapi/src/googlecloudlatencytest.pp svneol=native#text/plain
+packages/googleapi/src/googlecloudmonitoring.pp svneol=native#text/plain
+packages/googleapi/src/googlecloudsearch.pp svneol=native#text/plain
+packages/googleapi/src/googlecompute.pp svneol=native#text/plain
+packages/googleapi/src/googlecomputeaccounts.pp svneol=native#text/plain
+packages/googleapi/src/googlecontainer.pp svneol=native#text/plain
+packages/googleapi/src/googlecontent.pp svneol=native#text/plain
+packages/googleapi/src/googlecoordinate.pp svneol=native#text/plain
+packages/googleapi/src/googlecustomsearch.pp svneol=native#text/plain
+packages/googleapi/src/googledataflow.pp svneol=native#text/plain
+packages/googleapi/src/googledatastore.pp svneol=native#text/plain
+packages/googleapi/src/googledeploymentmanager.pp svneol=native#text/plain
+packages/googleapi/src/googledfareporting.pp svneol=native#text/plain
+packages/googleapi/src/googlediscovery.pp svneol=native#text/plain
+packages/googleapi/src/googlediscoverytopas.pp svneol=native#text/plain
+packages/googleapi/src/googledns.pp svneol=native#text/plain
+packages/googleapi/src/googledoubleclickbidmanager.pp svneol=native#text/plain
+packages/googleapi/src/googledoubleclicksearch.pp svneol=native#text/plain
+packages/googleapi/src/googledrive.pp svneol=native#text/plain
+packages/googleapi/src/googlefitness.pp svneol=native#text/plain
+packages/googleapi/src/googlefreebase.pp svneol=native#text/plain
+packages/googleapi/src/googlefusiontables.pp svneol=native#text/plain
+packages/googleapi/src/googlegames.pp svneol=native#text/plain
+packages/googleapi/src/googlegamesConfiguration.pp svneol=native#text/plain
+packages/googleapi/src/googlegamesManagement.pp svneol=native#text/plain
+packages/googleapi/src/googlegan.pp svneol=native#text/plain
+packages/googleapi/src/googlegenomics.pp svneol=native#text/plain
+packages/googleapi/src/googlegmail.pp svneol=native#text/plain
+packages/googleapi/src/googlegroupsmigration.pp svneol=native#text/plain
+packages/googleapi/src/googlegroupssettings.pp svneol=native#text/plain
+packages/googleapi/src/googleidentitytoolkit.pp svneol=native#text/plain
+packages/googleapi/src/googlelicensing.pp svneol=native#text/plain
+packages/googleapi/src/googlelogging.pp svneol=native#text/plain
+packages/googleapi/src/googlemanager.pp svneol=native#text/plain
+packages/googleapi/src/googlemapsengine.pp svneol=native#text/plain
+packages/googleapi/src/googlemirror.pp svneol=native#text/plain
+packages/googleapi/src/googleoauth2.pp svneol=native#text/plain
+packages/googleapi/src/googlepagespeedonline.pp svneol=native#text/plain
+packages/googleapi/src/googleplus.pp svneol=native#text/plain
+packages/googleapi/src/googleplusDomains.pp svneol=native#text/plain
+packages/googleapi/src/googleprediction.pp svneol=native#text/plain
+packages/googleapi/src/googlepubsub.pp svneol=native#text/plain
+packages/googleapi/src/googleqpxExpress.pp svneol=native#text/plain
+packages/googleapi/src/googlereplicapool.pp svneol=native#text/plain
+packages/googleapi/src/googlereplicapoolupdater.pp svneol=native#text/plain
+packages/googleapi/src/googlereseller.pp svneol=native#text/plain
+packages/googleapi/src/googleresourceviews.pp svneol=native#text/plain
+packages/googleapi/src/googleservice.pp svneol=native#text/plain
+packages/googleapi/src/googlesiteVerification.pp svneol=native#text/plain
+packages/googleapi/src/googlespectrum.pp svneol=native#text/plain
+packages/googleapi/src/googlesqladmin.pp svneol=native#text/plain
+packages/googleapi/src/googlestorage.pp svneol=native#text/plain
+packages/googleapi/src/googletagmanager.pp svneol=native#text/plain
+packages/googleapi/src/googletaskqueue.pp svneol=native#text/plain
+packages/googleapi/src/googletasks.pp svneol=native#text/plain
+packages/googleapi/src/googletranslate.pp svneol=native#text/plain
+packages/googleapi/src/googleurlshortener.pp svneol=native#text/plain
+packages/googleapi/src/googlewebfonts.pp svneol=native#text/plain
+packages/googleapi/src/googlewebmasters.pp svneol=native#text/plain
+packages/googleapi/src/googleyoutube.pp svneol=native#text/plain
+packages/googleapi/src/googleyoutubeAnalytics.pp svneol=native#text/plain
 packages/graph/Makefile svneol=native#text/plain
 packages/graph/Makefile.fpc svneol=native#text/plain
 packages/graph/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -4782,6 +4839,21 @@ packages/libcurl/examples/testcurl.pp svneol=native#text/plain
 packages/libcurl/examples/teststream.pp svneol=native#text/plain
 packages/libcurl/fpmake.pp svneol=native#text/plain
 packages/libcurl/src/libcurl.pp svneol=native#text/plain
+packages/libenet/Makefile svneol=native#text/plain
+packages/libenet/Makefile.fpc svneol=native#text/plain
+packages/libenet/examples/clientapp.lpi svneol=native#text/plain
+packages/libenet/examples/clientapp.pp svneol=native#text/plain
+packages/libenet/examples/serverapp.lpi svneol=native#text/plain
+packages/libenet/examples/serverapp.pp svneol=native#text/plain
+packages/libenet/fpmake.pp svneol=native#text/plain
+packages/libenet/src/enet.pp svneol=native#text/plain
+packages/libenet/src/enetcallbacks.pp svneol=native#text/plain
+packages/libenet/src/enetlist.pp svneol=native#text/plain
+packages/libenet/src/enetplatform.pp svneol=native#text/plain
+packages/libenet/src/enetprotocol.pp svneol=native#text/plain
+packages/libenet/src/enettime.pp svneol=native#text/plain
+packages/libenet/src/enettypes.pp svneol=native#text/plain
+packages/libenet/src/uenetclass.pp svneol=native#text/plain
 packages/libgbafpc/Makefile svneol=native#text/plain
 packages/libgbafpc/Makefile.fpc svneol=native#text/plain
 packages/libgbafpc/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -5696,6 +5768,7 @@ packages/mysql/examples/mysqls.c svneol=native#text/plain
 packages/mysql/examples/mysqls.pp svneol=native#text/plain
 packages/mysql/examples/testdb3.pp svneol=native#text/plain
 packages/mysql/examples/testdb4.pp svneol=native#text/plain
+packages/mysql/examples/testdb5.pp svneol=native#text/plain
 packages/mysql/fpmake.pp svneol=native#text/plain
 packages/mysql/scripts/mkdb svneol=native#text/plain
 packages/mysql/scripts/rmdb svneol=native#text/plain
@@ -6727,6 +6800,8 @@ packages/rtl-extra/src/bsd/clocale.inc svneol=native#text/plain
 packages/rtl-extra/src/bsd/ipcbsd.inc svneol=native#text/plain
 packages/rtl-extra/src/bsd/osdefs.inc svneol=native#text/plain
 packages/rtl-extra/src/darwin/unxsockh.inc svneol=native#text/plain
+packages/rtl-extra/src/dragonfly/unixsock.inc svneol=native#text/plain
+packages/rtl-extra/src/dragonfly/unxsockh.inc svneol=native#text/plain
 packages/rtl-extra/src/freebsd/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/freebsd/unxsockh.inc svneol=native#text/plain
 packages/rtl-extra/src/go32v2/printer.pp svneol=native#text/plain
@@ -6751,7 +6826,6 @@ packages/rtl-extra/src/linux/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/linux/unixsockets.inc svneol=native#text/plain
 packages/rtl-extra/src/linux/unixsocketsh.inc svneol=native#text/plain
 packages/rtl-extra/src/linux/unxsockh.inc svneol=native#text/plain
-packages/rtl-extra/src/morphos/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/msdos/printer.pp svneol=native#text/plain
 packages/rtl-extra/src/netbsd/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/netbsd/unxsockh.inc svneol=native#text/plain
@@ -7031,6 +7105,8 @@ packages/univint/src/CFDateFormatter.pas svneol=native#text/plain
 packages/univint/src/CFDictionary.pas svneol=native#text/plain
 packages/univint/src/CFError.pas svneol=native#text/plain
 packages/univint/src/CFFTPStream.pas svneol=native#text/plain
+packages/univint/src/CFFileDescriptor.pas svneol=native#text/plain
+packages/univint/src/CFFileSecurity.pas svneol=native#text/plain
 packages/univint/src/CFHTTPAuthentication.pas svneol=native#text/plain
 packages/univint/src/CFHTTPMessage.pas svneol=native#text/plain
 packages/univint/src/CFHTTPStream.pas svneol=native#text/plain
@@ -7061,6 +7137,7 @@ packages/univint/src/CFTimeZone.pas svneol=native#text/plain
 packages/univint/src/CFTree.pas svneol=native#text/plain
 packages/univint/src/CFURL.pas svneol=native#text/plain
 packages/univint/src/CFURLAccess.pas svneol=native#text/plain
+packages/univint/src/CFURLEnumerator.pas svneol=native#text/plain
 packages/univint/src/CFUUID.pas svneol=native#text/plain
 packages/univint/src/CFUserNotification.pas svneol=native#text/plain
 packages/univint/src/CFXMLNode.pas svneol=native#text/plain
@@ -7355,6 +7432,11 @@ packages/univint/src/SCSI.pas svneol=native#text/plain
 packages/univint/src/SCSchemaDefinitions.pas svneol=native#text/plain
 packages/univint/src/SFNTLayoutTypes.pas svneol=native#text/plain
 packages/univint/src/SFNTTypes.pas svneol=native#text/plain
+packages/univint/src/SKAnalysis.pas svneol=native#text/plain
+packages/univint/src/SKDocument.pas svneol=native#text/plain
+packages/univint/src/SKIndex.pas svneol=native#text/plain
+packages/univint/src/SKSearch.pas svneol=native#text/plain
+packages/univint/src/SKSummary.pas svneol=native#text/plain
 packages/univint/src/ScalerStreamTypes.pas svneol=native#text/plain
 packages/univint/src/Scrap.pas svneol=native#text/plain
 packages/univint/src/Script.pas svneol=native#text/plain
@@ -7392,6 +7474,7 @@ packages/univint/src/Video.pas svneol=native#text/plain
 packages/univint/src/WSMethodInvocation.pas svneol=native#text/plain
 packages/univint/src/WSProtocolHandler.pas svneol=native#text/plain
 packages/univint/src/WSTypes.pas svneol=native#text/plain
+packages/univint/src/acl.pas svneol=native#text/plain
 packages/univint/src/cblas.pas svneol=native#text/plain
 packages/univint/src/certextensions.pas svneol=native#text/plain
 packages/univint/src/cssmapple.pas svneol=native#text/plain
@@ -7975,7 +8058,6 @@ rtl/amiga/powerpc/utild2.inc svneol=native#text/plain
 rtl/amiga/powerpc/utilf.inc svneol=native#text/plain
 rtl/amiga/system.pp svneol=native#text/plain
 rtl/amiga/timerd.inc svneol=native#text/plain
-rtl/amiga/tthread.inc svneol=native#text/plain
 rtl/android/Makefile svneol=native#text/plain
 rtl/android/Makefile.fpc svneol=native#text/plain
 rtl/android/arm/dllprt0.as svneol=native#text/plain
@@ -8009,7 +8091,6 @@ rtl/arm/thumb.inc svneol=native#text/plain
 rtl/arm/thumb2.inc svneol=native#text/plain
 rtl/aros/Makefile svneol=native#text/plain
 rtl/aros/Makefile.fpc svneol=native#text/plain
-rtl/aros/arosthreads.inc svneol=native#text/plain
 rtl/aros/doslibd.inc svneol=native#text/plain
 rtl/aros/i386/doslibf.inc svneol=native#text/plain
 rtl/aros/i386/execd.inc svneol=native#text/plain
@@ -8019,10 +8100,8 @@ rtl/aros/i386/utild1.inc svneol=native#text/plain
 rtl/aros/i386/utild2.inc svneol=native#text/plain
 rtl/aros/i386/utilf.inc svneol=native#text/plain
 rtl/aros/system.pp svneol=native#text/plain
-rtl/aros/systemthreadh.inc svneol=native#text/plain
-rtl/aros/systhrd.inc svneol=native#text/plain
 rtl/aros/timerd.inc svneol=native#text/plain
-rtl/aros/tthread.inc svneol=native#text/plain
+rtl/aros/x86_64/prt0.as svneol=native#text/plain
 rtl/atari/Makefile svneol=native#text/plain
 rtl/atari/Makefile.fpc svneol=native#text/plain
 rtl/atari/prt0.as svneol=native#text/plain
@@ -8354,6 +8433,7 @@ rtl/haiku/classes.pp svneol=native#text/plain
 rtl/haiku/errno.inc svneol=native#text/plain
 rtl/haiku/errnostr.inc svneol=native#text/plain
 rtl/haiku/i386/cprt0.as svneol=native#text/plain
+rtl/haiku/i386/dllcprt0.as svneol=native#text/plain
 rtl/haiku/i386/dllprt.as svneol=native#text/plain
 rtl/haiku/i386/dllprt.cpp svneol=native#text/plain
 rtl/haiku/i386/func.as svneol=native#text/plain
@@ -8453,6 +8533,7 @@ rtl/inc/int64.inc svneol=native#text/plain
 rtl/inc/intres.inc svneol=native#text/plain
 rtl/inc/iso7185.pp svneol=native#text/pascal
 rtl/inc/lineinfo.pp svneol=native#text/plain
+rtl/inc/llvmintr.inc svneol=native#text/plain
 rtl/inc/lnfodwrf.pp svneol=native#text/plain
 rtl/inc/lstrings.pp svneol=native#text/plain
 rtl/inc/macpas.pp svneol=native#text/plain
@@ -8477,7 +8558,7 @@ rtl/inc/sstrings.inc svneol=native#text/plain
 rtl/inc/strings.pp svneol=native#text/plain
 rtl/inc/stringsi.inc svneol=native#text/plain
 rtl/inc/sysres.inc svneol=native#text/plain
-rtl/inc/system.fpd -text
+rtl/inc/system.fpd svneol=native#text/plain
 rtl/inc/system.inc svneol=native#text/plain
 rtl/inc/systemh.inc svneol=native#text/plain
 rtl/inc/text.inc svneol=native#text/plain
@@ -8544,6 +8625,17 @@ rtl/jvm/setjump.inc svneol=native#text/plain
 rtl/jvm/setjumph.inc svneol=native#text/plain
 rtl/linux/Makefile svneol=native#text/plain
 rtl/linux/Makefile.fpc svneol=native#text/plain
+rtl/linux/aarch64/bsyscall.inc svneol=native#text/plain
+rtl/linux/aarch64/cprt0.as svneol=native#text/plain
+rtl/linux/aarch64/dllprt0.as svneol=native#text/plain
+rtl/linux/aarch64/gprt0.as svneol=native#text/plain
+rtl/linux/aarch64/prt0.as svneol=native#text/plain
+rtl/linux/aarch64/sighnd.inc svneol=native#text/plain
+rtl/linux/aarch64/sighndh.inc svneol=native#text/plain
+rtl/linux/aarch64/stat.inc svneol=native#text/plain
+rtl/linux/aarch64/syscall.inc svneol=native#text/plain
+rtl/linux/aarch64/syscallh.inc svneol=native#text/plain
+rtl/linux/aarch64/sysnr.inc svneol=native#text/plain
 rtl/linux/arm/bsyscall.inc svneol=native#text/plain
 rtl/linux/arm/cprt0.as svneol=native#text/plain
 rtl/linux/arm/dllprt0.as svneol=native#text/plain
@@ -8762,11 +8854,9 @@ rtl/morphos/emuld.inc svneol=native#text/plain
 rtl/morphos/execd.inc svneol=native#text/plain
 rtl/morphos/execf.inc svneol=native#text/plain
 rtl/morphos/prt0.as svneol=native#text/plain
-rtl/morphos/sysosh.inc svneol=native#text/plain
 rtl/morphos/system.pp svneol=native#text/plain
 rtl/morphos/timerd.inc svneol=native#text/plain
 rtl/morphos/timerf.inc svneol=native#text/plain
-rtl/morphos/tthread.inc svneol=native#text/plain
 rtl/morphos/utild1.inc svneol=native#text/plain
 rtl/morphos/utild2.inc svneol=native#text/plain
 rtl/morphos/utilf.inc svneol=native#text/plain
@@ -14404,6 +14494,8 @@ tests/webtbs/tw2830.pp svneol=native#text/plain
 tests/webtbs/tw2832.pp svneol=native#text/plain
 tests/webtbs/tw2834.pp svneol=native#text/plain
 tests/webtbs/tw2841.pp svneol=native#text/plain
+tests/webtbs/tw28442.pp svneol=native#text/pascal
+tests/webtbs/tw28454.pp svneol=native#text/plain
 tests/webtbs/tw2853.pp svneol=native#text/plain
 tests/webtbs/tw2853a.pp svneol=native#text/plain
 tests/webtbs/tw2853b.pp svneol=native#text/plain
@@ -15121,6 +15213,7 @@ tests/webtbs/uw2731.pp svneol=native#text/plain
 tests/webtbs/uw27320.defaults.pp svneol=native#text/pascal
 tests/webtbs/uw2738.pp svneol=native#text/plain
 tests/webtbs/uw2834.pp svneol=native#text/plain
+tests/webtbs/uw28442.pp svneol=native#text/pascal
 tests/webtbs/uw2920.pp svneol=native#text/plain
 tests/webtbs/uw2956.pp svneol=native#text/plain
 tests/webtbs/uw2984.pp svneol=native#text/plain
@@ -15440,8 +15533,8 @@ utils/h2pas/h2pyacclib.pas svneol=native#text/plain
 utils/h2pas/scan.l svneol=native#text/plain
 utils/h2pas/scan.pas svneol=native#text/plain
 utils/h2pas/testit.h -text
-utils/h2pas/yylex.cod -text
-utils/h2pas/yyparse.cod -text
+utils/h2pas/yylex.cod svneol=native#text/plain
+utils/h2pas/yyparse.cod svneol=native#text/plain
 utils/importtl/Makefile svneol=native#text/plain
 utils/importtl/Makefile.fpc svneol=native#text/plain
 utils/importtl/Makefile.fpc.fpcmake svneol=native#text/plain

Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-02-23 rev 29972]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-07-28 rev 31240]
 #
 default: help
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros 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 powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-darwin
+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 i386-android i386-aros 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 powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos
@@ -184,6 +184,12 @@ $(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t
 endif
 override FPCOPT+=-Cp$(SUBARCH)
 endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(SUBARCH),)
 $(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
@@ -328,7 +334,7 @@ endif
 override PACKAGE_NAME=fpc
 override PACKAGE_VERSION=3.1.1
 REQUIREDVERSION=2.6.4
-REQUIREDVERSION2=2.6.2
+REQUIREDVERSION2=3.0.0
 ifndef inOS2
 override FPCDIR:=$(BASEDIR)
 export FPCDIR
@@ -639,6 +645,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -711,6 +720,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+override TARGET_DIRS+=compiler rtl utils packages ide installer
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 override TARGET_DIRS+=compiler rtl utils packages ide installer
 endif
@@ -1110,6 +1122,10 @@ STATICLIBPREFIX=
 STATICLIBEXT=.a
 SHORTSUFFIX=d16
 endif
+ifeq ($(OS_TARGET),embedded)
+EXEEXT=.bin
+SHORTSUFFIX=emb
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1376,6 +1392,7 @@ endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
@@ -1388,6 +1405,7 @@ endif
 ifndef CROSSCOMPILE
 ifneq ($(BINUTILSPREFIX),)
 override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
 endif
 endif
 ifdef UNITDIR
@@ -1487,6 +1505,9 @@ endif
 ifdef OPT
 override FPCOPT+=$(OPT)
 endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
 ifdef FPCOPTDEF
 override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
 endif
@@ -1585,7 +1606,7 @@ endif
 fpc_sourceinstall: distclean
 	$(MKDIR) $(INSTALL_SOURCEDIR)
 	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
-fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
 ifdef HASEXAMPLES
 	$(MKDIR) $(INSTALL_EXAMPLEDIR)
 endif
@@ -1757,6 +1778,10 @@ endif
 ifdef DEBUGSYMEXT
 	-$(DEL) *$(DEBUGSYMEXT)
 endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
 fpc_distclean: cleanall
 .PHONY: fpc_baseinfo
 override INFORULES+=fpc_baseinfo
@@ -2297,6 +2322,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_IDE=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2489,6 +2522,14 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_IDE=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1

Makefile.fpc

@@ -21,7 +21,10 @@ rule=help
 
 [prerules]
 REQUIREDVERSION=2.6.4
-REQUIREDVERSION2=2.6.2
+# Accept 3.0.0, without requiring to using OVERRIDEVERSIONCHECK=1
+# 3.0.0 should become REQUIREDVERSION after 3.0.0 final release
+# and 2.6.4 should be moved to REQUIREDVERSION2
+REQUIREDVERSION2=3.0.0
 
 
 # make versions < 3.77 (OS2 version) are buggy

compiler/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-02-24 rev 29972]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015/06/28]
 #
 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 i386-android i386-aros 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 powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-darwin
+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 i386-android i386-aros 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 powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-aros x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-linux aarch64-darwin
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 LIMIT83fs = go32v2 os2 emx watcom msdos
@@ -184,6 +184,12 @@ $(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t
 endif
 override FPCOPT+=-Cp$(SUBARCH)
 endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(SUBARCH),)
 $(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
@@ -330,9 +336,6 @@ override PACKAGE_VERSION=3.1.1
 unexport FPC_VERSION FPC_COMPILERINFO
 CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips avr jvm i8086 aarch64
 ALLTARGETS=$(CYCLETARGETS)
-ifdef ALPHA
-PPC_TARGET=alpha
-endif
 ifdef POWERPC
 PPC_TARGET=powerpc
 endif
@@ -436,11 +439,9 @@ MSGFILES=$(wildcard msg/error*.msg)
 ifeq ($(CPC_TARGET),i386)
 CPUSUF=386
 endif
-ifeq ($(CPC_TARGET),alpha)
-CPUSUF=axp
-endif
 ifeq ($(CPC_TARGET),m68k)
 CPUSUF=68k
+ALLOW_WARNINGS=1
 endif
 ifeq ($(CPC_TARGET),powerpc)
 CPUSUF=ppc
@@ -465,6 +466,7 @@ CPUSUF=mipsel
 endif
 ifeq ($(CPC_TARGET),avr)
 CPUSUF=avr
+ALLOW_WARNINGS=1
 endif
 ifeq ($(CPC_TARGET),jvm)
 CPUSUF=jvm
@@ -716,6 +718,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 override TARGET_DIRS+=utils
 endif
@@ -788,6 +793,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override TARGET_DIRS+=utils
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+override TARGET_DIRS+=utils
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 override TARGET_DIRS+=utils
 endif
@@ -953,6 +961,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 override TARGET_PROGRAMS+=pp
 endif
@@ -1025,6 +1036,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override TARGET_PROGRAMS+=pp
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+override TARGET_PROGRAMS+=pp
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 override TARGET_PROGRAMS+=pp
 endif
@@ -1191,6 +1205,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1263,6 +1280,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 override COMPILER_INCLUDEDIR+=$(CPC_TARGET)
 endif
@@ -1428,6 +1448,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1500,6 +1523,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
 endif
@@ -1665,6 +1691,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1737,6 +1766,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override COMPILER_TARGETDIR+=.
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+override COMPILER_TARGETDIR+=.
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 override COMPILER_TARGETDIR+=.
 endif
@@ -1902,6 +1934,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -1974,6 +2009,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
 endif
@@ -2372,6 +2410,10 @@ STATICLIBPREFIX=
 STATICLIBEXT=.a
 SHORTSUFFIX=d16
 endif
+ifeq ($(OS_TARGET),embedded)
+EXEEXT=.bin
+SHORTSUFFIX=emb
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -2789,6 +2831,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -2861,6 +2906,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -3658,6 +3706,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 TARGET_DIRS_UTILS=1
 endif
@@ -3730,6 +3781,9 @@ endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 TARGET_DIRS_UTILS=1
 endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+TARGET_DIRS_UTILS=1
+endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 TARGET_DIRS_UTILS=1
 endif
@@ -3861,7 +3915,7 @@ INSTALLEXEFILE=$(PPCROSSNAME)
 else
 INSTALLEXEFILE=$(EXENAME)
 endif
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr jvm i8086 aarch64
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 .PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS)
 $(PPC_TARGETS):
@@ -3936,9 +3990,6 @@ insdat: insdatx86 insdatarm insdataarch64
 regdatarm : arm/armreg.dat
 	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp
 	cd arm && ..$(PATHSEP)utils$(PATHSEP)mkarmreg$(SRCEXEEXT)
-regdatia64 : ia64/ia64reg.dat
-	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkia64reg.pp
-	cd ia64 && ..$(PATHSEP)utils$(PATHSEP)mkia64reg$(SRCEXEEXT)
 regdatsp : sparc/spreg.dat
 	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkspreg.pp
 	cd sparc && ..$(PATHSEP)utils$(PATHSEP)mkspreg$(SRCEXEEXT)

compiler/Makefile.fpc

@@ -38,9 +38,6 @@ CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips avr
 ALLTARGETS=$(CYCLETARGETS)
 
 # Allow ALPHA, POWERPC, POWERPC64, M68K, I386, jvm defines for target cpu
-ifdef ALPHA
-PPC_TARGET=alpha
-endif
 ifdef POWERPC
 PPC_TARGET=powerpc
 endif
@@ -172,11 +169,9 @@ MSGFILES=$(wildcard msg/error*.msg)
 ifeq ($(CPC_TARGET),i386)
 CPUSUF=386
 endif
-ifeq ($(CPC_TARGET),alpha)
-CPUSUF=axp
-endif
 ifeq ($(CPC_TARGET),m68k)
 CPUSUF=68k
+ALLOW_WARNINGS=1
 endif
 ifeq ($(CPC_TARGET),powerpc)
 CPUSUF=ppc
@@ -201,6 +196,7 @@ CPUSUF=mipsel
 endif
 ifeq ($(CPC_TARGET),avr)
 CPUSUF=avr
+ALLOW_WARNINGS=1
 endif
 ifeq ($(CPC_TARGET),jvm)
 CPUSUF=jvm
@@ -406,7 +402,7 @@ endif
 # CPU targets
 #####################################################################
 
-PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr jvm i8086 aarch64
+PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64
 INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS)))
 
 .PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS)
@@ -521,10 +517,6 @@ regdatarm : arm/armreg.dat
 	    $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp
         cd arm && ..$(PATHSEP)utils$(PATHSEP)mkarmreg$(SRCEXEEXT)
 
-regdatia64 : ia64/ia64reg.dat
-            $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkia64reg.pp
-        cd ia64 && ..$(PATHSEP)utils$(PATHSEP)mkia64reg$(SRCEXEEXT)
-
 regdatsp : sparc/spreg.dat
             $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkspreg.pp
         cd sparc && ..$(PATHSEP)utils$(PATHSEP)mkspreg$(SRCEXEEXT)

compiler/aarch64/a64att.inc

@@ -1,4 +1,4 @@
-{ don't edit, this file is generated from armins.dat }
+{ don't edit, this file is generated from a64ins.dat }
 (
 'none',
 'b',

compiler/aarch64/a64atts.inc

@@ -1,4 +1,4 @@
-{ don't edit, this file is generated from armins.dat }
+{ don't edit, this file is generated from a64ins.dat }
 (
 attsufNONE,
 attsufNONE,

compiler/aarch64/a64op.inc

@@ -1,4 +1,4 @@
-{ don't edit, this file is generated from armins.dat }
+{ don't edit, this file is generated from a64ins.dat }
 (
 A_NONE,
 A_B,

compiler/aarch64/a64tab.inc

@@ -1,4 +1,4 @@
-{ don't edit, this file is generated from armins.dat }
+{ don't edit, this file is generated from a64ins.dat }
 (
 
 );

compiler/aarch64/agcpugas.pas

@@ -39,6 +39,10 @@ unit agcpugas;
         procedure WriteInstruction(hp : tai);override;
       end;
 
+      TAArch64Assembler=class(TGNUassembler)
+        constructor create(smart: boolean); override;
+      end;
+
       TAArch64AppleAssembler=class(TAppleGNUassembler)
         constructor create(smart: boolean); override;
         function MakeCmdLine: TCmdStr; override;
@@ -68,6 +72,16 @@ unit agcpugas;
        cgbase,cgutils;
 
 
+{****************************************************************************}
+{                      AArch64 Assembler writer                              }
+{****************************************************************************}
+
+    constructor TAArch64Assembler.create(smart: boolean);
+      begin
+        inherited create(smart);
+        InstrWriter := TAArch64InstrWriter.create(self);
+      end;
+
 {****************************************************************************}
 {                      Apple AArch64 Assembler writer                        }
 {****************************************************************************}
@@ -99,6 +113,8 @@ unit agcpugas;
       const
         darwin_addrpage2str: array[addr_page..addr_gotpageoffset] of string[11] =
            ('@PAGE','@PAGEOFF','@GOTPAGE','@GOTPAGEOFF');
+        linux_addrpage2str: array[addr_page..addr_gotpageoffset] of string[10] =
+           ('',':lo12:',':got:',':got_lo12:');
       begin
         if ref.base=NR_NO then
           begin
@@ -117,8 +133,7 @@ unit agcpugas;
                   if target_asm.id=as_darwin then
                     result:=ref.symbol.name+darwin_addrpage2str[ref.refaddr]
                   else
-                    { todo }
-                    internalerror(2014121502);
+                    result:=linux_addrpage2str[ref.refaddr]+ref.symbol.name
                 end
               else
                 internalerror(2015022301);
@@ -160,8 +175,7 @@ unit agcpugas;
                           if target_asm.id=as_darwin then
                             result:=result+', '+ref.symbol.name+darwin_addrpage2str[ref.refaddr]
                           else
-                            { todo }
-                            internalerror(2014122510);
+                            result:=result+', '+linux_addrpage2str[ref.refaddr]+ref.symbol.name
                         end
                       else
                         { todo: not yet generated/don't know syntax }
@@ -269,6 +283,19 @@ unit agcpugas;
 
 
     const
+       as_aarch64_gas_info : tasminfo =
+          (
+            id     : as_gas;
+            idtxt  : 'AS';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $EXTRAOPT $ASM';
+            supported_targets : [system_aarch64_linux];
+            flags : [af_needar,af_smartlink_sections];
+            labelprefix : '.L';
+            comment : '// ';
+            dollarsign: '$';
+          );
+
        as_aarch64_gas_darwin_info : tasminfo =
           (
             id     : as_darwin;
@@ -284,5 +311,6 @@ unit agcpugas;
 
 
 begin
+  RegisterAssembler(as_aarch64_gas_info,TAArch64Assembler);
   RegisterAssembler(as_aarch64_gas_darwin_info,TAArch64AppleAssembler);
 end.

compiler/aarch64/cgcpu.pas

@@ -165,66 +165,59 @@ implementation
             { no relative symbol support (needed) yet }
             if assigned(ref.relsymbol) then
               internalerror(2014111001);
-            { on Darwin: load the address from the GOT. There does not appear to
-              be a non-GOT variant. This consists of first loading the address
-              of the page containing the GOT entry for this variable, and then
-              the address of the entry itself from that page (can be relaxed by
-              the linker in case the variable itself can be stored directly in
-              the GOT) }
-            if target_info.system in systems_darwin then
+            { loading a symbol address (whether it's in the GOT or not) consists
+              of two parts: first load the page on which it is located, then
+              either the offset in the page or load the value at that offset in
+              the page. This final GOT-load can be relaxed by the linker in case
+              the variable itself can be stored directly in the GOT }
+            if (preferred_newbasereg=NR_NO) or
+               (ref.base=preferred_newbasereg) or
+               (ref.index=preferred_newbasereg) then
+              preferred_newbasereg:=getaddressregister(list);
+            { load the (GOT) page }
+            reference_reset_symbol(href,ref.symbol,0,8);
+            if ((ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) and
+                (ref.symbol.bind in [AB_LOCAL,AB_GLOBAL])) or
+               ((ref.symbol.typ=AT_DATA) and
+                (ref.symbol.bind=AB_LOCAL)) then
+              href.refaddr:=addr_page
+            else
+              href.refaddr:=addr_gotpage;
+            list.concat(taicpu.op_reg_ref(A_ADRP,preferred_newbasereg,href));
+            { load the GOT entry (= address of the variable) }
+            reference_reset_base(href,preferred_newbasereg,0,sizeof(pint));
+            href.symbol:=ref.symbol;
+            { code symbols defined in the current compilation unit do not
+              have to be accessed via the GOT }
+            if ((ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) and
+                (ref.symbol.bind in [AB_LOCAL,AB_GLOBAL])) or
+               ((ref.symbol.typ=AT_DATA) and
+                (ref.symbol.bind=AB_LOCAL)) then
               begin
-                if (preferred_newbasereg=NR_NO) or
-                   (ref.base=preferred_newbasereg) or
-                   (ref.index=preferred_newbasereg) then
-                  preferred_newbasereg:=getaddressregister(list);
-                { load the (GOT) page }
-                reference_reset_symbol(href,ref.symbol,0,8);
-                if ((ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) and
-                    (ref.symbol.bind in [AB_LOCAL,AB_GLOBAL])) or
-                   ((ref.symbol.typ=AT_DATA) and
-                    (ref.symbol.bind=AB_LOCAL)) then
-                  href.refaddr:=addr_page
-                else
-                  href.refaddr:=addr_gotpage;
-                list.concat(taicpu.op_reg_ref(A_ADRP,preferred_newbasereg,href));
-                { load the GOT entry (= address of the variable) }
-                reference_reset_base(href,preferred_newbasereg,0,sizeof(pint));
-                href.symbol:=ref.symbol;
-                { code symbols defined in the current compilation unit do not
-                  have to be accessed via the GOT }
-                if ((ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) and
-                    (ref.symbol.bind in [AB_LOCAL,AB_GLOBAL])) or
-                   ((ref.symbol.typ=AT_DATA) and
-                    (ref.symbol.bind=AB_LOCAL)) then
-                  begin
-                    href.base:=NR_NO;
-                    href.refaddr:=addr_pageoffset;
-                    list.concat(taicpu.op_reg_reg_ref(A_ADD,preferred_newbasereg,preferred_newbasereg,href));
-                  end
-                else
-                  begin
-                    href.refaddr:=addr_gotpageoffset;
-                    { use a_load_ref_reg() rather than directly encoding the LDR,
-                      so that we'll check the validity of the reference }
-                    a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,preferred_newbasereg);
-                  end;
-                { set as new base register }
-                if ref.base=NR_NO then
-                  ref.base:=preferred_newbasereg
-                else if ref.index=NR_NO then
-                  ref.index:=preferred_newbasereg
-                else
-                  begin
-                    { make sure it's valid in case ref.base is SP -> make it
-                      the second operand}
-                    a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,preferred_newbasereg,ref.base,preferred_newbasereg);
-                    ref.base:=preferred_newbasereg
-                  end;
-                ref.symbol:=nil;
+                href.base:=NR_NO;
+                href.refaddr:=addr_pageoffset;
+                list.concat(taicpu.op_reg_reg_ref(A_ADD,preferred_newbasereg,preferred_newbasereg,href));
               end
             else
-              { todo }
-              internalerror(2014111003);
+              begin
+                href.refaddr:=addr_gotpageoffset;
+                { use a_load_ref_reg() rather than directly encoding the LDR,
+                  so that we'll check the validity of the reference }
+                a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,preferred_newbasereg);
+              end;
+            { set as new base register }
+            if ref.base=NR_NO then
+              ref.base:=preferred_newbasereg
+            else if ref.index=NR_NO then
+              ref.index:=preferred_newbasereg
+            else
+              begin
+                { make sure it's valid in case ref.base is SP -> make it
+                  the second operand}
+                a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,preferred_newbasereg,ref.base,preferred_newbasereg);
+                ref.base:=preferred_newbasereg
+              end;
+            ref.symbol:=nil;
           end;
 
         { base & index }
@@ -1110,7 +1103,7 @@ implementation
         list.Concat(taicpu.op_reg_reg_reg_cond(A_CSINV,dst,dst,makeregsize(NR_XZR,dstsize),C_NE));
         { mask the -1 to 255 if src was 0 (anyone find a two-instruction
           branch-free version? All of mine are 3...) }
-        list.Concat(setoppostfix(taicpu.op_reg_reg(A_UXT,dst,dst),PF_B));
+        list.Concat(setoppostfix(taicpu.op_reg_reg(A_UXT,makeregsize(dst,OS_32),makeregsize(dst,OS_32)),PF_B));
       end;
 
 
@@ -1631,9 +1624,7 @@ implementation
 
     procedure tcgaarch64.g_maybe_got_init(list : TAsmList);
       begin
-        { nothing to do on Darwin; check on ELF targets }
-        if not(target_info.system in systems_darwin) then
-          internalerror(2014112601);
+        { nothing to do on Darwin or Linux }
       end;
 
 

compiler/aarch64/cpubase.pas

@@ -429,7 +429,7 @@ unit cpubase;
 
     function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
       begin
-        is_calljmp:=o in [A_B,A_BL,A_BLR,A_RET,A_CBNZ,A_CBZ];
+        is_calljmp:=o in [A_B,A_BL,A_BLR,A_RET,A_CBNZ,A_CBZ,A_TBNZ,A_TBZ];
       end;
 
 

compiler/aarch64/cpupara.pas

@@ -318,7 +318,7 @@ unit cpupara;
                 hp.paraloc[side].size:=OS_ADDR;
                 hp.paraloc[side].alignment:=voidpointertype.alignment;
                 hp.paraloc[side].intsize:=voidpointertype.size;
-                hp.paraloc[side].def:=getpointerdef(hp.vardef);
+                hp.paraloc[side].def:=cpointerdef.getreusable(hp.vardef);
                 with hp.paraloc[side].add_location^ do
                   begin
                     size:=OS_ADDR;
@@ -397,7 +397,7 @@ unit cpupara;
 
         if push_addr_param(varspez,paradef,p.proccalloption) then
           begin
-            paradef:=getpointerdef(paradef);
+            paradef:=cpointerdef.getreusable(paradef);
             loc:=LOC_REGISTER;
             paracgsize:=OS_ADDR;
             paralen:=tcgsize2size[OS_ADDR];

compiler/aarch64/cputarg.pas

@@ -36,7 +36,7 @@ implementation
 **************************************}
 
     {$ifndef NOTARGETLINUX}
-//      ,t_linux
+      ,t_linux
     {$endif}
     {$ifndef NOTARGETBSD}
       ,t_bsd

compiler/aarch64/ncpucnv.pas

@@ -163,6 +163,10 @@ implementation
        exit;
 
       case left.location.loc of
+        LOC_SUBSETREG,
+        LOC_CSUBSETREG,
+        LOC_SUBSETREF,
+        LOC_CSUBSETREF,
         LOC_CREFERENCE,
         LOC_REFERENCE,
         LOC_REGISTER,

compiler/aarch64/symcpu.pas

@@ -94,6 +94,9 @@ type
   tcpuunitsym = class(tunitsym)
   end;
 
+  tcpuprogramparasym = class(tprogramparasym)
+  end;
+
   tcpunamespacesym = class(tnamespacesym)
   end;
 
@@ -162,6 +165,7 @@ begin
   { used tsym classes }
   clabelsym:=tcpulabelsym;
   cunitsym:=tcpuunitsym;
+  cprogramparasym:=tcpuprogramparasym;
   cnamespacesym:=tcpunamespacesym;
   cprocsym:=tcpuprocsym;
   ctypesym:=tcputypesym;

compiler/aasmcnst.pas

@@ -52,11 +52,13 @@ type
 
    { a simple data element; the value is stored as a tai }
    tai_simpletypedconst = class(tai_abstracttypedconst)
+   private
+     procedure setval(AValue: tai);
     protected
      fval: tai;
     public
      constructor create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
-     property val: tai read fval;
+     property val: tai read fval write setval;
    end;
 
 
@@ -118,8 +120,10 @@ type
    { information about aggregates we are parsing }
    taggregateinformation = class
     private
+     fnextfieldname: TIDString;
      function getcuroffset: asizeint;
      function getfieldoffset(l: longint): asizeint;
+     procedure setnextfieldname(AValue: TIDString);
     protected
      { type of the aggregate }
      fdef: tdef;
@@ -151,12 +155,13 @@ type
      constructor create(_def: tdef; _typ: ttypedconstkind); virtual;
      { calculated padding bytes for alignment if needed, and add the def of the
        next field in case we are constructing an anonymous record }
-     function prepare_next_field(nextfielddef: tdef): asizeint;
+     function prepare_next_field(nextfielddef: tdef): asizeint; virtual;
 
      property def: tdef read fdef;
      property typ: ttypedconstkind read ftyp;
      property curfield: tfieldvarsym read fcurfield write fcurfield;
      property nextfield: tfieldvarsym read fnextfield write fnextfield;
+     property nextfieldname: TIDString write setnextfieldname;
      property fieldoffset[l: longint]: asizeint read getfieldoffset;
      property curoffset: asizeint read getcuroffset;
      property anonrecord: boolean read fanonrecord write fanonrecord;
@@ -172,6 +177,7 @@ type
     private
      function getcurragginfo: taggregateinformation;
      procedure set_next_field(AValue: tfieldvarsym);
+     procedure set_next_field_name(AValue: TIDString);
     protected
      { temporary list in which all data is collected }
      fasmlist: tasmlist;
@@ -181,6 +187,7 @@ type
      { while queueing elements of a compound expression, this is the current
        offset in the top-level array/record }
      fqueue_offset: asizeint;
+     fqueued_def: tdef;
 
      { array of caggregateinformation instances }
      faggregateinformation: tfpobjectlist;
@@ -267,6 +274,7 @@ type
      procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); virtual;
 
     protected
+     procedure maybe_emit_tail_padding(def: tdef); virtual;
      function emit_string_const_common(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel):tasmlabofs;
      procedure begin_aggregate_internal(def: tdef; anonymous: boolean); virtual;
      procedure end_aggregate_internal(def: tdef; anonymous: boolean); virtual;
@@ -306,8 +314,17 @@ type
         a) it's definitely a record
         b) the def of the record should be automatically constructed based on
            the types of the emitted fields
+
+        packrecords: same as "pacrecords x"
+        recordalign: specify the (minimum) alignment of the start of the record
+          (no equivalent in source code), used as an alternative for explicit
+          align statements. Use "1" if it should be calculated based on the
+          fields
+        recordalignmin: same as "codealign recordmin=x"
+        maxcrecordalign: specify maximum C record alignment (no equivalent in
+          source code)
      }
-     function begin_anonymous_record(const optionalname: string; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
+     function begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
      function end_anonymous_record: trecorddef; virtual;
 
      { The next group of routines are for constructing complex expressions.
@@ -321,10 +338,11 @@ type
      procedure queue_vecn(def: tdef; const index: tconstexprint); virtual;
      { queue a subscripting operation }
      procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); virtual;
+     { queue indexing a record recursively via several field names. The fields
+       are specified in the inner to outer order (i.e., def.field1.field2) }
+     function queue_subscriptn_multiple_by_name(def: tabstractrecorddef; const fields: array of TIDString): tdef;
      { queue a type conversion operation }
      procedure queue_typeconvn(fromdef, todef: tdef); virtual;
-     { queue an address taking operation }
-     procedure queue_addrn(fromdef, todef: tdef); virtual;
      { finalise the queue (so a new one can be created) and flush the
         previously queued operations, applying them in reverse order on a...}
      { ... procdef }
@@ -339,6 +357,11 @@ type
      procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); virtual;
      { ... an ordinal constant }
      procedure queue_emit_ordconst(value: int64; def: tdef); virtual;
+    protected
+     { returns whether queue_init has been called without a corresponding
+       queue_emit_* to finish it }
+     function queue_is_active: boolean;
+    public
 
      { finalize the internal asmlist (if necessary) and return it.
        This asmlist will be freed when the builder is destroyed, so add its
@@ -357,6 +380,9 @@ type
        initialised. Also in case of objects, because the fieldvarsyms are spread
        over the symtables of the entire inheritance tree }
      property next_field: tfieldvarsym write set_next_field;
+     { set the name of the next field that will be emitted for an anonymous
+       record (or the next of the next started anonymous record) }
+     property next_field_name: TIDString write set_next_field_name;
     protected
      { this one always return the actual offset, called by the above (and
        overridden versions) }
@@ -387,6 +413,7 @@ implementation
 
    uses
      verbose,globals,systems,widestr,
+     fmodule,
      symbase,symtable,defutil;
 
 {****************************************************************************
@@ -418,6 +445,15 @@ implementation
       end;
 
 
+    procedure taggregateinformation.setnextfieldname(AValue: TIDString);
+      begin
+        if (fnextfieldname<>'') or
+           not anonrecord then
+          internalerror(2015071503);
+        fnextfieldname:=AValue;
+      end;
+
+
     constructor taggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
       begin
         fdef:=_def;
@@ -451,12 +487,18 @@ implementation
             { if we are constructing this record as data gets emitted, add a field
               for this data }
             if anonrecord then
-              trecorddef(def).add_field_by_def(nextfielddef);
+              begin
+                trecorddef(def).add_field_by_def(fnextfieldname,nextfielddef);
+                fnextfieldname:='';
+              end
+            else if fnextfieldname<>'' then
+              internalerror(2015071501);
             { find next field }
             i:=curindex;
             repeat
               inc(i);
-            until tsym(tabstractrecorddef(def).symtable.symlist[i]).typ=fieldvarsym;
+            until (tsym(tabstractrecorddef(def).symtable.symlist[i]).typ=fieldvarsym) and
+              not(sp_static in tsym(tabstractrecorddef(def).symtable.symlist[i]).symoptions);
             nextoffset:=fieldoffset[i];
             currentoffset:=curoffset;
             curindex:=i;
@@ -491,6 +533,12 @@ implementation
                                 tai_simpletypedconst
  ****************************************************************************}
 
+    procedure tai_simpletypedconst.setval(AValue: tai);
+      begin
+        fval:=AValue;
+      end;
+
+
    constructor tai_simpletypedconst.create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
      begin
        inherited create(_adetyp,_def);
@@ -646,7 +694,7 @@ implementation
            if fvalues.count<>1 then
              internalerror(2014070105);
            tai_simpletypedconst(fvalues[0]).fdef:=
-             getarraydef(cansichartype,
+             carraydef.getreusable(cansichartype,
                tai_string(tai_simpletypedconst(fvalues[0]).val).len);
          end;
      end;
@@ -684,6 +732,17 @@ implementation
      end;
 
 
+    procedure ttai_typedconstbuilder.set_next_field_name(AValue: TIDString);
+      var
+        info: taggregateinformation;
+      begin
+        info:=curagginfo;
+        if not assigned(info) then
+          internalerror(2015071502);
+        info.nextfieldname:='$'+AValue;
+      end;
+
+
    procedure ttai_typedconstbuilder.pad_next_field(nextfielddef: tdef);
      var
        fillbytes: asizeint;
@@ -755,6 +814,11 @@ implementation
      var
        prelist: tasmlist;
      begin
+       { have we finished all aggregates? }
+       if (getcurragginfo<>nil) and
+          { in case of syntax errors, the aggregate may not have been finished }
+          (ErrorCount=0) then
+         internalerror(2015072301);
        prelist:=tasmlist.create;
        { only now add items based on the symbolname, because it may be
          modified by the "section" specifier in case of a typed constant }
@@ -976,8 +1040,10 @@ implementation
          an anonymous record also add the next field }
        if assigned(info) then
          begin
-           if ((info.def.typ=recorddef) or
-               is_object(info.def)) and
+           { queue_init already adds padding }
+           if not queue_is_active and
+               (is_record(info.def) or
+                is_object(info.def)) and
               { may add support for these later }
               not is_packed_record_or_object(info.def) then
              pad_next_field(def);
@@ -994,6 +1060,30 @@ implementation
      end;
 
 
+   procedure ttai_typedconstbuilder.maybe_emit_tail_padding(def: tdef);
+     var
+       info: taggregateinformation;
+       fillbytes: asizeint;
+     begin
+       info:=curagginfo;
+       if not assigned(info) then
+         internalerror(2014091002);
+       if def<>info.def then
+         internalerror(2014091205);
+       if (is_record(def) or
+           is_object(def)) and
+          not is_packed_record_or_object(def) then
+         begin
+           fillbytes:=def.size-info.curoffset;
+           while fillbytes>0 do
+             begin
+               do_emit_tai(Tai_const.Create_8bit(0),u8inttype);
+               dec(fillbytes)
+             end;
+         end;
+     end;
+
+
    function ttai_typedconstbuilder.emit_string_const_common(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel): tasmlabofs;
      var
        string_symofs: asizeint;
@@ -1004,7 +1094,7 @@ implementation
        result.ofs:=0;
        { pack the data, so that we don't add unnecessary null bytes after the
          constant string }
-       begin_anonymous_record('$'+get_dynstring_rec_name(stringtype,false,len),1,1,1);
+       begin_anonymous_record('$'+get_dynstring_rec_name(stringtype,false,len),1,sizeof(TConstPtrUInt),1,1);
        string_symofs:=get_string_symofs(stringtype,false);
        { encoding }
        emit_tai(tai_const.create_16bit(encoding),u16inttype);
@@ -1069,9 +1159,14 @@ implementation
          begin
            { add padding if necessary, and update the current field/offset }
            info:=curagginfo;
-           if is_record(curagginfo.def) or
-              is_object(curagginfo.def) then
-             pad_next_field(def);
+           if (is_record(curagginfo.def) or
+               is_object(curagginfo.def)) and
+              not is_packed_record_or_object(curagginfo.def) then
+             begin
+               if queue_is_active then
+                 internalerror(2015073001);
+               pad_next_field(def);
+             end;
          end
        { if this is the outer record, no padding is required; the alignment
          has to be specified explicitly in that case via get_final_asmlist() }
@@ -1087,30 +1182,15 @@ implementation
    procedure ttai_typedconstbuilder.end_aggregate_internal(def: tdef; anonymous: boolean);
      var
        info: taggregateinformation;
-       fillbytes: asizeint;
        tck: ttypedconstkind;
      begin
        tck:=aggregate_kind(def);
        if tck=tck_simple then
          exit;
-       info:=curagginfo;
-       if not assigned(info) then
-         internalerror(2014091002);
-       if def<>info.def then
-         internalerror(2014091205);
        { add tail padding if necessary }
-       if (is_record(def) or
-           is_object(def)) and
-          not is_packed_record_or_object(def) then
-         begin
-           fillbytes:=def.size-info.curoffset;
-           while fillbytes>0 do
-             begin
-               do_emit_tai(Tai_const.Create_8bit(0),u8inttype);
-               dec(fillbytes)
-             end;
-         end;
+       maybe_emit_tail_padding(def);
        { pop and free the information }
+       info:=curagginfo;
        faggregateinformation.count:=faggregateinformation.count-1;
        info.free;
      end;
@@ -1150,7 +1230,7 @@ implementation
        move(data^,s^,len);
        s[len]:=#0;
        { terminating zero included }
-       datadef:=getarraydef(cansichartype,len+1);
+       datadef:=carraydef.getreusable(cansichartype,len+1);
        datatcb.maybe_begin_aggregate(datadef);
        datatcb.emit_tai(tai_string.create_pchar(s,len+1),datadef);
        datatcb.maybe_end_aggregate(datadef);
@@ -1174,7 +1254,7 @@ implementation
          begin
            result.lab:=startlab;
            datatcb.begin_anonymous_record('$'+get_dynstring_rec_name(st_widestring,true,strlength),
-             4,
+             4,4,
              targetinfos[target_info.system]^.alignment.recordalignmin,
              targetinfos[target_info.system]^.alignment.maxCrecordalign);
            datatcb.emit_tai(Tai_const.Create_32bit(strlength*cwidechartype.size),s32inttype);
@@ -1199,7 +1279,7 @@ implementation
          end;
        if cwidechartype.size = 2 then
          begin
-           datadef:=getarraydef(cwidechartype,strlength+1);
+           datadef:=carraydef.getreusable(cwidechartype,strlength+1);
            datatcb.maybe_begin_aggregate(datadef);
            for i:=0 to strlength-1 do
              datatcb.emit_tai(Tai_const.Create_16bit(pcompilerwidestring(data)^.data[i]),cwidechartype);
@@ -1227,11 +1307,11 @@ implementation
          functionality in place yet to reuse shortstringdefs of the same length
          and neither the lowlevel nor the llvm typedconst builder cares about
          this difference }
-       result:=getarraydef(cansichartype,length(str)+1);
+       result:=carraydef.getreusable(cansichartype,length(str)+1);
        maybe_begin_aggregate(result);
        emit_tai(Tai_const.Create_8bit(length(str)),u8inttype);
        if str<>'' then
-         emit_tai(Tai_string.Create(str),getarraydef(cansichartype,length(str)));
+         emit_tai(Tai_string.Create(str),carraydef.getreusable(cansichartype,length(str)));
        maybe_end_aggregate(result);
      end;
 
@@ -1259,7 +1339,7 @@ implementation
 
    procedure ttai_typedconstbuilder.emit_procdef_const(pd: tprocdef);
      begin
-       emit_tai(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0),pd.getcopyas(procvardef,pc_address_only));
+       emit_tai(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd));
      end;
 
 
@@ -1292,33 +1372,29 @@ implementation
      end;
 
 
-   function ttai_typedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+   function ttai_typedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef;
      var
        anonrecorddef: trecorddef;
-       srsym: tsym;
-       srsymtable: tsymtable;
-       found: boolean;
+       typesym: ttypesym;
      begin
        { if the name is specified, we create a typesym with that name in order
          to ensure we can find it again later with that name -> reuse here as
          well if possible (and that also avoids duplicate type name issues) }
        if optionalname<>'' then
          begin
-           if optionalname[1]='$' then
-             found:=searchsym_type(copy(optionalname,2,length(optionalname)),srsym,srsymtable)
-           else
-             found:=searchsym_type(optionalname,srsym,srsymtable);
-           if found then
+           typesym:=try_search_current_module_type(optionalname);
+           if assigned(typesym) then
              begin
-               if ttypesym(srsym).typedef.typ<>recorddef then
-                 internalerror(2014091207);
-               result:=trecorddef(ttypesym(srsym).typedef);
+               if typesym.typedef.typ<>recorddef then
+                 internalerror(2015071401);
+               result:=trecorddef(typesym.typedef);
                maybe_begin_aggregate(result);
                exit;
              end;
          end;
        { create skeleton def }
        anonrecorddef:=crecorddef.create_global_internal(optionalname,packrecords,recordalignmin,maxcrecordalign);
+       trecordsymtable(anonrecorddef.symtable).recordalignment:=recordalign;
        { generic aggregate housekeeping }
        begin_aggregate_internal(anonrecorddef,true);
        { mark as anonymous record }
@@ -1355,11 +1431,27 @@ implementation
 
 
    procedure ttai_typedconstbuilder.queue_init(todef: tdef);
+     var
+       info: taggregateinformation;
      begin
        { nested call to init? }
        if fqueue_offset<>low(fqueue_offset) then
          internalerror(2014062101);
+
+       { insert padding bytes before starting the queue, so that the first
+         padding byte won't be interpreted as the emitted value for this queue }
+       info:=curagginfo;
+       if assigned(info) then
+         begin
+           if ((info.def.typ=recorddef) or
+               is_object(info.def)) and
+              { may add support for these later }
+              not is_packed_record_or_object(info.def) then
+             pad_next_field(todef);
+         end;
+
        fqueue_offset:=0;
+       fqueued_def:=todef;
      end;
 
 
@@ -1404,12 +1496,43 @@ implementation
      end;
 
 
-   procedure ttai_typedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
+   function ttai_typedconstbuilder.queue_subscriptn_multiple_by_name(def: tabstractrecorddef; const fields: array of TIDString): tdef;
+     var
+       syms,
+       parentdefs: tfplist;
+       sym: tsym;
+       curdef: tdef;
+       i: longint;
      begin
-       { do nothing }
+       result:=nil;
+       if length(fields)=0 then
+         internalerror(2015071601);
+       syms:=tfplist.Create;
+       syms.count:=length(fields);
+       parentdefs:=tfplist.create;
+       parentdefs.Count:=length(fields);
+       curdef:=def;
+       for i:=low(fields) to high(fields) do
+         begin
+           sym:=search_struct_member_no_helper(tabstractrecorddef(curdef),fields[i]);
+           if not assigned(sym) or
+              (sym.typ<>fieldvarsym) or
+              ((i<>high(fields)) and
+               not(tfieldvarsym(sym).vardef.typ in [objectdef,recorddef])) then
+             internalerror(2015071505);
+           syms[i]:=sym;
+           parentdefs[i]:=curdef;
+           curdef:=tfieldvarsym(sym).vardef;
+           result:=curdef;
+         end;
+       for i:=high(fields) downto low(fields) do
+         queue_subscriptn(tabstractrecorddef(parentdefs[i]),tfieldvarsym(syms[i]));
+       syms.free;
+       parentdefs.free;
      end;
 
-   procedure ttai_typedconstbuilder.queue_addrn(fromdef, todef: tdef);
+
+   procedure ttai_typedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
      begin
        { do nothing }
      end;
@@ -1426,9 +1549,9 @@ implementation
 
    procedure ttai_typedconstbuilder.queue_emit_staticvar(vs: tstaticvarsym);
      begin
-       { getpointerdef because we are emitting a pointer to the staticvarsym
+       { pointerdef because we are emitting a pointer to the staticvarsym
          data, not the data itself }
-       emit_tai(Tai_const.Createname(vs.mangledname,fqueue_offset),getpointerdef(vs.vardef));
+       emit_tai(Tai_const.Createname(vs.mangledname,fqueue_offset),cpointerdef.getreusable(vs.vardef));
        fqueue_offset:=low(fqueue_offset);
      end;
 
@@ -1454,13 +1577,14 @@ implementation
 
    procedure ttai_typedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
      begin
-       { getpointerdef, because "sym" represents the address of whatever the
+       { pointerdef, because "sym" represents the address of whatever the
          data is }
-       def:=getpointerdef(def);
+       def:=cpointerdef.getreusable(def);
        emit_tai(Tai_const.Create_sym_offset(sym,fqueue_offset),def);
        fqueue_offset:=low(fqueue_offset);
      end;
 
+
    procedure ttai_typedconstbuilder.queue_emit_ordconst(value: int64; def: tdef);
      begin
        emit_ord_const(value,def);
@@ -1468,6 +1592,12 @@ implementation
      end;
 
 
+   function ttai_typedconstbuilder.queue_is_active: boolean;
+     begin
+       result:=fqueue_offset<>low(fqueue_offset)
+     end;
+
+
 {****************************************************************************
                            tai_abstracttypedconst
  ****************************************************************************}

compiler/aasmtai.pas

@@ -253,6 +253,7 @@ interface
        { llvm only }
        ,top_single
        ,top_double
+       ,top_undef
 {$ifdef cpuextended}
        ,top_extended80
 {$endif cpuextended}
@@ -433,6 +434,7 @@ interface
         {$ifdef llvm}
             top_single : (sval:single);
             top_double : (dval:double);
+            top_undef :  ();
           {$ifdef cpuextended}
             top_extended80 : (eval:extended);
           {$endif cpuextended}
@@ -574,7 +576,7 @@ interface
           is_global : boolean;
           sym       : tasmsymbol;
           size      : asizeint;
-          constructor Create(const _name : string;_size : aint);
+          constructor Create(const _name : string;_size : asizeint);
           constructor Create_global(const _name : string;_size : asizeint);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -1246,7 +1248,7 @@ implementation
                              TAI_DATABLOCK
  ****************************************************************************}
 
-    constructor tai_datablock.Create(const _name : string;_size : aint);
+    constructor tai_datablock.Create(const _name : string;_size : asizeint);
 
       begin
          inherited Create;

compiler/aggas.pas

@@ -26,6 +26,8 @@ unit aggas;
 
 {$i fpcdefs.inc}
 
+{ $define DEBUG_AGGAS}
+
 interface
 
     uses
@@ -1261,10 +1263,18 @@ implementation
 
            ait_force_line,
            ait_function_name :
-             ;
+             begin
+{$ifdef DEBUG_AGGAS}
+               WriteStr(s,hp.typ);
+               AsmWriteLn('# '+s);
+{$endif DEBUG_AGGAS}
+             end;
 
            ait_cutobject :
              begin
+{$ifdef DEBUG_AGGAS}
+               AsmWriteLn('# ait_cutobject');
+{$endif DEBUG_AGGAS}
                if SmartAsm then
                 begin
                 { only reset buffer if nothing has changed }
@@ -1290,10 +1300,16 @@ implementation
              end;
 
            ait_marker :
-             if tai_marker(hp).kind=mark_NoLineInfoStart then
-               inc(InlineLevel)
-             else if tai_marker(hp).kind=mark_NoLineInfoEnd then
-               dec(InlineLevel);
+             begin
+{$ifdef DEBUG_AGGAS}
+               WriteStr(s,tai_marker(hp).Kind);
+               AsmWriteLn('# ait_marker, kind: '+s);
+{$endif DEBUG_AGGAS}
+               if tai_marker(hp).kind=mark_NoLineInfoStart then
+                 inc(InlineLevel)
+               else if tai_marker(hp).kind=mark_NoLineInfoEnd then
+                 dec(InlineLevel);
+             end;
 
            ait_directive :
              begin
@@ -1333,6 +1349,7 @@ implementation
                AsmLn;
 {$endif DISABLE_WIN64_SEH}
              end;
+
            ait_varloc:
              begin
                if tai_varloc(hp).newlocationhi<>NR_NO then

compiler/agjasmin.pas

@@ -1,1232 +0,0 @@
-{
-    Copyright (c) 1998-2010 by the Free Pascal team
-
-    This unit implements the Jasmin assembler writer
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{ Unit for writing Jasmin assembler (JVM bytecode) output.
-}
-unit agjasmin;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      cclasses,
-      globtype,globals,
-      symconst,symbase,symdef,symsym,
-      aasmbase,aasmtai,aasmdata,aasmcpu,
-      assemble;
-
-    type
-      TJasminInstrWriter = class;
-      {# This is a derived class which is used to write
-         Jasmin-styled assembler.
-      }
-
-      { TJasminAssembler }
-
-      TJasminAssembler=class(texternalassembler)
-       protected
-        jasminjar: tcmdstr;
-        asmfiles: TCmdStrList;
-
-        procedure WriteExtraHeader(obj: tabstractrecorddef);
-        procedure WriteInstruction(hp: tai);
-        procedure NewAsmFileForStructDef(obj: tabstractrecorddef);
-
-        function VisibilityToStr(vis: tvisibility): ansistring;
-        function MethodDefinition(pd: tprocdef): ansistring;
-        function ConstValue(csym: tconstsym): ansistring;
-        function ConstAssignmentValue(csym: tconstsym): ansistring;
-        function ConstDefinition(sym: tconstsym): ansistring;
-        function FieldDefinition(sym: tabstractvarsym): ansistring;
-        function InnerStructDef(obj: tabstractrecorddef): ansistring;
-
-        procedure WriteProcDef(pd: tprocdef);
-        procedure WriteFieldSym(sym: tabstractvarsym);
-        procedure WriteConstSym(sym: tconstsym);
-        procedure WriteSymtableVarSyms(st: TSymtable);
-        procedure WriteSymtableProcdefs(st: TSymtable);
-        procedure WriteSymtableStructDefs(st: TSymtable);
-       public
-        constructor Create(smart: boolean); override;
-        function MakeCmdLine: TCmdStr;override;
-        procedure WriteTree(p:TAsmList);override;
-        procedure WriteAsmList;override;
-        procedure RemoveAsm; override;
-        destructor destroy; override;
-       protected
-        InstrWriter: TJasminInstrWriter;
-      end;
-
-
-      {# This is the base class for writing instructions.
-
-         The WriteInstruction() method must be overridden
-         to write a single instruction to the assembler
-         file.
-      }
-
-      { TJasminInstrWriter }
-
-      TJasminInstrWriter = class
-        constructor create(_owner: TJasminAssembler);
-        procedure WriteInstruction(hp : tai); virtual;
-       protected
-        owner: TJasminAssembler;
-      end;
-
-
-implementation
-
-    uses
-      SysUtils,
-      cutils,cfileutl,systems,script,
-      fmodule,finput,verbose,
-      symtype,symcpu,symtable,jvmdef,
-      itcpujas,cpubase,cpuinfo,cgutils,
-      widestr
-      ;
-
-    const
-      line_length = 70;
-
-    type
-      t64bitarray = array[0..7] of byte;
-      t32bitarray = array[0..3] of byte;
-
-{****************************************************************************}
-{                          Support routines                                  }
-{****************************************************************************}
-
-   function fixline(s:string):string;
-   {
-     return s with all leading and ending spaces and tabs removed
-   }
-     var
-       i,j,k : integer;
-     begin
-       i:=length(s);
-       while (i>0) and (s[i] in [#9,' ']) do
-        dec(i);
-       j:=1;
-       while (j<i) and (s[j] in [#9,' ']) do
-        inc(j);
-       for k:=j to i do
-        if s[k] in [#0..#31,#127..#255] then
-         s[k]:='.';
-       fixline:=Copy(s,j,i-j+1);
-     end;
-
-
-   function constastr(p: pchar; len: longint): ansistring;
-     var
-       i,runstart,runlen: longint;
-
-       procedure flush;
-         begin
-           if runlen>0 then
-             begin
-               setlength(result,length(result)+runlen);
-               move(p[runstart],result[length(result)-runlen+1],runlen);
-               runlen:=0;
-             end;
-         end;
-
-     begin
-       result:='"';
-       runlen:=0;
-       runstart:=0;
-       for i:=0 to len-1 do
-         begin
-           { escape control codes }
-           case p[i] of
-             { LF and CR must be escaped specially, because \uXXXX parsing
-               happens in the pre-processor, so it's the same as actually
-               inserting a newline in the middle of a string constant }
-             #10:
-               begin
-                 flush;
-                 result:=result+'\n';
-               end;
-             #13:
-               begin
-                 flush;
-                 result:=result+'\r';
-               end;
-             '"','\':
-               begin
-                 flush;
-                 result:=result+'\'+p[i];
-               end
-             else if p[i]<#32 then
-               begin
-                 flush;
-                 result:=result+'\u'+hexstr(ord(p[i]),4);
-               end
-             else if p[i]<#127 then
-               begin
-                 if runlen=0 then
-                   runstart:=i;
-                 inc(runlen);
-               end
-             else
-               begin
-                 { see comments in njvmcon }
-                 flush;
-                 result:=result+'\u'+hexstr(ord(p[i]),4)
-               end;
-           end;
-         end;
-       flush;
-       result:=result+'"';
-     end;
-
-
-   function constwstr(w: pcompilerwidechar; len: longint): ansistring;
-     var
-       i: longint;
-     begin
-       result:='"';
-       for i:=0 to len-1 do
-         begin
-           { escape control codes }
-           case w[i] of
-             10:
-               result:=result+'\n';
-             13:
-               result:=result+'\r';
-             ord('"'),ord('\'):
-               result:=result+'\'+chr(w[i]);
-             else if (w[i]<32) or
-                (w[i]>=127) then
-               result:=result+'\u'+hexstr(w[i],4)
-             else
-               result:=result+char(w[i]);
-           end;
-         end;
-       result:=result+'"';
-     end;
-
-
-   function constsingle(s: single): ansistring;
-     begin
-       result:='0fx'+hexstr(longint(t32bitarray(s)),8);
-     end;
-
-
-   function constdouble(d: double): ansistring;
-      begin
-        // force interpretation as double (since we write it out as an
-        // integer, we never have to swap the endianess). We have to
-        // include the sign separately because of the way Java parses
-        // hex numbers (0x8000000000000000 is not a valid long)
-       result:=hexstr(abs(int64(t64bitarray(d))),16);
-       if int64(t64bitarray(d))<0 then
-         result:='-'+result;
-       result:='0dx'+result;
-      end;
-
-{****************************************************************************}
-{                       Jasmin Assembler writer                              }
-{****************************************************************************}
-
-    destructor TJasminAssembler.Destroy;
-      begin
-        InstrWriter.free;
-        asmfiles.free;
-        inherited destroy;
-      end;
-
-
-    procedure TJasminAssembler.WriteTree(p:TAsmList);
-      var
-        ch       : char;
-        hp       : tai;
-        hp1      : tailineinfo;
-        s        : ansistring;
-        i,pos    : longint;
-        InlineLevel : longint;
-        do_line  : boolean;
-      begin
-        if not assigned(p) then
-         exit;
-
-        InlineLevel:=0;
-        { lineinfo is only needed for al_procedures (PFV) }
-        do_line:=(cs_asm_source in current_settings.globalswitches);
-        hp:=tai(p.first);
-        while assigned(hp) do
-         begin
-           prefetch(pointer(hp.next)^);
-           if not(hp.typ in SkipLineInfo) then
-            begin
-              hp1 := hp as tailineinfo;
-              current_filepos:=hp1.fileinfo;
-               { no line info for inlined code }
-               if do_line and (inlinelevel=0) then
-                begin
-                  { load infile }
-                  if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
-                   begin
-                     infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
-                     if assigned(infile) then
-                      begin
-                        { open only if needed !! }
-                        if (cs_asm_source in current_settings.globalswitches) then
-                         infile.open;
-                      end;
-                     { avoid unnecessary reopens of the same file !! }
-                     lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
-                     { be sure to change line !! }
-                     lastfileinfo.line:=-1;
-                   end;
-
-                { write source }
-                  if (cs_asm_source in current_settings.globalswitches) and
-                     assigned(infile) then
-                   begin
-                     if (infile<>lastinfile) then
-                       begin
-                         AsmWriteLn(target_asm.comment+'['+infile.name+']');
-                         if assigned(lastinfile) then
-                           lastinfile.close;
-                       end;
-                     if (hp1.fileinfo.line<>lastfileinfo.line) and
-                        ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
-                       begin
-                         if (hp1.fileinfo.line<>0) and
-                            ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
-                           AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
-                             fixline(infile.GetLineStr(hp1.fileinfo.line)));
-                         { set it to a negative value !
-                         to make that is has been read already !! PM }
-                         if (infile.linebuf^[hp1.fileinfo.line]>=0) then
-                           infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
-                       end;
-                   end;
-                  lastfileinfo:=hp1.fileinfo;
-                  lastinfile:=infile;
-                end;
-            end;
-
-           case hp.typ of
-
-             ait_comment :
-               Begin
-                 AsmWrite(target_asm.comment);
-                 AsmWritePChar(tai_comment(hp).str);
-                 AsmLn;
-               End;
-
-             ait_regalloc :
-               begin
-                 if (cs_asm_regalloc in current_settings.globalswitches) then
-                   begin
-                     AsmWrite(#9+target_asm.comment+'Register ');
-                     repeat
-                       AsmWrite(std_regname(Tai_regalloc(hp).reg));
-                       if (hp.next=nil) or
-                          (tai(hp.next).typ<>ait_regalloc) or
-                          (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
-                         break;
-                       hp:=tai(hp.next);
-                       AsmWrite(',');
-                     until false;
-                     AsmWrite(' ');
-                     AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
-                   end;
-               end;
-
-             ait_tempalloc :
-               begin
-                 if (cs_asm_tempalloc in current_settings.globalswitches) then
-                   begin
-  {$ifdef EXTDEBUG}
-                     if assigned(tai_tempalloc(hp).problem) then
-                       AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
-                         tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
-                     else
-  {$endif EXTDEBUG}
-                       AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
-                         tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]);
-                   end;
-               end;
-
-             ait_align :
-               begin
-
-               end;
-
-             ait_section :
-               begin
-
-               end;
-
-             ait_datablock :
-               begin
-                 internalerror(2010122701);
-               end;
-
-             ait_const:
-               begin
-                 AsmWriteln('constant');
-//                 internalerror(2010122702);
-               end;
-
-             ait_realconst :
-               begin
-                 internalerror(2010122703);
-               end;
-
-             ait_string :
-               begin
-                 pos:=0;
-                  for i:=1 to tai_string(hp).len do
-                   begin
-                     if pos=0 then
-                      begin
-                        AsmWrite(#9'strconst: '#9'"');
-                        pos:=20;
-                      end;
-                     ch:=tai_string(hp).str[i-1];
-                     case ch of
-                        #0, {This can't be done by range, because a bug in FPC}
-                   #1..#31,
-                #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
-                       '"' : s:='\"';
-                       '\' : s:='\\';
-                     else
-                      s:=ch;
-                     end;
-                     AsmWrite(s);
-                     inc(pos,length(s));
-                     if (pos>line_length) or (i=tai_string(hp).len) then
-                      begin
-                        AsmWriteLn('"');
-                        pos:=0;
-                      end;
-                   end;
-               end;
-
-             ait_label :
-               begin
-                 if (tai_label(hp).labsym.is_used) then
-                  begin
-                    AsmWrite(tai_label(hp).labsym.name);
-                    AsmWriteLn(':');
-                  end;
-               end;
-
-             ait_symbol :
-               begin
-                  if (tai_symbol(hp).sym.typ = AT_FUNCTION) then
-                    begin
-                    end
-                  else
-                   begin
-                     AsmWrite('data symbol: ');
-                     AsmWriteln(tai_symbol(hp).sym.name);
-//                     internalerror(2010122706);
-                   end;
-               end;
-             ait_symbol_end :
-               begin
-               end;
-
-             ait_instruction :
-               begin
-                 WriteInstruction(hp);
-               end;
-
-             ait_force_line,
-             ait_function_name : ;
-
-             ait_cutobject :
-               begin
-               end;
-
-             ait_marker :
-               if tai_marker(hp).kind=mark_NoLineInfoStart then
-                 inc(InlineLevel)
-               else if tai_marker(hp).kind=mark_NoLineInfoEnd then
-                 dec(InlineLevel);
-
-             ait_directive :
-               begin
-                 AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
-                 if tai_directive(hp).name<>'' then
-                   AsmWrite(tai_directive(hp).name);
-                 AsmLn;
-               end;
-
-             ait_jvar:
-               begin
-                 AsmWrite('.var ');
-                 AsmWrite(tostr(tai_jvar(hp).stackslot));
-                 AsmWrite(' is ');
-                 AsmWrite(tai_jvar(hp).desc^);
-                 AsmWrite(' from ');
-                 AsmWrite(tai_jvar(hp).startlab.name);
-                 AsmWrite(' to ');
-                 AsmWriteLn(tai_jvar(hp).stoplab.name);
-               end;
-
-             ait_jcatch:
-               begin
-                 AsmWrite('.catch ');
-                 AsmWrite(tai_jcatch(hp).name^);
-                 AsmWrite(' from ');
-                 AsmWrite(tai_jcatch(hp).startlab.name);
-                 AsmWrite(' to ');
-                 AsmWrite(tai_jcatch(hp).stoplab.name);
-                 AsmWrite(' using ');
-                 AsmWriteLn(tai_jcatch(hp).handlerlab.name);
-               end;
-             else
-               internalerror(2010122707);
-           end;
-           hp:=tai(hp.next);
-         end;
-      end;
-
-
-    procedure TJasminAssembler.WriteExtraHeader(obj: tabstractrecorddef);
-      var
-        superclass,
-        intf: tobjectdef;
-        n: ansistring;
-        i: longint;
-        toplevelowner: tsymtable;
-      begin
-        superclass:=nil;
-
-        { JVM 1.5+ }
-        AsmWriteLn('.bytecode 49.0');
-        // include files are not support by Java, and the directory of the main
-        // source file must not be specified
-        if current_module.mainsource<>'' then
-          n:=ExtractFileName(current_module.mainsource)
-        else
-          n:=InputFileName;
-        AsmWriteLn('.source '+ExtractFileName(n));
-
-        { class/interface name }
-        if not assigned(obj) then
-          begin
-            { fake class type for unit -> name=unitname and
-              superclass=java.lang.object, make final so you cannot descend
-              from it }
-            AsmWrite('.class final public ');
-            if assigned(current_module.namespace) then
-              AsmWrite(current_module.namespace^+'.');
-            AsmWriteln(current_module.realmodulename^);
-            AsmWriteLn('.super java/lang/Object');
-          end
-        else
-          begin
-            toplevelowner:=obj.owner;
-            while not(toplevelowner.symtabletype in [staticsymtable,globalsymtable]) do
-              toplevelowner:=toplevelowner.defowner.owner;
-            case obj.typ of
-              recorddef:
-                begin
-                  { can't inherit from records }
-                  AsmWrite('.class final ');
-                  if toplevelowner.symtabletype=globalsymtable then
-                    AsmWrite('public ');
-                  AsmWriteln(obj.jvm_full_typename(true));
-                  superclass:=java_fpcbaserecordtype;
-                end;
-              objectdef:
-                begin
-                  case tobjectdef(obj).objecttype of
-                    odt_javaclass:
-                      begin
-                        AsmWrite('.class ');
-                        if oo_is_sealed in tobjectdef(obj).objectoptions then
-                          AsmWrite('final ');
-                        if (oo_is_abstract in tobjectdef(obj).objectoptions) or
-                           (tobjectdef(obj).abstractcnt<>0) then
-                          AsmWrite('abstract ');
-                        if toplevelowner.symtabletype=globalsymtable then
-                          AsmWrite('public ');
-                        if (oo_is_enum_class in tobjectdef(obj).objectoptions) then
-                          AsmWrite('enum ');
-                        AsmWriteln(obj.jvm_full_typename(true));
-                        superclass:=tobjectdef(obj).childof;
-                      end;
-                    odt_interfacejava:
-                      begin
-                        AsmWrite('.interface abstract ');
-                        if toplevelowner.symtabletype=globalsymtable then
-                          AsmWrite('public ');
-                        AsmWriteLn(obj.jvm_full_typename(true));
-                        { interfaces must always specify Java.lang.object as
-                          superclass }
-                        superclass:=java_jlobject;
-                      end
-                    else
-                      internalerror(2011010906);
-                  end;
-                end;
-            end;
-            { superclass }
-            if assigned(superclass) then
-              begin
-                AsmWrite('.super ');
-                if assigned(superclass.import_lib) then
-                  AsmWrite(superclass.import_lib^+'/');
-                AsmWriteln(superclass.objextname^);
-              end;
-            { implemented interfaces }
-            if (obj.typ=objectdef) and
-               assigned(tobjectdef(obj).ImplementedInterfaces) then
-              begin
-                for i:=0 to tobjectdef(obj).ImplementedInterfaces.count-1 do
-                  begin
-                    intf:=TImplementedInterface(tobjectdef(obj).ImplementedInterfaces[i]).IntfDef;
-                    AsmWrite('.implements ');
-                    AsmWriteLn(intf.jvm_full_typename(true));
-                  end;
-              end;
-            { signature for enum classes (must come after superclass and
-              implemented interfaces) }
-            if (obj.typ=objectdef) and
-               (oo_is_enum_class in tobjectdef(obj).objectoptions) then
-              AsmWriteln('.signature "Ljava/lang/Enum<L'+obj.jvm_full_typename(true)+';>;"');
-            { in case of nested class: relation to parent class }
-            if obj.owner.symtabletype in [objectsymtable,recordsymtable] then
-              AsmWriteln(InnerStructDef(obj));
-            { add all nested classes }
-            for i:=0 to obj.symtable.deflist.count-1 do
-              if (is_java_class_or_interface(tdef(obj.symtable.deflist[i])) or
-                  (tdef(obj.symtable.deflist[i]).typ=recorddef)) and
-                 not(df_generic in tdef(obj.symtable.deflist[i]).defoptions) then
-                AsmWriteln(InnerStructDef(tabstractrecorddef(obj.symtable.deflist[i])));
-          end;
-        AsmLn;
-      end;
-
-
-    procedure TJasminAssembler.WriteInstruction(hp: tai);
-      begin
-        InstrWriter.WriteInstruction(hp);
-      end;
-
-
-   function TJasminAssembler.MakeCmdLine: TCmdStr;
-     const
-       jasminjarname = 'jasmin.jar';
-     var
-       filenames: tcmdstr;
-       asmfile: tcmdstrlistitem;
-       jasminjarfound: boolean;
-     begin
-       if jasminjar='' then
-         begin
-           jasminjarfound:=false;
-           if utilsdirectory<>'' then
-             jasminjarfound:=FindFile(jasminjarname,utilsdirectory,false,jasminjar);
-           if not jasminjarfound then
-             jasminjarfound:=FindFileInExeLocations(jasminjarname,false,jasminjar);
-           if (not jasminjarfound) and not(cs_asm_extern in current_settings.globalswitches) then
-             begin
-               Message1(exec_e_assembler_not_found,jasminjarname);
-               current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
-             end;
-           if jasminjarfound then
-             Message1(exec_t_using_assembler,jasminjar);
-         end;
-       result:=target_asm.asmcmd;
-       filenames:=ScriptFixFileName(AsmFileName);
-       if cs_asm_extern in current_settings.globalswitches then
-         filenames:=maybequoted(filenames);
-       asmfile:=tcmdstrlistitem(asmfiles.First);
-       while assigned(asmfile) do
-         begin
-           if cs_asm_extern in current_settings.globalswitches then
-             filenames:=filenames+' '+maybequoted(ScriptFixFileName(asmfile.str))
-           else
-            filenames:=filenames+' '+ScriptFixFileName(asmfile.str);
-           asmfile:=tcmdstrlistitem(asmfile.next);
-        end;
-       Replace(result,'$ASM',filenames);
-       if (path<>'') then
-         if cs_asm_extern in current_settings.globalswitches then
-           Replace(result,'$OBJDIR',maybequoted(ScriptFixFileName(path)))
-         else
-           Replace(result,'$OBJDIR',ScriptFixFileName(path))
-       else
-         Replace(result,'$OBJDIR','.');
-       if cs_asm_extern in current_settings.globalswitches then
-         Replace(result,'$JASMINJAR',maybequoted(ScriptFixFileName(jasminjar)))
-       else
-         Replace(result,'$JASMINJAR',ScriptFixFileName(jasminjar));
-       Replace(result,'$EXTRAOPT',asmextraopt);
-     end;
-
-
-   procedure TJasminAssembler.NewAsmFileForStructDef(obj: tabstractrecorddef);
-      begin
-        if AsmSize<>AsmStartSize then
-          begin
-            AsmClose;
-            asmfiles.Concat(AsmFileName);
-          end
-        else
-          AsmClear;
-
-        AsmFileName:=obj.jvm_full_typename(false);
-        AsmFileName:=Path+FixFileName(AsmFileName)+target_info.asmext;
-        AsmCreate(cut_normal);
-      end;
-
-
-    function TJasminAssembler.VisibilityToStr(vis: tvisibility): ansistring;
-      begin
-        case vis of
-          vis_hidden,
-          vis_strictprivate:
-            result:='private ';
-          { protected in Java means "accessible by subclasses *and* by classes
-            in the same package" -> similar to regular "protected" in Pascal;
-            "strict protected" is actually more strict in Pascal than in Java,
-            but there's not much we can do about that }
-          vis_protected,
-          vis_strictprotected:
-            result:='protected ';
-          vis_private:
-            { pick default visibility = "package" visibility; required because
-              other classes in the same unit can also access these symbols }
-            result:='';
-          vis_public:
-            result:='public '
-          else
-            internalerror(2010122609);
-        end;
-      end;
-
-
-    function TJasminAssembler.MethodDefinition(pd: tprocdef): ansistring;
-      begin
-        result:=VisibilityToStr(pd.visibility);
-        if (pd.procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
-           (po_classmethod in pd.procoptions) then
-          result:=result+'static ';
-        if (po_abstractmethod in pd.procoptions) or
-           is_javainterface(tdef(pd.owner.defowner)) then
-          result:=result+'abstract ';
-        if (pd.procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
-           (po_finalmethod in pd.procoptions) or
-           (not(po_virtualmethod in pd.procoptions) and
-            not(po_classmethod in pd.procoptions) and
-            not(pd.proctypeoption in [potype_constructor,potype_class_constructor])) then
-          result:=result+'final ';
-        result:=result+tcpuprocdef(pd).jvmmangledbasename(false);
-      end;
-
-
-    function TJasminAssembler.ConstValue(csym: tconstsym): ansistring;
-      begin
-        case csym.consttyp of
-          constord:
-            { always interpret as signed value, because the JVM does not
-              support unsigned values }
-            case csym.constdef.size of
-              1:result:=tostr(shortint(csym.value.valueord.svalue));
-              2:result:=tostr(smallint(csym.value.valueord.svalue));
-              4:result:=tostr(longint(csym.value.valueord.svalue));
-              8:result:=tostr(csym.value.valueord.svalue);
-              else
-                internalerror(2014082050);
-            end;
-          conststring:
-            result:=constastr(pchar(csym.value.valueptr),csym.value.len);
-          constreal:
-            case tfloatdef(csym.constdef).floattype of
-              s32real:
-                result:=constsingle(pbestreal(csym.value.valueptr)^);
-              s64real:
-                result:=constdouble(pbestreal(csym.value.valueptr)^);
-              else
-                internalerror(2011021204);
-              end;
-          constset:
-            result:='TODO: add support for constant sets';
-          constpointer:
-            { can only be null, but that's the default value and should not
-              be written; there's no primitive type that can hold nill }
-            internalerror(2011021201);
-          constnil:
-            internalerror(2011021202);
-          constresourcestring:
-            result:='TODO: add support for constant resource strings';
-          constwstring:
-            result:=constwstr(pcompilerwidestring(csym.value.valueptr)^.data,pcompilerwidestring(csym.value.valueptr)^.len);
-          constguid:
-            result:='TODO: add support for constant guids';
-          else
-            internalerror(2011021205);
-        end;
-      end;
-
-
-    function TJasminAssembler.ConstAssignmentValue(csym: tconstsym): ansistring;
-      begin
-        result:='';
-        { nil is the default value -> don't write explicitly }
-        case csym.consttyp of
-          constpointer:
-            begin
-              if csym.value.valueordptr<>0 then
-                internalerror(2011021206);
-            end;
-          constnil:
-            ;
-        else
-          begin
-            { enums and sets are initialized as typed constants }
-            if not assigned(csym.constdef) or
-               not(csym.constdef.typ in [enumdef,setdef]) then
-              result:=' = '+ConstValue(csym);
-          end;
-        end;
-      end;
-
-
-    function TJasminAssembler.ConstDefinition(sym: tconstsym): ansistring;
-      begin
-        result:=VisibilityToStr(sym.visibility);
-        { formal constants are always class-level, not instance-level }
-        result:=result+'static final ';
-        if sp_internal in sym.symoptions then
-          result:=result+'synthetic ';
-        result:=result+jvmmangledbasename(sym,true);
-        result:=result+ConstAssignmentValue(tconstsym(sym));
-      end;
-
-
-    function TJasminAssembler.FieldDefinition(sym: tabstractvarsym): ansistring;
-      begin
-        case sym.typ of
-          staticvarsym:
-            begin
-              if sym.owner.symtabletype=globalsymtable then
-                result:='public '
-              else
-                { package visbility }
-                result:='';
-            end;
-          fieldvarsym,
-          absolutevarsym:
-            result:=VisibilityToStr(tstoredsym(sym).visibility);
-          else
-            internalerror(2011011204);
-        end;
-        if (sym.typ=staticvarsym) or
-           (sp_static in sym.symoptions) then
-          result:=result+'static ';
-        if sym.varspez in [vs_const,vs_final] then
-          result:=result+'final ';
-        if sp_internal in sym.symoptions then
-          result:=result+'synthetic ';
-        { mark the class fields of enum classes that contain the initialised
-          enum instances as "enum" (recognise them by the fact that their type
-          is the same as their parent class, and that this parent class is
-          marked as oo_is_enum_class) }
-        if assigned(sym.owner.defowner) and
-           (tdef(sym.owner.defowner).typ=objectdef) and
-           (oo_is_enum_class in tobjectdef(sym.owner.defowner).objectoptions) and
-           (sym.typ=staticvarsym) and
-           (tstaticvarsym(sym).vardef=tdef(sym.owner.defowner)) then
-          result:=result+'enum ';
-        result:=result+jvmmangledbasename(sym,true);
-      end;
-
-
-    function TJasminAssembler.InnerStructDef(obj: tabstractrecorddef): ansistring;
-      var
-        extname: pshortstring;
-        kindname: ansistring;
-      begin
-        if not(obj.owner.defowner.typ in [objectdef,recorddef]) then
-          internalerror(2011021701);
-        { Nested classes in the Pascal sense are equivalent to "static"
-          inner classes in Java -- will be changed when support for
-          Java-style non-static classes is added }
-        case obj.typ of
-          recorddef:
-            begin
-              kindname:='class static ';
-              extname:=obj.symtable.realname;
-            end;
-          objectdef:
-            begin
-              extname:=tobjectdef(obj).objextname;
-              case tobjectdef(obj).objecttype of
-                odt_javaclass:
-                  kindname:='class static ';
-                odt_interfacejava:
-                  kindname:='interface static abstract ';
-                else
-                  internalerror(2011021702);
-              end;
-            end;
-          else
-            internalerror(2011032809);
-        end;
-        result:=
-          '.inner '+
-          kindname+
-          VisibilityToStr(obj.typesym.visibility)+
-         extname^+
-         ' inner '+
-         obj.jvm_full_typename(true)+
-         ' outer '+
-         tabstractrecorddef(obj.owner.defowner).jvm_full_typename(true);
-      end;
-
-
-    procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
-      begin
-        if not assigned(tcpuprocdef(pd).exprasmlist) and
-           not(po_abstractmethod in pd.procoptions) and
-           (not is_javainterface(pd.struct) or
-            (pd.proctypeoption in [potype_unitinit,potype_unitfinalize])) then
-          exit;
-        AsmWrite('.method ');
-        AsmWriteln(MethodDefinition(pd));
-        if jvmtypeneedssignature(pd) then
-          begin
-            AsmWrite('.signature "');
-            AsmWrite(tcpuprocdef(pd).jvmmangledbasename(true));
-            AsmWriteln('"');
-          end;
-        WriteTree(tcpuprocdef(pd).exprasmlist);
-        AsmWriteln('.end method');
-        AsmLn;
-      end;
-
-
-    procedure TJasminAssembler.WriteFieldSym(sym: tabstractvarsym);
-      begin
-        { internal static field definition alias -> skip }
-        if (sym.owner.symtabletype in [recordsymtable,ObjectSymtable]) and
-           (sym.typ=staticvarsym) then
-          exit;
-        { external or threadvar definition -> no definition here }
-        if ([vo_is_external,vo_is_thread_var]*sym.varoptions)<>[] then
-          exit;
-        AsmWrite('.field ');
-        AsmWriteln(FieldDefinition(sym));
-      end;
-
-
-    procedure TJasminAssembler.WriteConstSym(sym: tconstsym);
-      begin
-        AsmWrite('.field ');
-        AsmWriteln(ConstDefinition(sym));
-      end;
-
-
-    procedure TJasminAssembler.WriteSymtableVarSyms(st: TSymtable);
-      var
-        sym : tsym;
-        i,j : longint;
-      begin
-        if not assigned(st) then
-          exit;
-        for i:=0 to st.SymList.Count-1 do
-         begin
-           sym:=tsym(st.SymList[i]);
-           case sym.typ of
-             staticvarsym,
-             fieldvarsym:
-               begin
-                 WriteFieldSym(tabstractvarsym(sym));
-                 if (sym.typ=staticvarsym) and
-                    assigned(tstaticvarsym(sym).defaultconstsym) then
-                   WriteFieldSym(tabstractvarsym(tstaticvarsym(sym).defaultconstsym));
-               end;
-             constsym:
-               begin
-                 { multiple procedures can have constants with the same name }
-                 if not assigned(sym.owner.defowner) or
-                    (tdef(sym.owner.defowner).typ<>procdef) then
-                   WriteConstSym(tconstsym(sym));
-               end;
-             procsym:
-               begin
-                 for j:=0 to tprocsym(sym).procdeflist.count-1 do
-                   if not(df_generic in tprocdef(tprocsym(sym).procdeflist[j]).defoptions) then
-                     WriteSymtableVarSyms(tprocdef(tprocsym(sym).procdeflist[j]).localst);
-               end;
-           end;
-         end;
-      end;
-
-
-    procedure TJasminAssembler.WriteSymtableProcdefs(st: TSymtable);
-      var
-        i   : longint;
-        def : tdef;
-      begin
-        if not assigned(st) then
-          exit;
-        for i:=0 to st.DefList.Count-1 do
-          begin
-            def:=tdef(st.DefList[i]);
-            case def.typ of
-              procdef :
-                begin
-                  { methods are also in the static/globalsymtable of the unit
-                    -> make sure they are only written for the objectdefs that
-                    own them }
-                  if (not(st.symtabletype in [staticsymtable,globalsymtable]) or
-                      (def.owner=st)) and
-                     not(df_generic in def.defoptions) then
-                    begin
-                      WriteProcDef(tprocdef(def));
-                      if assigned(tprocdef(def).localst) then
-                        WriteSymtableProcdefs(tprocdef(def).localst);
-                    end;
-                end;
-            end;
-          end;
-      end;
-
-    procedure TJasminAssembler.WriteSymtableStructDefs(st: TSymtable);
-      var
-        i   : longint;
-        def : tdef;
-        obj : tabstractrecorddef;
-        nestedstructs: tfpobjectlist;
-      begin
-        if not assigned(st) then
-          exit;
-        nestedstructs:=tfpobjectlist.create(false);
-        for i:=0 to st.DefList.Count-1 do
-          begin
-            def:=tdef(st.DefList[i]);
-            if df_generic in def.defoptions then
-              continue;
-            case def.typ of
-              objectdef:
-                if not(oo_is_external in tobjectdef(def).objectoptions) then
-                  nestedstructs.add(def);
-              recorddef:
-                nestedstructs.add(def);
-            end;
-          end;
-        for i:=0 to nestedstructs.count-1 do
-          begin
-            obj:=tabstractrecorddef(nestedstructs[i]);
-            NewAsmFileForStructDef(obj);
-            WriteExtraHeader(obj);
-            WriteSymtableVarSyms(obj.symtable);
-            AsmLn;
-            WriteSymtableProcDefs(obj.symtable);
-            WriteSymtableStructDefs(obj.symtable);
-          end;
-        nestedstructs.free;
-      end;
-
-    constructor TJasminAssembler.Create(smart: boolean);
-      begin
-        inherited create(smart);
-        InstrWriter:=TJasminInstrWriter.Create(self);
-        asmfiles:=TCmdStrList.Create;
-      end;
-
-
-    procedure TJasminAssembler.WriteAsmList;
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module.mainsource) then
-       Comment(V_Debug,'Start writing Jasmin-styled assembler output for '+current_module.mainsource);
-{$endif}
-
-      AsmStartSize:=AsmSize;
-      WriteExtraHeader(nil);
-(*
-      for hal:=low(TasmlistType) to high(TasmlistType) do
-        begin
-          AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
-          writetree(current_asmdata.asmlists[hal]);
-          AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
-        end;
-*)
-      { print all global variables }
-      WriteSymtableVarSyms(current_module.globalsymtable);
-      WriteSymtableVarSyms(current_module.localsymtable);
-      AsmLn;
-      { print all global procedures/functions }
-      WriteSymtableProcdefs(current_module.globalsymtable);
-      WriteSymtableProcdefs(current_module.localsymtable);
-
-      WriteSymtableStructDefs(current_module.globalsymtable);
-      WriteSymtableStructDefs(current_module.localsymtable);
-
-      AsmLn;
-{$ifdef EXTDEBUG}
-      if assigned(current_module.mainsource) then
-       Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource);
-{$endif EXTDEBUG}
-    end;
-
-
-    procedure TJasminAssembler.RemoveAsm;
-      var
-        g : file;
-      begin
-        inherited;
-        if cs_asm_leave in current_settings.globalswitches then
-         exit;
-        while not asmfiles.empty do
-          begin
-            if cs_asm_extern in current_settings.globalswitches then
-             AsmRes.AddDeleteCommand(asmfiles.GetFirst)
-            else
-             begin
-               assign(g,asmfiles.GetFirst);
-               {$I-}
-                erase(g);
-               {$I+}
-               if ioresult<>0 then;
-             end;
-          end;
-      end;
-
-{****************************************************************************}
-{                         Jasmin Instruction Writer                          }
-{****************************************************************************}
-
-     constructor TJasminInstrWriter.create(_owner: TJasminAssembler);
-       begin
-         inherited create;
-         owner := _owner;
-       end;
-
-    function getreferencestring(var ref : treference) : ansistring;
-      begin
-        if (ref.arrayreftype<>art_none) or
-           (ref.index<>NR_NO) then
-          internalerror(2010122809);
-        if assigned(ref.symbol) then
-          begin
-            // global symbol or field -> full type and name
-            // ref.base can be <> NR_NO in case an instance field is loaded.
-            // This register is not part of this instruction, it will have
-            // been placed on the stack by the previous one.
-            if (ref.offset<>0) then
-              internalerror(2010122811);
-            result:=ref.symbol.name;
-          end
-        else
-          begin
-            // local symbol -> stack slot, stored in offset
-            if ref.base<>NR_STACK_POINTER_REG then
-              internalerror(2010122810);
-            result:=tostr(ref.offset);
-          end;
-      end;
-
-
-    function getopstr(const o:toper) : ansistring;
-      var
-        d: double;
-        s: single;
-      begin
-        case o.typ of
-          top_reg:
-            // should have been translated into a memory location by the
-            // register allocator)
-            if (cs_no_regalloc in current_settings.globalswitches) then
-              getopstr:=std_regname(o.reg)
-            else
-              internalerror(2010122803);
-          top_const:
-            str(o.val,result);
-          top_ref:
-            getopstr:=getreferencestring(o.ref^);
-          top_single:
-            begin
-              result:=constsingle(o.sval);
-            end;
-          top_double:
-            begin
-              result:=constdouble(o.dval);
-            end;
-          top_string:
-            begin
-              result:=constastr(o.pcval,o.pcvallen);
-            end;
-          top_wstring:
-            begin
-              result:=constwstr(o.pwstrval^.data,getlengthwidestring(o.pwstrval));
-            end
-          else
-            internalerror(2010122802);
-        end;
-      end;
-
-
-    procedure TJasminInstrWriter.WriteInstruction(hp: tai);
-      var
-        s: ansistring;
-        i: byte;
-        sep: ansistring;
-      begin
-        s:=#9+jas_op2str[taicpu(hp).opcode];
-        if taicpu(hp).ops<>0 then
-          begin
-            sep:=#9;
-            for i:=0 to taicpu(hp).ops-1 do
-              begin
-                 s:=s+sep+getopstr(taicpu(hp).oper[i]^);
-                 sep:=' ';
-              end;
-          end;
-        owner.AsmWriteLn(s);
-      end;
-
-{****************************************************************************}
-{                         Jasmin Instruction Writer                          }
-{****************************************************************************}
-
-  const
-    as_jvm_jasmin_info : tasminfo =
-       (
-         id     : as_jvm_jasmin;
-         idtxt  : 'Jasmin';
-         asmbin : 'java';
-         asmcmd : '-jar $JASMINJAR $ASM $EXTRAOPT -d $OBJDIR';
-         supported_targets : [system_jvm_java32,system_jvm_android32];
-         flags : [];
-         labelprefix : 'L';
-         comment : ' ; ';
-         dollarsign : '$';
-       );
-
-
-begin
-  RegisterAssembler(as_jvm_jasmin_info,TJasminAssembler);
-end.

compiler/alpha/aasmcpu.pas

@@ -1,268 +0,0 @@
-{
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    Implements the assembler classes specific for the Alpha
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{
-  Implements the assembler classes specific for the Alpha.
-}
-unit aasmcpu;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       aasmbase,globals,verbose,
-       cpubase,aasmtai,aasmdata,aasmsym;
-
-    type
-      tai_frame = class(tai)
-         G,R : TRegister;
-         LS,LU : longint;
-        Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
-        end;
-
-
-      taicpu = class(tai_cpu_abstract_sym)
-         constructor op_none(op : tasmop);
-
-         constructor op_reg(op : tasmop;_op1 : tregister);
-         constructor op_const(op : tasmop;_op1 : longint);
-         constructor op_ref(op : tasmop;_op1 : preference);
-
-         constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
-         constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
-         constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
-
-         constructor op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
-         constructor op_const_const(op : tasmop;_op1,_op2 : longint);
-         constructor op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
-
-         constructor op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
-         { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
-         constructor op_ref_ref(op : tasmop;_op1,_op2 : preference);
-
-         constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
-         constructor op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
-         constructor op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
-         constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3 : preference);
-         constructor op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
-         constructor op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
-
-         { this is for Jmp instructions }
-         constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
-
-         constructor op_sym(op : tasmop;_op1 : tasmsymbol);
-         constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
-         constructor op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
-         constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
-      end;
-
-      tai_align = class(tai_align_abstract)
-        { nothing to add }
-      end;
-
-    procedure InitAsm;
-    procedure DoneAsm;
-
-implementation
-
-
-{*****************************************************************************
-                                 taicpu Constructors
-*****************************************************************************}
-
-
-    constructor taicpu.op_none(op : tasmop);
-      begin
-         inherited create(op);
-      end;
-
-
-    constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
-      begin
-         inherited create(op);
-         ops:=1;
-      end;
-
-
-    constructor taicpu.op_const(op : tasmop;_op1 : longint);
-      begin
-         inherited create(op);
-         ops:=1;
-      end;
-
-
-    constructor taicpu.op_ref(op : tasmop;_op1 : preference);
-      begin
-         inherited create(op);
-         ops:=1;
-      end;
-
-
-    constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-    constructor taicpu.op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_ref_ref(op : tasmop;_op1,_op2 : preference);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
-      begin
-         inherited create(op);
-         ops:=3;
-      end;
-
-    constructor taicpu.op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
-      begin
-         inherited create(op);
-         ops:=3;
-      end;
-
-     constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;_op3 : preference);
-      begin
-         inherited create(op);
-         ops:=3;
-      end;
-
-     constructor taicpu.op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
-      begin
-         inherited create(op);
-         ops:=3;
-      end;
-
-     constructor taicpu.op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
-      begin
-         inherited create(op);
-         ops:=3;
-      end;
-
-     constructor taicpu.op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
-      begin
-         inherited create(op);
-         ops:=3;
-      end;
-
-
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         condition:=cond;
-         ops:=1;
-      end;
-
-
-    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         ops:=1;
-      end;
-
-
-    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
-      begin
-         inherited create(op);
-         ops:=1;
-      end;
-
-
-    constructor taicpu.op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-
-    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
-      begin
-         inherited create(op);
-         ops:=2;
-      end;
-
-    Constructor tai_frame.create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
-
-    begin
-      Inherited Create;
-      typ:=ait_frame;
-      G:=GP;
-      R:=RA;
-      LS:=LocalSize;
-      LU:=L;
-    end;
-
-    procedure InitAsm;
-      begin
-      end;
-
-
-    procedure DoneAsm;
-      begin
-      end;
-
-
-    end.

compiler/alpha/agaxpgas.pas

@@ -1,126 +0,0 @@
-{
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements an asm for the DEC Alpha
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit agaxpgas;
-
-  {$i fpcdefs.inc}
-
-  interface
-
-    uses
-       globals,systems,aasmbase,aasmtai,aasmdata,
-       aggas,cpubase;
-
-    type
-      TAXPGNUAssembler=class(TGNUAssembler)
-        procedure WriteInstruction(hp : tai);override;
-      end;
-
-    const
-       gas_reg2str : array[tregister] of string[4] = (
-         '',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '','',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '',''
-       );
-
-  implementation
-
-    const
-       op2str : array[tasmop] of string[14] = (
-          'addf','addg','addl','addq',
-          'adds','addt','amask','and','beq','bge',
-          'bgt','bic','bis','blbc','blbs','ble',
-          'blt','bne','br','bsr','call_pal','cmoveq',
-          'cmovge','cmovgt','cmovlbc','cmovlbs','cmovle','cmovlt',
-          'cmovne','cmpbge','cmpeq','cmpgeq','cmpgle','cmpglt',
-          'cmple','cmplt','cmpteq','cmptle','cmptlt','cmptun',
-          'cmpule','cmpult','cpys','cpyse','cpysn','ctlz',
-          'ctpop','cttz','cvtdg','cvtgd','cvtgf','cvtgq',
-          'cvtlq','cvtqf','cvtqg','cvtql','cvtqs','cvtqt',
-          'cvtst','cvttq','cvtts','divf','divg','divs',
-          'divt','ecb','eqv','excb','extbl','extlh',
-          'extll','extqh','extql','extwh','extwl','fbeq',
-          'fbge','fbgt','fble','fblt','fbne','fcmoveq',
-          'fcmovge','fcmovgt','fcmovle','fcmovlt','fcmovne','fetch',
-          'fetch_m','ftois','ftoit','implver','insbl','inslh',
-          'insll','insqh','insql','inswh','inswl','itoff',
-          'itofs','itoft','jmp','jsr','jsr_coroutine','lda',
-          'ldah','ldbu','ldwu','ldf','ldg','ldl',
-          'ldl_l','ldq','ldq_l','ldq_u','lds','ldt',
-          'maxsb8','maxsw4','maxub8','maxuw4','mb','mf_fpcr',
-          'minsb8','minsw4','minub8','minuw4','mskbl','msklh',
-          'mskll','mskqh','mskql','mskwh','mskwl','mt_fpcr',
-          'mulf','mulg','mull','mulq',
-          'muls','mult','ornot','perr','pklb','pkwb',
-          'rc','ret','rpcc','rs','s4addl','s4addq',
-          's4subl','s4subq','s8addl','s8addq','s8subl','s8subq',
-          'sextb','sextw','sll','sqrtf','sqrtg','sqrts',
-          'sqrtt','sra','srl','stb','stf','stg',
-          'sts','stl','stl_c','stq','stq_c','stq_u',
-          'stt','stw','subf','subg','subl',
-          'subq','subs','subt','trapb','umulh','unpkbl',
-          'unpkbw','wh64','wmb','xor','zap','zapnot',
-          'ldgp');
-
-      procedure TAXPGNUAssembler.WriteInstruction (hp : tai);
-        begin
-(*
-               op:=paicpu(hp)^.opcode;
-               calljmp:=is_calljmp(op);
-             { call maybe not translated to calll }
-               s:=#9+att_op2str[op]+cond2str[paicpu(hp)^.condition];
-               if (not calljmp) and
-                  (not att_nosuffix[op]) and
-                  not(
-                   (paicpu(hp)^.oper[0].typ=top_reg) and
-                   (paicpu(hp)^.oper[0].reg in [R_ST..R_ST7])
-                  ) then
-                s:=s+att_opsize2str[paicpu(hp)^.opsize];
-             { process operands }
-               if paicpu(hp)^.ops<>0 then
-                begin
-                { call and jmp need an extra handling                          }
-                { this code is only called if jmp isn't a labeled instruction }
-                  if calljmp then
-                   s:=s+#9+getopstr_jmp(paicpu(hp)^.oper[0])
-                  else
-                   begin
-                     for i:=0to paicpu(hp)^.ops-1 do
-                      begin
-                        if i=0 then
-                         sep:=#9
-                        else
-                         sep:=',';
-                        s:=s+sep+getopstr(paicpu(hp)^.oper[i])
-                      end;
-                   end;
-                end;
-               AsmWriteLn(s);
-*)
-             end;
-
-end.

compiler/alpha/aoptcpu.pas

@@ -1,38 +0,0 @@
-{
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit implements the Alpha optimizer object
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-
-Unit aoptcpu;
-
-Interface
-
-uses cpubase, aoptobj, aoptcpub;
-
-Type
-  TAOptCpu = Object(TAoptObj)
-    { uses the same constructor as TAopObj }
-  End;
-
-Implementation
-
-End.

compiler/alpha/aoptcpub.pas

@@ -1,112 +0,0 @@
- {
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains several types and constants necessary for the
-    optimizer to work on the 80x86 architecture
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-Unit aoptcpub; { Assembler OPTimizer CPU specific Base }
-
-{ enable the following define if memory references can have both a base and }
-{ index register in 1 operand                                               }
-
-{ enable the following define if memory references can have a scaled index }
-{$define RefsHaveScale}
-
-{ enable the following define if memory references can have a segment }
-{ override                                                            }
-
-{ define RefsHaveSegment}
-
-Interface
-
-Uses
-  CPUAsm,AOptBase;
-
-Type
-
-{ type of a normal instruction }
-  TInstr = Taicpu;
-  PInstr = ^TInstr;
-
-{ ************************************************************************* }
-{ **************************** TCondRegs ********************************** }
-{ ************************************************************************* }
-{ Info about the conditional registers                                      }
-  TCondRegs = Object
-    Constructor Init;
-    Destructor Done;
-  End;
-
-{ ************************************************************************* }
-{ **************************** TAoptBaseCpu ******************************* }
-{ ************************************************************************* }
-
-  TAoptBaseCpu = Object(TAoptBase)
-  End;
-
-
-{ ************************************************************************* }
-{ ******************************* Constants ******************************* }
-{ ************************************************************************* }
-Const
-
-{ the maximum number of things (registers, memory, ...) a single instruction }
-{ changes                                                                    }
-
-  MaxCh = 3;
-
-{ the maximum number of operands an instruction has }
-
-  MaxOps = 3;
-
-{Oper index of operand that contains the source (reference) with a load }
-{instruction                                                            }
-
-  LoadSrc = 0;
-
-{Oper index of operand that contains the destination (register) with a load }
-{instruction                                                                }
-
-  LoadDst = 1;
-
-{Oper index of operand that contains the source (register) with a store }
-{instruction                                                            }
-
-  StoreSrc = 0;
-
-{Oper index of operand that contains the destination (reference) with a load }
-{instruction                                                                 }
-
-  StoreDst = 1;
-
-Implementation
-
-{ ************************************************************************* }
-{ **************************** TCondRegs ********************************** }
-{ ************************************************************************* }
-Constructor TCondRegs.init;
-Begin
-End;
-
-Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
-Begin
-End;
-
-End.

compiler/alpha/aoptcpuc.pas

@@ -1,38 +0,0 @@
- {
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the processor specific implementation of the
-    assembler optimizer common subexpression elimination object.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit aoptcpuc;
-
-Interface
-
-Uses
-  AOptCs;
-
-Type
-  TRegInfoCpu = Object(TRegInfo)
-  End;
-
-
-Implementation
-
-End.

compiler/alpha/aoptcpud.pas

@@ -1,39 +0,0 @@
-{
-    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the processor specific implementation of the
-    assembler optimizer data flow analyzer.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-Unit aoptcpud;
-
-Interface
-
-uses
-  AOptDA;
-
-Type
-  PAOptDFACpu = ^TAOptDFACpu;
-  TAOptDFACpu = Object(TAOptDFA)
-  End;
-
-Implementation
-
-
-End.

compiler/alpha/cgcpu.pas

@@ -1,168 +0,0 @@
-{
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements the code generator for the Alpha
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{
-  This unit implements the code generator for the Alpha.
-}
-unit cgcpu;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-   cgbase,cgobj,aasmbase,aasmtai,aasmdata,aasmcpu,cginfo,cpubase,cpuinfo;
-
-type
-pcgalpha = ^tcgalpha;
-tcgalpha = class(tcg)
-  procedure a_call_name(list : TAsmList;const s : string);override;
-  procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : aword;register : tregister);override;
-  procedure a_load_reg_ref(list : TAsmList;size : tcgsize;register : tregister;const ref : treference);override;
-  procedure a_load_ref_reg(list : TAsmList;size : tcgsize;const ref : treference;register : tregister);override;
-  procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
-  procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword;
-    reg : tregister;  l : tasmlabel);override;
-  procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
-  procedure a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
-  procedure a_cmp_ref_const_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword;
-    reg : tregister; l : tasmlabel);
-  procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
-  procedure g_stackframe_entry(list : TAsmList;localsize : longint);override;
-  procedure g_maybe_loadself(list : TAsmList);override;
-  procedure g_restore_frame_pointer(list : TAsmList);override;
-end;
-
-procedure create_codegen;
-
-implementation
-
-uses
-   globtype,globals;
-
-procedure tcgalpha.g_stackframe_entry(list : TAsmList;localsize : longint);
-
-begin
-   list.concat(taicpu.op_reg_ref(A_LDGP,Global_pointer,new_reference(R_27,0)));
-   list.concat(taicpu.op_reg_ref(A_LDA,stack_pointer_reg,new_reference(stack_pointer_reg,-LocalSize)));
-   If LocalSize<>0 then
-     list.concat(tai_frame.create(Global_pointer,LocalSize,R_27,0));
-   { Always generate a frame pointer. }
-   list.concat(taicpu.op_reg_reg_reg(A_BIS,stack_pointer_reg,stack_pointer_reg,frame_pointer_reg));
-end;
-
-procedure g_exitcode(list : TAsmList;parasize : longint; nostackframe,inlined : boolean);
-
-begin
-   { Restore stack pointer from frame pointer }
-   list.Concat (taicpu.op_reg_reg_reg(A_BIS,frame_pointer_reg,frame_pointer_reg,stack_pointer_reg));
-   { Restore previous stack position}
-   list.Concat (taicpu.op_reg_const_reg(A_ADDQ,stack_pointer_reg,Parasize,stack_pointer_reg));
-   { return... }
-   list.Concat(taicpu.op_reg_ref_const(A_RET,stack_pointer_reg,new_reference(Return_pointer,0),1));
-    { end directive
-    Concat (paiend,init(''));
-    }
-end;
-
-procedure tcgalpha.a_call_name(list : TAsmList;const s : string);
-
-  begin
-     { list^.concat(taicpu,op_sym(A_CALL,S_NO,newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)))); }
-     {!!!!!!!!!1 offset is ignored }
-     abstract;
-  end;
-
-procedure tcgalpha.a_load_const_reg(list : TAsmList;size : tcgsize;a : aword;register : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.a_load_reg_ref(list : TAsmList;size : tcgsize;register : tregister;const ref : treference);
-
-begin
-end;
-
-
-procedure tcgalpha.a_load_ref_reg(list : TAsmList;size : tcgsize;const ref : treference;register : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.a_load_reg_reg(list : TAsmList;fromsize, tosize : tcgsize;reg1,reg2 : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
-  l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_ref_const_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword;
-  reg : tregister; l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.g_maybe_loadself(list : TAsmList);
-
-begin
-end;
-
-
-procedure tcgalpha.g_restore_frame_pointer(list : TAsmList);
-
-begin
-end;
-
-
-procedure create_codegen;
-  begin
-    cg:=tcgalpha.create;
-    cg128:=tcg128.create;
-  end;
-
-end.

compiler/alpha/cpubase.pas

@@ -1,431 +0,0 @@
-{
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    This unit implements an asmlistitem class for the Alpha architecture.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{
-  This unit implements an asmlistitem class for the Alpha architecture.
-}
-unit cpubase;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       cutils,cclasses,globals,aasmbase,cpuinfo,cginfo;
-
-    type
-       { all registers }
-       TRegister = (R_NO,  { R_NO is Mandatory, signifies no register }
-                    R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,
-                    R_10,R_11,R_12,R_13,R_14,R_15,R_16,R_17,R_18,R_19,
-                    R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,
-                    R_30,R_31,
-                    R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,
-                    R_F10,R_F11,R_F12,R_F13,R_F14,R_F15,R_F16,R_F17,R_F18,R_F19,
-                    R_F20,R_F21,R_F22,R_F23,R_F24,R_F25,R_F26,R_F27,R_F28,R_F29,
-                    R_F30,R_F31);
-
-       tasmop = (A_ADDF,A_ADDG,A_ADDL,A_ADDQ,
-                 A_ADDS,A_ADDT,A_AMASK,A_AND,A_BEQ,A_BGE,
-                 A_BGT,A_BIC,A_BIS,A_BLBC,A_BLBS,A_BLE,
-                 A_BLT,A_BNE,A_BR,A_BSR,A_CALL_PAL,A_CMOVEQ,
-                 A_CMOVGE,A_CMOVGT,A_CMOVLBC,A_CMOVLBS,A_CMOVLE,A_CMOVLT,
-                 A_CMOVNE,A_CMPBGE,A_CMPEQ,A_CMPGEQ,A_CMPGLE,A_CMPGLT,
-                 A_CMPLE,A_CMPLT,A_CMPTEQ,A_CMPTLE,A_CMPTLT,A_CMPTUN,
-                 A_CMPULE,A_CMPULT,A_CPYS,A_CPYSE,A_CPYSN,A_CTLZ,
-                 A_CTPOP,A_CTTZ,A_CVTDG,A_CVTGD,A_CVTGF,A_CVTGQ,
-                 A_CVTLQ,A_CVTQF,A_CVTQG,A_CVTQL,A_CVTQS,A_CVTQT,
-                 A_CVTST,A_CVTTQ,A_CVTTS,A_DIVF,A_DIVG,A_DIVS,
-                 A_DIVT,A_ECB,A_EQV,A_EXCB,A_EXTBL,A_EXTLH,
-                 A_EXTLL,A_EXTQH,A_EXTQL,A_EXTWH,A_EXTWL,A_FBEQ,
-                 A_FBGE,A_FBGT,A_FBLE,A_FBLT,A_FBNE,A_FCMOVEQ,
-                 A_FCMOVGE,A_FCMOVGT,A_FCMOVLE,A_FCMOVLT,A_FCMOVNE,A_FETCH,
-                 A_FETCH_M,A_FTOIS,A_FTOIT,A_IMPLVER,A_INSBL,A_INSLH,
-                 A_INSLL,A_INSQH,A_INSQL,A_INSWH,A_INSWL,A_ITOFF,
-                 A_ITOFS,A_ITOFT,A_JMP,A_JSR,A_JSR_COROUTINE,A_LDA,
-                 A_LDAH,A_LDBU,A_LDWU,A_LDF,A_LDG,A_LDL,
-                 A_LDL_L,A_LDQ,A_LDQ_L,A_LDQ_U,A_LDS,A_LDT,
-                 A_MAXSB8,A_MAXSW4,A_MAXUB8,A_MAXUW4,A_MB,A_MF_FPCR,
-                 A_MINSB8,A_MINSW4,A_MINUB8,A_MINUW4,A_MSKBL,A_MSKLH,
-                 A_MSKLL,A_MSKQH,A_MSKQL,A_MSKWH,A_MSKWL,A_MT_FPCR,
-                 A_MULF,A_MULG,A_MULL,A_MULQ,
-                 A_MULS,A_MULT,A_ORNOT,A_PERR,A_PKLB,A_PKWB,
-                 A_RC,A_RET,A_RPCC,A_RS,A_S4ADDL,A_S4ADDQ,
-                 A_S4SUBL,A_S4SUBQ,A_S8ADDL,A_S8ADDQ,A_S8SUBL,A_S8SUBQ,
-                 A_SEXTB,A_SEXTW,A_SLL,A_SQRTF,A_SQRTG,A_SQRTS,
-                 A_SQRTT,A_SRA,A_SRL,A_STB,A_STF,A_STG,
-                 A_STS,A_STL,A_STL_C,A_STQ,A_STQ_C,A_STQ_U,
-                 A_STT,A_STW,A_SUBF,A_SUBG,A_SUBL,
-                 A_SUBQ,A_SUBS,A_SUBT,A_TRAPB,A_UMULH,
-                 A_UNPKBL,A_UNPKBW,A_WH64,A_WMB,A_XOR,A_ZAP,
-                 A_ZAPNOT
-                 { Psuedo code understood by the gnu assembler }
-                 ,A_LDGP);
-
-    const
-       firstop = low(tasmop);
-       lastop  = high(tasmop);
-
-       std_reg2str : array[tregister] of string[4] = (
-         '',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '','',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '','','','','','','','','','',
-         '',''
-       );
-
-
-    type
-       TAsmCond =
-        (
-         C_None,C_A,C_AE,C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_NA,C_NAE,
-         C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_NO,C_NP,C_NS,C_NZ,C_O,C_P,
-         C_PE,C_PO,C_S,C_Z
-        );
-
-        TRegisterset = Set of TRegister;
-
-        tregister64 = tregister;
-
-    Const
-       Firstreg = R_0;
-       LastReg = R_F31;
-
-
-{*****************************************************************************
-                          Default generic sizes
-*****************************************************************************}
-
-       { Defines the default address size for a processor, }
-       OS_ADDR = OS_64;
-       { the natural int size for a processor,
-         has to match osuinttype/ossinttype as initialized in psystem }
-       OS_INT = OS_64;
-       { the maximum float size for a processor,           }
-       OS_FLOAT = OS_F80;
-       { the size of a vector register for a processor     }
-       OS_VECTOR = OS_M64;
-
-       stack_pointer_reg = R_30;
-       frame_pointer_reg = R_15;
-       self_pointer_reg = R_16;
-       accumulator   = R_0;
-  {the return_result_reg, is used inside the called function to store its return
-  value when that is a scalar value otherwise a pointer to the address of the
-  result is placed inside it}
-        return_result_reg               =       accumulator;
-
-  {the function_result_reg contains the function result after a call to a scalar
-  function othewise it contains a pointer to the returned result}
-        function_result_reg     =       accumulator;
-       fpu_result_reg = R_F0;
-       global_pointer = R_29;
-       return_pointer = R_26;
-       { it is used to pass the offset to the destructor helper routine }
-       vmt_offset_reg = R_1;
-
-     { low and high of the available maximum width integer general purpose }
-     { registers                                                           }
-       LoGPReg = R_0;
-       HiGPReg = R_31;
-
-       { low and high of every possible width general purpose register (same as
-         above on most architctures apart from the 80x86)                       }
-       LoReg = R_0;
-       HiReg = R_31;
-
-       maxfpuregs = 32;
-
-       max_operands = 4;
-
-       registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9];
-
-       maxvarregs = 6;
-       varregs : Array [1..maxvarregs] of Tregister =
-                 (R_9,R_10,R_11,R_12,R_13,R_14);
-
-       maxfpuvarregs = 8;
-
-       { Registers which are defined as scratch and no need to save across
-         routine calls or in assembler blocks.
-       }
-       max_scratch_regs = 2;
-       scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2);
-
-{*****************************************************************************
-                               GDB Information
-*****************************************************************************}
-
-       {  Register indexes for stabs information, when some
-         parameters or variables are stored in registers.
-       }
-       stab_regindex : array[tregister] of shortint =
-          (0,
-           0,0,0,0,0,0,0,0,0,0,
-           0,0,0,0,0,0,0,0,0,0,
-           0,0,0,0,0,0,0,0,0,0,
-           0,0,
-           0,0,0,0,0,0,0,0,0,0,
-           0,0,0,0,0,0,0,0,0,0,
-           0,0,0,0,0,0,0,0,0,0,
-           0,0
-          );
-
-{*****************************************************************************
-                                   Flags
-*****************************************************************************}
-       type
-       { The Alpha doesn't have flags but some generic code depends on this type. }
-       TResFlags = (F_NO);
-
-
-       { reference record }
-       pparareference = ^tparareference;
-       tparareference = packed record
-          index       : tregister;
-          offset      : longint;
-       end;
-
-       trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
-
-       TReference = record
-         offset : aword;
-         symbol : tasmsymbol;
-         base : tregister;
-         { The index isn't used by the alpha port, but some generic code depends on it }
-         index : tregister;
-         is_immediate : boolean;
-         offsetfixup : word; {needed for inline}
-         options     : trefoptions;
-         { the boundary to which the reference is surely aligned }
-         alignment : byte;
-       end;
-       PReference = ^TReference;
-
-       TLoc=(
-              LOC_INVALID,      { added for tracking problems}
-              LOC_CONSTANT,     { constant value }
-              LOC_JUMP,         { boolean results only, jump to false or true label }
-              LOC_FLAGS,        { boolean results only, flags are set }
-              LOC_CREFERENCE,   { in memory constant value reference (cannot change) }
-              LOC_REFERENCE,    { in memory value }
-              LOC_REGISTER,     { in a processor register }
-              LOC_CREGISTER,    { Constant register which shouldn't be modified }
-              LOC_FPUREGISTER,  { FPU stack }
-              LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
-              LOC_SSEREGISTER,
-              LOC_CSSEREGISTER,
-              LOC_CMMREGISTER,
-              LOC_MMREGISTER
-            );
-
-      { tparamlocation describes where a parameter for a procedure is stored.
-        References are given from the caller's point of view. The usual
-        TLocation isn't used, because contains a lot of unnessary fields.
-      }
-      tparalocation = packed record
-         size : TCGSize;
-         loc  : TLoc;
-         sp_fixup : longint;
-         case TLoc of
-            LOC_REFERENCE : (reference : tparareference);
-            { segment in reference at the same place as in loc_register }
-            LOC_REGISTER,LOC_CREGISTER : (
-              case longint of
-                1 : (register,register64.reghi : tregister);
-                { overlay a register64.reglo }
-                2 : (register64.reglo : tregister);
-                { overlay a 64 Bit register type }
-                3 : (reg64 : tregister64);
-                4 : (register64 : tregister64);
-              );
-      end;
-
-      tlocation = packed record
-         loc  : TLoc;
-         size : TCGSize;
-         case TLoc of
-            LOC_CONSTANT : (
-              case longint of
-                1 : (value : AWord);
-                { can't do this, this layout depends on the host cpu. Use }
-                { lo(valueqword)/hi(valueqword) instead (JM)              }
-                { 2 : (valuelow, valuehigh:AWord);                        }
-                { overlay a complete 64 Bit value }
-                3 : (valueqword : qword);
-              );
-            LOC_CREFERENCE,
-            LOC_REFERENCE : (reference : treference);
-            { segment in reference at the same place as in loc_register }
-            LOC_REGISTER,LOC_CREGISTER : (
-              case longint of
-                1 : (register,register64.reghi,segment : tregister);
-                { overlay a register64.reglo }
-                2 : (register64.reglo : tregister);
-                { overlay a 64 Bit register type }
-                3 : (reg64 : tregister64);
-                4 : (register64 : tregister64);
-              );
-      end;
-
-{*****************************************************************************
-                                Operands
-*****************************************************************************}
-
-
-        { Types of operand }
-        toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
-
-        toper=record
-          ot  : longint;
-          case typ : toptype of
-           top_none   : ();
-           top_reg    : (reg:tregister);
-           top_ref    : (ref:preference);
-           top_const  : (val:longint);
-           top_symbol : (sym:tasmsymbol;symofs:longint);
-        end;
-
-   const
-      { Registers which must be saved when calling a routine declared as
-        cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers
-        saved should be the ones as defined in the target ABI and / or GCC.
-
-        This value can be deduced from the CALLED_USED_REGISTERS array in the
-        GCC source.
-      }
-      std_saved_registers = [];
-      { Required parameter alignment when calling a routine declared as
-        stdcall and cdecl. The alignment value should be the one defined
-        by GCC or the target ABI.
-
-        The value of this constant is equal to the constant
-        PARM_BOUNDARY / BITS_PER_UNIT in the GCC source.
-      }
-      std_param_align = 8;
-
-      { offsets for the integer and floating point registers }
-      INT_REG = 0;
-      FLOAT_REG = 32;
-
-      { operator qualifiers }
-      OQ_CHOPPED_ROUNDING            = $01;  { /C }
-      OQ_ROUNDING_MODE_DYNAMIC       = $02;  { /D }
-      OQ_ROUND_TOWARD_MINUS_INFINITY = $04;  { /M }
-      OQ_INEXACT_RESULT_ENABLE        = $08; { /I }
-      OQ_SOFTWARE_COMPLETION_ENABLE  = $10;  { /S }
-      OQ_FLOATING_UNDERFLOW_ENABLE   = $20;  { /U }
-      OQ_INTEGER_OVERFLOW_ENABLE     = $40;  { /V }
-
-
-{*****************************************************************************
-                   Opcode propeties (needed for optimizer)
-*****************************************************************************}
-
-{$ifndef NOOPT}
-Type
-{What an instruction can change}
-  TInsChange = (Ch_None);
-{$endif}
-
-
-{ resets all values of ref to defaults }
-procedure reset_reference(var ref : treference);
-{ set mostly used values of a new reference }
-function new_reference(base : tregister;offset : longint) : preference;
-function newreference(const r : treference) : preference;
-procedure disposereference(var r : preference);
-
-function reg2str(r : tregister) : string;
-
-{*****************************************************************************
-                                  Init/Done
-*****************************************************************************}
-
-  procedure InitCpu;
-  procedure DoneCpu;
-
-implementation
-
-uses
-   verbose;
-
-function reg2str(r : tregister) : string;
-
-  begin
-     if r in [R_0..R_31] then
-       reg2str:='R'+tostr(longint(r)-longint(R_0))
-     else if r in [R_F0..R_F31] then
-       reg2str:='F'+tostr(longint(r)-longint(R_F0))
-     else internalerror(38991);
-  end;
-
-procedure reset_reference(var ref : treference);
-begin
-  FillChar(ref,sizeof(treference),0);
-end;
-
-
-function new_reference(base : tregister;offset : longint) : preference;
-var
-  r : preference;
-begin
-  new(r);
-  FillChar(r^,sizeof(treference),0);
-  r^.offset:=offset;
-  r^.alignment:=8;
-  new_reference:=r;
-end;
-
-function newreference(const r : treference) : preference;
-
-var
-   p : preference;
-begin
-   new(p);
-   p^:=r;
-   newreference:=p;
-end;
-
-procedure disposereference(var r : preference);
-
-begin
-  dispose(r);
-  r:=Nil;
-end;
-
-{*****************************************************************************
-                                  Init/Done
-*****************************************************************************}
-
-  procedure InitCpu;
-    begin
-    end;
-
-  procedure DoneCpu;
-    begin
-    end;
-
-end.

compiler/alpha/cpuinfo.pas

@@ -1,91 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998-2000 by the Free Pascal development team
-
-    Basic Processor information about the Alpha
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{
-  Basic Processor information about the Alpha
-}
-Unit CPUInfo;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
- globtype;
-
-Type
-   { Natural integer register type and size for the target machine }
-{$ifdef FPC}
-   AWord = Qword;
-{$else FPC}
-   AWord = Longint;
-{$endif FPC}
-   PAWord = ^AWord;
-
-   { 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
-     $fffffffffffffff on a 32bit machine if the compiler uses
-     int64 constants internally (JM)                              }
-   TConstPtrUInt = qword;
-
-   bestreal = extended;
-{$if FPC_FULLVERSION>20700}
-   bestrealrec = TExtended80Rec;
-{$endif FPC_FULLVERSION>20700}
-   ts32real = single;
-   ts64real = double;
-   ts80real = extended;
-   ts64comp = extended;
-
-   pbestreal=^bestreal;
-
-   { possible supported processors for this target }
-   tcputype =
-      (cpu_none,
-       ClassEV7,
-       ClassEV8
-      );
-
-   tcontrollertype =
-     (ct_none
-     );
-
-
-Const
-   { Is there support for dealing with multiple microcontrollers available }
-   { for this platform? }
-   ControllerSupport = false;
-   { Size of native extended type }
-   extended_size = 16;
-   {# Size of a pointer                           }
-   aint_size  = 8;
-   {# Size of a multimedia register               }
-   mmreg_size = 8;
-
-   { We know that there are fields after sramsize
-     but we don't care about this warning }
-   {$PUSH}
-    {$WARN 3177 OFF}
-   embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
-   (
-      (controllertypestr:''; controllerunitstr:''; flashbase:0; flashsize:0; srambase:0; sramsize:0));
-   {$POP}
-
-   { target cpu string (used by compiler options) }
-   target_cpu_string = 'alpha';
-
-Implementation
-
-end.

compiler/alpha/cpunode.pas

@@ -1,56 +0,0 @@
-{
-    Copyright (c) 2000-2002 by Florian Klaempfl
-
-    Imports the Alpha code generator
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{
-  This unit imports the Alpha code generator.
-}
-unit cpunode;
-
-{$i fpcdefs.inc}
-
-  interface
-
-  implementation
-
-    uses
-       { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,
-       { to be able to only parts of the generic code,
-         the processor specific nodes must be included
-         after the generic one (FK)
-       }
-//       naxpadd,
-//       naxpcal,
-//       naxpcon,
-//       naxpflw,
-//       naxpmem,
-//       naxpset,
-//       naxpinl,
-//       nppcopt,
-       { this not really a node }
-//       naxpobj,
-//       naxpmat,
-//       naxpcnv,
-         { symtable }
-         symcpu
-       ;
-
-end.

compiler/alpha/cpupara.pas

@@ -1,270 +0,0 @@
-{
-    Copyright (c) 2002 by Florian Klaempfl
-
-    Alpha specific calling conventions
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
-}
-{ Alpha specific calling conventions are handled by this unit
-}
-unit cpupara;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       cpubase,
-       symconst,symbase,symtype,symdef,paramgr;
-
-    type
-       tcpuparamanager = class(tparamanager)
-          procedure create_param_loc_info(p : tabstractprocdef);override;
-          function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
-       end;
-
-  implementation
-
-    uses
-       verbose,
-       globtype,
-       cpuinfo,cginfo,cgbase,
-       defbase;
-
-    function getparaloc(p : tdef) : tloc;
-
-      begin
-         { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
-           if push_addr_param for the def is true
-         }
-         case p.typ of
-            orddef:
-              getparaloc:=LOC_REGISTER;
-            floatdef:
-              getparaloc:=LOC_FPUREGISTER;
-            enumdef:
-              getparaloc:=LOC_REGISTER;
-            pointerdef:
-              getparaloc:=LOC_REGISTER;
-            formaldef:
-              getparaloc:=LOC_REGISTER;
-            classrefdef:
-              getparaloc:=LOC_REGISTER;
-            recorddef:
-              getparaloc:=LOC_REFERENCE;
-            objectdef:
-              if is_object(p) then
-                getparaloc:=LOC_REFERENCE
-              else
-                getparaloc:=LOC_REGISTER;
-            stringdef:
-              if is_shortstring(p) or is_longstring(p) then
-                getparaloc:=LOC_REFERENCE
-              else
-                getparaloc:=LOC_REGISTER;
-            procvardef:
-              if (po_methodpointer in tprocvardef(p).procoptions) then
-                getparaloc:=LOC_REFERENCE
-              else
-                getparaloc:=LOC_REGISTER;
-            filedef:
-              getparaloc:=LOC_REGISTER;
-            arraydef:
-              getparaloc:=LOC_REFERENCE;
-            setdef:
-              if is_smallset(p) then
-                getparaloc:=LOC_REGISTER
-              else
-                getparaloc:=LOC_REFERENCE;
-            variantdef:
-              getparaloc:=LOC_REFERENCE;
-            { avoid problems with errornous definitions }
-            errordef:
-              getparaloc:=LOC_REGISTER;
-            else
-              internalerror(2002071001);
-         end;
-      end;
-
-    procedure tcpuparamanager.create_param_loc_info(p : tabstractprocdef);
-
-      var
-         nextintreg,nextfloatreg,nextmmreg : tregister;
-         stack_offset : aword;
-         hp : tparaitem;
-         loc : tloc;
-         is_64bit: boolean;
-
-      begin
-         nextintreg:=R_3;
-         nextfloatreg:=R_F1;
-         // nextmmreg:=R_M1;
-         stack_offset:=0;
-         { pointer for structured results ? }
-         if not is_void(p.returndef) then
-           begin
-              if not(ret_in_reg(p.returndef)) then
-                inc(nextintreg);
-           end;
-
-         { frame pointer for nested procedures? }
-         { inc(nextintreg);                     }
-         { constructor? }
-         { destructor? }
-         hp:=tparaitem(p.para.last);
-         while assigned(hp) do
-           begin
-              loc:=getparaloc(hp.paratype.def);
-              hp.paraloc.sp_fixup:=0;
-              case loc of
-                 LOC_REGISTER:
-                   begin
-                      hp.paraloc.size := def_cgsize(hp.paratype.def);
-                      { for things like formaldef }
-                      if hp.paraloc.size = OS_NO then
-                        hp.paraloc.size := OS_ADDR;
-                      is_64bit := hp.paraloc.size in [OS_64,OS_S64];
-                      if nextintreg<=tregister(ord(R_10)-ord(is_64bit))  then
-                        begin
-                           hp.paraloc.loc:=LOC_REGISTER;
-                           hp.paraloc.register64.reglo:=nextintreg;
-                           inc(nextintreg);
-                           if is_64bit then
-                             begin
-                               hp.paraloc.register64.reghi:=nextintreg;
-                               inc(nextintreg);
-                             end;
-                        end
-                      else
-                         begin
-                            nextintreg := R_11;
-                            hp.paraloc.loc:=LOC_REFERENCE;
-                            hp.paraloc.reference.index:=stack_pointer_reg;
-                            hp.paraloc.reference.offset:=stack_offset;
-                            if not is_64bit then
-                              inc(stack_offset,4)
-                            else
-                              inc(stack_offset,8);
-                        end;
-                   end;
-                 LOC_FPUREGISTER:
-                   begin
-                      if hp.paratyp in [vs_var,vs_out] then
-                        begin
-                            if nextintreg<=R_10 then
-                             begin
-                                hp.paraloc.size:=OS_ADDR;
-                                hp.paraloc.loc:=LOC_REGISTER;
-                                hp.paraloc.register:=nextintreg;
-                                inc(nextintreg);
-                             end
-                           else
-                              begin
-                                 {!!!!!!!}
-                                 hp.paraloc.size:=def_cgsize(hp.paratype.def);
-                                 internalerror(2002071006);
-                             end;
-                        end
-                      else if nextfloatreg<=R_F10 then
-                        begin
-                           hp.paraloc.size:=def_cgsize(hp.paratype.def);
-                           hp.paraloc.loc:=LOC_FPUREGISTER;
-                           hp.paraloc.register:=nextfloatreg;
-                           inc(nextfloatreg);
-                        end
-                      else
-                         begin
-                            {!!!!!!!}
-                             hp.paraloc.size:=def_cgsize(hp.paratype.def);
-                            internalerror(2002071004);
-                        end;
-                   end;
-                 LOC_REFERENCE:
-                   begin
-                      hp.paraloc.size:=OS_ADDR;
-                      if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then
-                        begin
-                           if nextintreg<=R_10 then
-                             begin
-                                hp.paraloc.loc:=LOC_REGISTER;
-                                hp.paraloc.register:=nextintreg;
-                                inc(nextintreg);
-                             end
-                           else
-                              begin
-                                 hp.paraloc.loc:=LOC_REFERENCE;
-                                 hp.paraloc.reference.index:=stack_pointer_reg;
-                                 hp.paraloc.reference.offset:=stack_offset;
-                                 inc(stack_offset,4);
-                             end;
-                        end
-                      else
-                        begin
-                           hp.paraloc.loc:=LOC_REFERENCE;
-                           hp.paraloc.reference.index:=stack_pointer_reg;
-                           hp.paraloc.reference.offset:=stack_offset;
-                           inc(stack_offset,hp.paratype.def.size);
-                        end;
-                   end;
-                 else
-                   internalerror(2002071002);
-              end;
-              hp:=tparaitem(hp.previous);
-           end;
-      end;
-
-    function tcpuparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
-      begin
-         case p.returndef.typ of
-            orddef,
-            enumdef:
-              begin
-                getfuncretparaloc.loc:=LOC_REGISTER;
-                getfuncretparaloc.register:=R_3;
-                getfuncretparaloc.size:=def_cgsize(p.returndef);
-                if getfuncretparaloc.size in [OS_S64,OS_64] then
-                  getfuncretparaloc.register64.reghi:=R_4;
-              end;
-            floatdef:
-              begin
-                getfuncretparaloc.loc:=LOC_FPUREGISTER;
-                getfuncretparaloc.register:=R_F1;
-                getfuncretparaloc.size:=def_cgsize(p.returndef);
-              end;
-            pointerdef,
-            formaldef,
-            classrefdef,
-            recorddef,
-            objectdef,
-            stringdef,
-            procvardef,
-            filedef,
-            arraydef,
-            errordef:
-              begin
-                getfuncretparaloc.loc:=LOC_REGISTER;
-                getfuncretparaloc.register:=R_3;
-                getfuncretparaloc.size:=OS_ADDR;
-              end;
-            else
-              internalerror(2002090903);
-        end;
-      end;
-
-
-begin
-   paramanager:=tcpuparamanager.create;
-end.

compiler/alpha/cpupi.pas

@@ -1,43 +0,0 @@
-{
-    Copyright (c) 2002 by Florian Klaempfl
-
-    This unit contains the CPU specific part of tprocinfo
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{
-  This unit contains the CPU specific part of tprocinfo.
-}
-unit cpupi;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       cgbase;
-
-    type
-       talphaprocinfo = class(tprocinfo)
-       end;
-
-
-  implementation
-
-begin
-   cprocinfo:=talphaprocinfo;
-end.

compiler/alpha/cputarg.pas

@@ -1,51 +0,0 @@
-{
-    Copyright (c) 2001-2002 by Peter Vreman
-
-    Includes the powerpc dependent target units
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit cputarg;
-
-{$i fpcdefs.inc}
-
-interface
-
-
-implementation
-
-    uses
-      systems { prevent a syntax error when nothing is included }
-
-{**************************************
-             Targets
-**************************************}
-
-    {$ifndef NOTARGETLINUX}
-      ,t_linux
-    {$endif}
-
-{**************************************
-             Assemblers
-**************************************}
-
-    {$ifndef NOAGAXPGAS}
-      ,agaxpgas
-    {$endif}
-      ;
-
-end.

compiler/alpha/rasm.pas

@@ -1,65 +0,0 @@
-{
-    Copyright (c) 1998-2002 by The Free Pascal Team
-
-    This unit does the parsing process for the inline assembler
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{
-  This unit does the parsing process for the inline assembler.
-}
-Unit Rasm;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
-  node;
-
-   {
-     This routine is called to parse the instructions in assembler
-     blocks. It returns a complete list of directive and instructions
-   }
-   function assemble: tnode;
-
-
-Implementation
-
-    uses
-       { common }
-       cutils,cclasses,
-       { global }
-       globtype,globals,verbose,
-       systems,
-       { aasm }
-       cpubase,aasmbase,aasmtai,aasmdata,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner
-       // ,rautils
-       ;
-
-    function assemble : tnode;
-     begin
-     end;
-
-Begin
-end.

compiler/alpha/rgcpu.pas

@@ -1,69 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit implements the powerpc specific class for the register
-    allocator
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-unit rgcpu;
-
-{$i fpcdefs.inc}
-
-  interface
-
-     uses
-       aasmbase,aasmtai,aasmdata,
-       cpubase,
-       rgobj;
-
-     type
-       trgcpu = class(trgobj)
-         function getcpuregisterint(list: TAsmList; reg: tregister): tregister; override;
-         procedure ungetregisterint(list: TAsmList; reg: tregister); override;
-       end;
-
-  implementation
-
-    uses
-      cgobj;
-
-    function trgcpu.getcpuregisterint(list: TAsmList; reg: tregister): tregister;
-
-      begin
-        if reg = R_0 then
-          begin
-            cg.a_reg_alloc(list,reg);
-            result := reg;
-          end
-        else result := inherited getcpuregisterint(list,reg);
-      end;
-
-
-    procedure trgcpu.ungetregisterint(list: TAsmList; reg: tregister);
-
-      begin
-        if reg = R_0 then
-          cg.a_reg_dealloc(list,reg)
-        else
-          inherited ungetregisterint(list,reg);
-      end;
-
-initialization
-  rg := trgcpu.create;
-end.

compiler/alpha/symcpu.pas

@@ -1,211 +0,0 @@
-{
-    Copyright (c) 2014 by Florian Klaempfl
-
-    Symbol table overrides for Alpha
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit symcpu;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  symtype,symdef,symsym;
-
-type
-  { defs }
-  tcpufiledef = class(tfiledef)
-  end;
-  tcpufiledefclass = class of tcpufiledef;
-
-  tcpuvariantdef = class(tvariantdef)
-  end;
-  tcpuvariantdefclass = class of tcpuvariantdef;
-
-  tcpuformaldef = class(tformaldef)
-  end;
-  tcpuformaldefclass = class of tcpuformaldef;
-
-  tcpuforwarddef = class(tforwarddef)
-  end;
-  tcpuforwarddefclass = class of tcpuforwarddef;
-
-  tcpuundefineddef = class(tundefineddef)
-  end;
-  tcpuundefineddefclass = class of tcpuundefineddef;
-
-  tcpuerrordef = class(terrordef)
-  end;
-  tcpuerrordefclass = class of tcpuerrordef;
-
-  tcpupointerdef = class(tpointerdef)
-  end;
-  tcpupointerdefclass = class of tcpupointerdef;
-
-  tcpurecorddef = class(trecorddef)
-  end;
-  tcpurecorddefclass = class of tcpurecorddef;
-
-  tcpuimplementedinterface = class(timplementedinterface)
-  end;
-  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
-
-  tcpuobjectdef = class(tobjectdef)
-  end;
-  tcpuobjectdefclass = class of tcpuobjectdef;
-
-  tcpuclassrefdef = class(tclassrefdef)
-  end;
-  tcpuclassrefdefclass = class of tcpuclassrefdef;
-
-  tcpuarraydef = class(tarraydef)
-  end;
-  tcpuarraydefclass = class of tcpuarraydef;
-
-  tcpuorddef = class(torddef)
-  end;
-  tcpuorddefclass = class of tcpuorddef;
-
-  tcpufloatdef = class(tfloatdef)
-  end;
-  tcpufloatdefclass = class of tcpufloatdef;
-
-  tcpuprocvardef = class(tprocvardef)
-  end;
-  tcpuprocvardefclass = class of tcpuprocvardef;
-
-  tcpuprocdef = class(tprocdef)
-  end;
-  tcpuprocdefclass = class of tcpuprocdef;
-
-  tcpustringdef = class(tstringdef)
-  end;
-  tcpustringdefclass = class of tcpustringdef;
-
-  tcpuenumdef = class(tenumdef)
-  end;
-  tcpuenumdefclass = class of tcpuenumdef;
-
-  tcpusetdef = class(tsetdef)
-  end;
-  tcpusetdefclass = class of tcpusetdef;
-
-  { syms }
-  tcpulabelsym = class(tlabelsym)
-  end;
-  tcpulabelsymclass = class of tcpulabelsym;
-
-  tcpuunitsym = class(tunitsym)
-  end;
-  tcpuunitsymclass = class of tcpuunitsym;
-
-  tcpunamespacesym = class(tnamespacesym)
-  end;
-  tcpunamespacesymclass = class of tcpunamespacesym;
-
-  tcpuprocsym = class(tprocsym)
-  end;
-  tcpuprocsymclass = class of tcpuprocsym;
-
-  tcputypesym = class(ttypesym)
-  end;
-  tcpuypesymclass = class of tcputypesym;
-
-  tcpufieldvarsym = class(tfieldvarsym)
-  end;
-  tcpufieldvarsymclass = class of tcpufieldvarsym;
-
-  tcpulocalvarsym = class(tlocalvarsym)
-  end;
-  tcpulocalvarsymclass = class of tcpulocalvarsym;
-
-  tcpuparavarsym = class(tparavarsym)
-  end;
-  tcpuparavarsymclass = class of tcpuparavarsym;
-
-  tcpustaticvarsym = class(tstaticvarsym)
-  end;
-  tcpustaticvarsymclass = class of tcpustaticvarsym;
-
-  tcpuabsolutevarsym = class(tabsolutevarsym)
-  end;
-  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
-
-  tcpupropertysym = class(tpropertysym)
-  end;
-  tcpupropertysymclass = class of tcpupropertysym;
-
-  tcpuconstsym = class(tconstsym)
-  end;
-  tcpuconstsymclass = class of tcpuconstsym;
-
-  tcpuenumsym = class(tenumsym)
-  end;
-  tcpuenumsymclass = class of tcpuenumsym;
-
-  tcpusyssym = class(tsyssym)
-  end;
-  tcpusyssymclass = class of tcpusyssym;
-
-
-const
-  pbestrealtype : ^tdef = @s64floattype;
-
-
-implementation
-
-begin
-  { used tdef classes }
-  cfiledef:=tcpufiledef;
-  cvariantdef:=tcpuvariantdef;
-  cformaldef:=tcpuformaldef;
-  cforwarddef:=tcpuforwarddef;
-  cundefineddef:=tcpuundefineddef;
-  cerrordef:=tcpuerrordef;
-  cpointerdef:=tcpupointerdef;
-  crecorddef:=tcpurecorddef;
-  cimplementedinterface:=tcpuimplementedinterface;
-  cobjectdef:=tcpuobjectdef;
-  cclassrefdef:=tcpuclassrefdef;
-  carraydef:=tcpuarraydef;
-  corddef:=tcpuorddef;
-  cfloatdef:=tcpufloatdef;
-  cprocvardef:=tcpuprocvardef;
-  cprocdef:=tcpuprocdef;
-  cstringdef:=tcpustringdef;
-  cenumdef:=tcpuenumdef;
-  csetdef:=tcpusetdef;
-
-  { used tsym classes }
-  clabelsym:=tcpulabelsym;
-  cunitsym:=tcpuunitsym;
-  cnamespacesym:=tcpunamespacesym;
-  cprocsym:=tcpuprocsym;
-  ctypesym:=tcputypesym;
-  cfieldvarsym:=tcpufieldvarsym;
-  clocalvarsym:=tcpulocalvarsym;
-  cparavarsym:=tcpuparavarsym;
-  cstaticvarsym:=tcpustaticvarsym;
-  cabsolutevarsym:=tcpuabsolutevarsym;
-  cpropertysym:=tcpupropertysym;
-  cconstsym:=tcpuconstsym;
-  cenumsym:=tcpuenumsym;
-  csyssym:=tcpusyssym;
-end.
-

compiler/alpha/tgcpu.pas

@@ -1,42 +0,0 @@
-{
-    Copyright (C) 1998-2000 by Florian Klaempfl
-
-    This unit handles the temporary variables stuff for Alpha
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-{
-  This unit handles the temporary variables stuff for Alpha.
-}
-unit tgcpu;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       tgobj;
-
-    type
-       ttgalpha = class(ttgobj)
-       end;
-
-implementation
-
-begin
-  tg:=ttgalpha.create;
-end.

compiler/aopt.pas

@@ -279,14 +279,6 @@ Unit aopt;
                 if pass = 0 then
                   PeepHoleOptPass1;
               end;
-            If (cs_opt_asmcse in current_settings.optimizerswitches) Then
-              Begin
-//                DFA:=TAOptDFACpu.Create(AsmL,BlockStart,BlockEnd,LabelInfo);
-                { data flow analyzer }
-//                DFA.DoDFA;
-                { common subexpression elimination }
-      {          CSE;}
-              End;
             { more peephole optimizations }
             if (cs_opt_peephole in current_settings.optimizerswitches) then
               begin

compiler/aoptobj.pas

@@ -1178,7 +1178,11 @@ Unit AoptObj;
 
     function IsJumpToLabel(hp: taicpu): boolean;
       begin
+{$if defined(avr)}
+        result:=(hp.opcode in aopt_uncondjmp) and
+{$else avr}
         result:=(hp.opcode=aopt_uncondjmp) and
+{$endif avr}
 {$if defined(arm) or defined(aarch64)}
           (hp.condition=c_None) and
 {$endif arm or aarch64}

compiler/arm/aasmcpu.pas

@@ -744,7 +744,8 @@ implementation
           A_SXTB16,A_UXTB16,
           A_UXTB,A_UXTH,A_SXTB,A_SXTH,
           A_NEG,
-          A_VABS,A_VADD,A_VCVT,A_VDIV,A_VLDR,A_VMOV,A_VMUL,A_VNEG,A_VSQRT,A_VSUB:
+          A_VABS,A_VADD,A_VCVT,A_VDIV,A_VLDR,A_VMOV,A_VMUL,A_VNEG,A_VSQRT,A_VSUB,
+          A_MRS,A_MSR:
             if opnr=0 then
               result:=operand_write
             else
@@ -2684,8 +2685,13 @@ implementation
         end;
 
       function getcoprocreg(reg: tregister): byte;
+        var
+          tmpr: tregister;
         begin
-          result:=getsupreg(reg)-getsupreg(NR_CR0);
+          { FIXME: temp variable r is needed here to avoid Internal error 20060521 }
+          {        while compiling the compiler. }
+          tmpr:=NR_CR0;
+          result:=getsupreg(reg)-getsupreg(tmpr);
         end;
 
       function getmmreg(reg: tregister): byte;

compiler/arm/cpuinfo.pas

@@ -250,6 +250,17 @@ Type
       ct_stm32f107rc,
       ct_stm32f107vb,
       ct_stm32f107vc,
+      
+      ct_stm32f429xe, // 512K flash
+      ct_stm32f429xg, // 1M flash
+      ct_stm32f429xi, // 2M flash
+
+      ct_stm32f745xe,
+      ct_stm32f745xg,
+      ct_stm32f746xe,
+      ct_stm32f746xg,
+      ct_stm32f756xe,
+      ct_stm32f756xg,
 
       { TI - Fury Class - 64 K Flash, 16 K SRAM Devices }
       ct_lm3s1110,
@@ -341,6 +352,11 @@ Type
       { Allwinner }
       ct_allwinner_a20,
 
+      { Freescale }
+      ct_mk20dx128xxx7,
+      ct_mk20dx256xxx7,
+      ct_mk20dx64xxx7,
+
       // generic Thumb2 target
       ct_thumb2bare
      );
@@ -621,6 +637,17 @@ Const
       (controllertypestr:'STM32F107RC';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'STM32F107VB';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'STM32F107VC';     controllerunitstr:'STM32F10X_CL';     flashbase:$08000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
+      
+      (controllertypestr:'STM32F429XE';     controllerunitstr:'STM32F429';        flashbase:$08000000; flashsize:$00080000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429XG';     controllerunitstr:'STM32F429';        flashbase:$08000000; flashsize:$00100000; srambase:$20000000; sramsize:$00030000),
+      (controllertypestr:'STM32F429XI';     controllerunitstr:'STM32F429';        flashbase:$08000000; flashsize:$00200000; srambase:$20000000; sramsize:$00030000),
+
+      (controllertypestr:'STM32F745XE';     controllerunitstr:'STM32F745';        flashbase:$08000000; flashsize:$00080000; srambase:$20010000; sramsize:$00040000),
+      (controllertypestr:'STM32F745XG';     controllerunitstr:'STM32F745';        flashbase:$08000000; flashsize:$00100000; srambase:$20010000; sramsize:$00040000),
+      (controllertypestr:'STM32F746XE';     controllerunitstr:'STM32F746';        flashbase:$08000000; flashsize:$00080000; srambase:$20010000; sramsize:$00040000),
+      (controllertypestr:'STM32F746XG';     controllerunitstr:'STM32F746';        flashbase:$08000000; flashsize:$00100000; srambase:$20010000; sramsize:$00040000),
+      (controllertypestr:'STM32F756XE';     controllerunitstr:'STM32F756';        flashbase:$08000000; flashsize:$00080000; srambase:$20010000; sramsize:$00040000),
+      (controllertypestr:'STM32F756XG';     controllerunitstr:'STM32F756';        flashbase:$08000000; flashsize:$00100000; srambase:$20010000; sramsize:$00040000),
 
       (controllertypestr:'LM3S1110';	controllerunitstr:'LM3FURY';	flashbase:$00000000;	flashsize:$00010000;	srambase:$20000000;	sramsize:$00004000),
       (controllertypestr:'LM3S1133';	controllerunitstr:'LM3FURY';	flashbase:$00000000;	flashsize:$00010000;	srambase:$20000000;	sramsize:$00004000),
@@ -710,6 +737,11 @@ Const
       { Allwinner }
       (controllertypestr:'ALLWINNER_A20'; controllerunitstr:'ALLWINNER_A20';     flashbase:$00000000; flashsize:$00000000;  srambase:$40000000; sramsize:$80000000),
 
+      { Freescale }
+      (controllertypestr:'MK20DX128XXX7'; controllerunitstr:'MK20D7'; flashbase:$00000000; flashsize:$00020000; srambase:$20000000; sramsize:$00004000),
+      (controllertypestr:'MK20DX256XXX7'; controllerunitstr:'MK20D7'; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00008000),
+      (controllertypestr:'MK20DX64XXX7';  controllerunitstr:'MK20D7'; flashbase:$00000000; flashsize:$00010000; srambase:$20000000; sramsize:$00002000),
+
       { Bare bones }
       (controllertypestr:'THUMB2_BARE';	controllerunitstr:'THUMB2_BARE';	flashbase:$00000000;	flashsize:$00002000;	srambase:$20000000;	sramsize:$00000400)
     );

compiler/arm/cpupara.pas

@@ -131,7 +131,7 @@ unit cpupara;
         psym:=tparavarsym(pd.paras[nr-1]);
         pdef:=psym.vardef;
         if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
-          pdef:=getpointerdef(pdef);
+          pdef:=cpointerdef.getreusable(pdef);
         cgpara.reset;
         cgpara.size:=def_cgsize(pdef);
         cgpara.intsize:=tcgsize2size[cgpara.size];
@@ -202,7 +202,10 @@ unit cpupara;
             filedef:
               getparaloc:=LOC_REGISTER;
             arraydef:
-              getparaloc:=LOC_REFERENCE;
+              if is_dynamic_array(p) then
+                getparaloc:=LOC_REGISTER
+              else
+                getparaloc:=LOC_REFERENCE;
             setdef:
               if is_smallset(p) then
                 getparaloc:=LOC_REGISTER
@@ -415,7 +418,7 @@ unit cpupara;
 
             if push_addr_param(hp.varspez,paradef,p.proccalloption) then
               begin
-                paradef:=getpointerdef(paradef);
+                paradef:=cpointerdef.getreusable(paradef);
                 loc:=LOC_REGISTER;
                 paracgsize := OS_ADDR;
                 paralen := tcgsize2size[OS_ADDR];
@@ -509,7 +512,7 @@ unit cpupara;
                             { LOC_REFERENCE always contains everything that's left }
                             paraloc^.loc:=LOC_REFERENCE;
                             paraloc^.size:=int_cgsize(paralen);
-                            paraloc^.def:=getarraydef(u8inttype,paralen);
+                            paraloc^.def:=carraydef.getreusable(u8inttype,paralen);
                             if (side=callerside) then
                               paraloc^.reference.index:=NR_STACK_POINTER_REG;
                             paraloc^.reference.offset:=stack_offset;
@@ -583,7 +586,7 @@ unit cpupara;
                             { LOC_REFERENCE always contains everything that's left }
                             paraloc^.loc:=LOC_REFERENCE;
                             paraloc^.size:=int_cgsize(paralen);
-                            paraloc^.def:=getarraydef(u8inttype,paralen);
+                            paraloc^.def:=carraydef.getreusable(u8inttype,paralen);
                             if (side=callerside) then
                               paraloc^.reference.index:=NR_STACK_POINTER_REG;
                             paraloc^.reference.offset:=stack_offset;
@@ -596,7 +599,7 @@ unit cpupara;
                         if push_addr_param(hp.varspez,paradef,p.proccalloption) then
                           begin
                             paraloc^.size:=OS_ADDR;
-                            paraloc^.def:=getpointerdef(paradef);
+                            paraloc^.def:=cpointerdef.getreusable(paradef);
                             assignintreg
                           end
                         else

compiler/arm/narmcnv.pas

@@ -314,6 +314,10 @@ implementation
 
          { Load left node into flag F_NE/F_E }
          resflags:=F_NE;
+
+         if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+           hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
          case left.location.loc of
             LOC_CREFERENCE,
             LOC_REFERENCE :

compiler/arm/narmset.pas

@@ -242,6 +242,7 @@ implementation
             { do not use BX here to avoid switching into arm mode }
             current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg(A_MOV, NR_PC, tmpreg));
 
+            current_asmdata.CurrAsmList.Concat(tai_align.Create(4));                
             cg.a_label(current_asmdata.CurrAsmList,tablelabel);
             { generate jump table }
             last:=min_;

compiler/arm/symcpu.pas

@@ -119,6 +119,10 @@ type
   end;
   tcpuunitsymclass = class of tcpuunitsym;
 
+  tcpuprogramparasym = class(tprogramparasym)
+  end;
+  tcpuprogramparasymclass = class(tprogramparasym);
+
   tcpunamespacesym = class(tnamespacesym)
   end;
   tcpunamespacesymclass = class of tcpunamespacesym;
@@ -199,6 +203,7 @@ begin
   { used tsym classes }
   clabelsym:=tcpulabelsym;
   cunitsym:=tcpuunitsym;
+  cprogramparasym:=tcpuprogramparasym;
   cnamespacesym:=tcpunamespacesym;
   cprocsym:=tcpuprocsym;
   ctypesym:=tcputypesym;

compiler/assemble.pas

@@ -33,7 +33,7 @@ interface
 
     uses
       SysUtils,
-      systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase,finput;
+      systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase,owbase,finput;
 
     const
        { maximum of aasmoutput lists there will be }
@@ -147,6 +147,7 @@ interface
       TInternalAssembler=class(TAssembler)
       private
         FCObjOutput : TObjOutputclass;
+        FCInternalAr : TObjectWriterClass;
         { the aasmoutput lists that need to be processed }
         lists        : byte;
         list         : array[1..maxoutputlists] of TAsmList;
@@ -165,6 +166,7 @@ interface
         ObjData   : TObjData;
         ObjOutput : tObjOutput;
         property CObjOutput:TObjOutputclass read FCObjOutput write FCObjOutput;
+        property CInternalAr : TObjectWriterClass read FCInternalAr write FCInternalAr;
       public
         constructor create(smart:boolean);override;
         destructor  destroy;override;
@@ -194,7 +196,7 @@ Implementation
       cpuinfo,
 {$endif m68k or arm}
       aasmcpu,
-      owbase,owar
+      owar,owomflib
       ;
 
     var
@@ -1819,16 +1821,20 @@ Implementation
         startsectype : TAsmSectiontype;
         place: tcutplace;
         ObjWriter : TObjectWriter;
+        startsecname: String;
+        startsecorder: TAsmSectionOrder;
       begin
         if not(cs_asm_leave in current_settings.globalswitches) and
            not(af_needar in target_asm.flags) then
-          ObjWriter:=TARObjectWriter.create(current_module.staticlibfilename)
+          ObjWriter:=CInternalAr.CreateAr(current_module.staticlibfilename)
         else
           ObjWriter:=TObjectwriter.create;
 
         NextSmartName(cut_normal);
         ObjOutput:=CObjOutput.Create(ObjWriter);
-        startsectype:=sec_code;
+        startsectype:=sec_none;
+        startsecname:='';
+        startsecorder:=secorder_default;
 
         { start with list 1 }
         currlistidx:=1;
@@ -1842,7 +1848,8 @@ Implementation
            ObjData.currpass:=0;
            ObjData.resetsections;
            ObjData.beforealloc;
-           ObjData.createsection(startsectype);
+           if startsectype<>sec_none then
+             ObjData.CreateSection(startsectype,startsecname,startsecorder);
            TreePass0(hp);
            ObjData.afteralloc;
            { leave if errors have occured }
@@ -1853,7 +1860,8 @@ Implementation
            ObjData.currpass:=1;
            ObjData.resetsections;
            ObjData.beforealloc;
-           ObjData.createsection(startsectype);
+           if startsectype<>sec_none then
+             ObjData.CreateSection(startsectype,startsecname,startsecorder);
            TreePass1(hp);
            ObjData.afteralloc;
 
@@ -1866,7 +1874,8 @@ Implementation
            ObjOutput.startobjectfile(ObjFileName);
            ObjData.resetsections;
            ObjData.beforewrite;
-           ObjData.createsection(startsectype);
+           if startsectype<>sec_none then
+             ObjData.CreateSection(startsectype,startsecname,startsecorder);
            hp:=TreePass2(hp);
            ObjData.afterwrite;
 
@@ -1892,12 +1901,18 @@ Implementation
              place := cut_normal;
 
            { avoid empty files }
-           startsectype:=sec_code;
+           startsectype:=sec_none;
+           startsecname:='';
+           startsecorder:=secorder_default;
            while assigned(hp) and
                  (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
             begin
               if Tai(hp).typ=ait_section then
-                startsectype:=Tai_section(hp).sectype;
+                begin
+                  startsectype:=Tai_section(hp).sectype;
+                  startsecname:=Tai_section(hp).name^;
+                  startsecorder:=Tai_section(hp).secorder;
+                end;
               if (Tai(hp).typ=ait_cutobject) then
                 place:=Tai_cutobject(hp).place;
               hp:=Tai(hp.next);

compiler/avr/aasmcpu.pas

@@ -250,7 +250,8 @@ implementation
           A_MOV,A_MOVW,A_POP:
             if opnr=0 then
               result:=operand_write;
-          A_CP,A_CPC,A_CPI,A_PUSH,A_SBRC,A_SBRS,A_ST,A_STD,A_STS:
+          A_CP,A_CPC,A_CPI,A_PUSH,A_SBRC,A_SBRS,A_ST,A_STD,A_STS,
+          A_MUL,A_MULS,A_MULSU,A_FMUL,A_FMULS,A_FMULSU:
             ;
           else
             begin
@@ -401,6 +402,7 @@ implementation
         curtai : tai;
         again : boolean;
         l : tasmlabel;
+        inasmblock : Boolean;
       begin
         again:=true;
         while again do
@@ -435,21 +437,41 @@ implementation
               end;
 
             curtai:=tai(list.first);
+            inasmblock:=false;
             while assigned(curtai) do
               begin
-                if (curtai.typ=ait_instruction) and
-                  (taicpu(curtai).opcode in [A_BRxx]) and
-                  ((taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset>64) or
-                   (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset<-63)
-                  ) then
-                  begin
-                    current_asmdata.getjumplabel(l);
-                    list.insertafter(tai_label.create(l),curtai);
-                    list.insertafter(taicpu.op_sym(A_JMP,taicpu(curtai).oper[0]^.ref^.symbol),curtai);
-                    taicpu(curtai).oper[0]^.ref^.symbol:=l;
-                    taicpu(curtai).condition:=inverse_cond(taicpu(curtai).condition);
-                    again:=true;
-                  end;
+                case curtai.typ of
+                  ait_instruction:
+                    case taicpu(curtai).opcode of
+                      A_BRxx:
+                        if (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset>64) or
+                          (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset<-63) then
+                          begin
+                            current_asmdata.getjumplabel(l);
+                            list.insertafter(tai_label.create(l),curtai);
+                            list.insertafter(taicpu.op_sym(A_JMP,taicpu(curtai).oper[0]^.ref^.symbol),curtai);
+                            taicpu(curtai).oper[0]^.ref^.symbol:=l;
+                            taicpu(curtai).condition:=inverse_cond(taicpu(curtai).condition);
+                            again:=true;
+                          end;
+                      A_JMP:
+                        { replace JMP by RJMP? ...
+                          ... but do not mess with asm block }
+                        if not(inasmblock) and (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset<=2048) and
+                        (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset>=-2047) then
+                        begin
+                          taicpu(curtai).opcode:=A_RJMP;
+                          again:=true;
+                        end;
+                    end;
+                  ait_marker:
+                    case tai_marker(curtai).Kind of
+                      mark_AsmBlockStart:
+                        inasmblock:=true;
+                      mark_AsmBlockEnd:
+                        inasmblock:=false;
+                    end;
+                end;
                 curtai:=tai(curtai.next);
               end;
           end;

compiler/avr/agavrgas.pas

@@ -128,8 +128,12 @@ unit agavrgas;
                   case refaddr of
                     addr_hi8:
                       s:='hi8('+s+')';
+                    addr_hi8_gs:
+                      s:='hi8(gs('+s+'))';
                     addr_lo8:
                       s:='lo8('+s+')';
+                    addr_lo8_gs:
+                      s:='lo8(gs('+s+'))';
                     else
                       s:='('+s+')';
                   end;

compiler/avr/aoptcpu.pas

@@ -26,13 +26,19 @@ Unit aoptcpu;
 
 {$i fpcdefs.inc}
 
+{$define DEBUG_AOPTCPU}
+
 Interface
 
 uses cpubase, cgbase, aasmtai, aopt, aoptcpub;
 
 Type
   TCpuAsmOptimizer = class(TAsmOptimizer)
+    { outputs a debug message into the assembler file }
+    procedure DebugMsg(const s: string; p: tai);
+
     Function GetNextInstructionUsingReg(Current: tai; Var Next: tai;reg : TRegister): Boolean;
+    function RegInInstruction(Reg: TRegister; p1: tai): Boolean; override;
 
     { uses the same constructor as TAopObj }
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
@@ -42,9 +48,14 @@ Type
 Implementation
 
   uses
+    cutils,
     cpuinfo,
-    aasmbase,aasmcpu,
-    globals,globtype;
+    aasmbase,aasmcpu,aasmdata,
+    globals,globtype,
+    cgutils;
+
+  type
+    TAsmOpSet = set of TAsmOp;
 
   function CanBeCond(p : tai) : boolean;
     begin
@@ -52,6 +63,79 @@ Implementation
     end;
 
 
+  function RefsEqual(const r1, r2: treference): boolean;
+    begin
+      refsequal :=
+        (r1.offset = r2.offset) and
+        (r1.base = r2.base) and
+        (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
+        (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
+        (r1.relsymbol = r2.relsymbol) and
+        (r1.addressmode = r2.addressmode);
+    end;
+
+
+  function MatchOperand(const oper1: TOper; const oper2: TOper): boolean; inline;
+    begin
+      result:=oper1.typ=oper2.typ;
+
+      if result then
+        case oper1.typ of
+          top_const:
+            Result:=oper1.val = oper2.val;
+          top_reg:
+            Result:=oper1.reg = oper2.reg;
+          top_ref:
+            Result:=RefsEqual(oper1.ref^, oper2.ref^);
+          else Result:=false;
+        end
+    end;
+
+
+  function MatchOperand(const oper: TOper; const reg: TRegister): boolean; inline;
+    begin
+      result := (oper.typ = top_reg) and (oper.reg = reg);
+    end;
+
+
+  function MatchInstruction(const instr: tai; const op: TAsmOp): boolean;
+    begin
+      result :=
+        (instr.typ = ait_instruction) and
+        (taicpu(instr).opcode = op);
+    end;
+
+
+  function MatchInstruction(const instr: tai; const ops: TAsmOpSet): boolean;
+    begin
+      result :=
+        (instr.typ = ait_instruction) and
+        (taicpu(instr).opcode in ops);
+    end;
+
+
+{$ifdef DEBUG_AOPTCPU}
+  procedure TCpuAsmOptimizer.DebugMsg(const s: string;p : tai);
+    begin
+      asml.insertbefore(tai_comment.Create(strpnew(s)), p);
+    end;
+{$else DEBUG_AOPTCPU}
+  procedure TCpuAsmOptimizer.DebugMsg(const s: string;p : tai);inline;
+    begin
+    end;
+{$endif DEBUG_AOPTCPU}
+
+
+  function TCpuAsmOptimizer.RegInInstruction(Reg: TRegister; p1: tai): Boolean;
+    begin
+      If (p1.typ = ait_instruction) and (taicpu(p1).opcode in [A_MUL,A_MULS,A_FMUL,A_FMULS,A_FMULSU]) and
+              ((getsupreg(reg)=RS_R0) or (getsupreg(reg)=RS_R1)) then
+        Result:=true
+      else
+        Result:=inherited RegInInstruction(Reg, p1);
+    end;
+
+
   function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai;
     var Next: tai; reg: TRegister): Boolean;
     begin
@@ -65,261 +149,757 @@ Implementation
 
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
     var
-      hp1,hp2,hp3: tai;
+      hp1,hp2,hp3,hp4,hp5: tai;
       alloc, dealloc: tai_regalloc;
       i: integer;
+      l: TAsmLabel;
     begin
       result := false;
       case p.typ of
         ait_instruction:
           begin
-            case taicpu(p).opcode of
-              A_LDI:
-                begin
-                  { turn
-                    ldi reg0, imm
-                    cp reg1, reg0
-                    dealloc reg0
-                    into
-                    cpi reg1, imm
-                  }
-                  if (taicpu(p).ops=2) and
-                     (taicpu(p).oper[0]^.typ=top_reg) and
-                     (taicpu(p).oper[1]^.typ=top_const) and
-                     GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-                     (hp1.typ=ait_instruction) and
-                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
-                     (taicpu(hp1).opcode=A_CP) and
-                     (taicpu(hp1).ops=2) and
-                     (taicpu(hp1).oper[1]^.typ=top_reg) and
-                     (getsupreg(taicpu(hp1).oper[0]^.reg) in [16..31]) and
-                     (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
-                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
+            {
+              change
+              <op> reg,x,y
+              cp reg,r1
+              into
+              <op>s reg,x,y
+            }
+            { this optimization can applied only to the currently enabled operations because
+              the other operations do not update all flags and FPC does not track flag usage }
+            if MatchInstruction(p, [A_ADC,A_ADD,A_AND,A_ANDI,A_ASR,A_COM,A_DEC,A_EOR,
+                                    A_INC,A_LSL,A_LSR,
+                                    A_OR,A_ORI,A_ROL,A_ROR,A_SBC,A_SBCI,A_SUB,A_SUBI]) and
+              GetNextInstruction(p, hp1) and
+              MatchInstruction(hp1, A_CP) and
+              (((taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg) and
+                (taicpu(hp1).oper[1]^.reg = NR_R1)) or
+               ((taicpu(p).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
+                (taicpu(hp1).oper[0]^.reg = NR_R1) and
+                (taicpu(p).opcode in [A_ADC,A_ADD,A_AND,A_ANDI,A_ASR,A_COM,A_EOR,
+                                      A_LSL,A_LSR,
+                                      A_OR,A_ORI,A_ROL,A_ROR]))) and
+              GetNextInstruction(hp1, hp2) and
+              { be careful here, following instructions could use other flags
+                however after a jump fpc never depends on the value of flags }
+              { All above instructions set Z and N according to the following
+                Z := result = 0;
+                N := result[31];
+                EQ = Z=1; NE = Z=0;
+                MI = N=1; PL = N=0; }
+              MatchInstruction(hp2, A_BRxx) and
+              (taicpu(hp2).condition in [C_EQ,C_NE,C_MI,C_PL]) { and
+              no flag allocation tracking implemented yet on avr
+              assigned(FindRegDealloc(NR_DEFAULTFLAGS,tai(hp2.Next)))} then
+              begin
+                { move flag allocation if possible }
+                { no flag allocation tracking implemented yet on avr
+                GetLastInstruction(hp1, hp2);
+                hp2:=FindRegAlloc(NR_DEFAULTFLAGS,tai(hp2.Next));
+                if assigned(hp2) then
+                  begin
+                    asml.Remove(hp2);
+                    asml.insertbefore(hp2, p);
+                  end;
+                }
+
+                DebugMsg('Peephole OpCp2Op performed', p);
+
+                asml.remove(hp1);
+                hp1.free;
+                Result:=true;
+              end
+            else
+              case taicpu(p).opcode of
+                A_LDI:
+                  begin
+                    { turn
+                      ldi reg0, imm
+                      cp reg1, reg0
+                      dealloc reg0
+                      into
+                      cpi reg1, imm
+                    }
+                    if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ=top_reg) and
+                       (taicpu(p).oper[1]^.typ=top_const) and
+                       GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                       (hp1.typ=ait_instruction) and
+                       (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
+                       (taicpu(hp1).opcode=A_CP) and
+                       (taicpu(hp1).ops=2) and
+                       (taicpu(hp1).oper[1]^.typ=top_reg) and
+                       (getsupreg(taicpu(hp1).oper[0]^.reg) in [16..31]) and
+                       (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
+                      begin
+                        taicpu(hp1).opcode:=A_CPI;
+                        taicpu(hp1).loadconst(1, taicpu(p).oper[1]^.val);
+
+                        alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                        dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
+
+                        if assigned(alloc) and assigned(dealloc) then
+                          begin
+                            asml.Remove(alloc);
+                            alloc.Free;
+                            asml.Remove(dealloc);
+                            dealloc.Free;
+                          end;
+
+                        DebugMsg('Peephole LdiCp2Cpi performed', p);
+
+                        GetNextInstruction(p,hp1);
+                        asml.Remove(p);
+                        p.Free;
+                        p:=hp1;
+
+                        result:=true;
+                      end;
+                  end;
+                A_STS:
+                  if (taicpu(p).oper[0]^.ref^.symbol=nil) and
+                    (taicpu(p).oper[0]^.ref^.relsymbol=nil) and
+                    (getsupreg(taicpu(p).oper[0]^.ref^.base)=RS_NO) and
+                    (getsupreg(taicpu(p).oper[0]^.ref^.index)=RS_NO) and
+                    (taicpu(p).oper[0]^.ref^.addressmode=AM_UNCHANGED) and
+                    (taicpu(p).oper[0]^.ref^.offset>=32) and
+                    (taicpu(p).oper[0]^.ref^.offset<=95) then
                     begin
-                      taicpu(hp1).opcode:=A_CPI;
-                      taicpu(hp1).loadconst(1, taicpu(p).oper[1]^.val);
-
-                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
-                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
-
-                      if assigned(alloc) and assigned(dealloc) then
-                        begin
-                          asml.Remove(alloc);
-                          alloc.Free;
-                          asml.Remove(dealloc);
-                          dealloc.Free;
-                        end;
-
-                      GetNextInstruction(p,hp1);
-                      asml.Remove(p);
-                      p.Free;
-                      p:=hp1;
+                      DebugMsg('Peephole Sts2Out performed', p);
 
-                      result:=true;
+                      taicpu(p).opcode:=A_OUT;
+                      taicpu(p).loadconst(0,taicpu(p).oper[0]^.ref^.offset-32);
                     end;
-                end;
-              A_CLR:
-                begin
-                  { turn the common
-                    clr rX
-                    mov/ld rX, rY
-                    into
-                    mov/ld rX, rY
-                  }
-                  if (taicpu(p).ops=1) and
-                     (taicpu(p).oper[0]^.typ=top_reg) and
-                     GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
-                     (hp1.typ=ait_instruction) and
-                     (taicpu(hp1).opcode in [A_MOV,A_LD]) and
-                     (taicpu(hp1).ops>0) and
-                     (taicpu(hp1).oper[0]^.typ=top_reg) and
-                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) then
+                A_LDS:
+                  if (taicpu(p).oper[1]^.ref^.symbol=nil) and
+                    (taicpu(p).oper[1]^.ref^.relsymbol=nil) and
+                    (getsupreg(taicpu(p).oper[1]^.ref^.base)=RS_NO) and
+                    (getsupreg(taicpu(p).oper[1]^.ref^.index)=RS_NO) and
+                    (taicpu(p).oper[1]^.ref^.addressmode=AM_UNCHANGED) and
+                    (taicpu(p).oper[1]^.ref^.offset>=32) and
+                    (taicpu(p).oper[1]^.ref^.offset<=95) then
                     begin
-                      asml.Remove(p);
-                      p.Free;
-                      p:=hp1;
-                      result:=true;
-                    end
-                  { turn
-                    clr rX
-                    ...
-                    adc rY, rX
-                    into
-                    ...
-                    adc rY, r1
-                  }
-                  else if (taicpu(p).ops=1) and
-                     (taicpu(p).oper[0]^.typ=top_reg) and
-                     GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
-                     (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
-                     (hp1.typ=ait_instruction) and
-                     (taicpu(hp1).opcode in [A_ADC,A_SBC]) and
-                     (taicpu(hp1).ops=2) and
-                     (taicpu(hp1).oper[1]^.typ=top_reg) and
-                     (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
-                     (taicpu(hp1).oper[0]^.reg<>taicpu(p).oper[0]^.reg) and
-                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
-                    begin
-                      taicpu(hp1).oper[1]^.reg:=NR_R1;
-
-                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
-                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
+                      DebugMsg('Peephole Lds2In performed', p);
 
-                      if assigned(alloc) and assigned(dealloc) then
-                        begin
-                          asml.Remove(alloc);
-                          alloc.Free;
-                          asml.Remove(dealloc);
-                          dealloc.Free;
-                        end;
-
-                      GetNextInstruction(p,hp1);
-                      asml.Remove(p);
-                      p.free;
-                      p:=hp1;
-
-                      result:=true;
+                      taicpu(p).opcode:=A_IN;
+                      taicpu(p).loadconst(1,taicpu(p).oper[1]^.ref^.offset-32);
                     end;
-                end;
-              A_PUSH:
-                begin
-                  { turn
-                    push reg0
-                    push reg1
-                    pop reg3
-                    pop reg2
-                    into
-                    movw reg2,reg0
-                  }
-                  if (taicpu(p).ops=1) and
-                     (taicpu(p).oper[0]^.typ=top_reg) and
-                     GetNextInstruction(p,hp1) and
-                     (hp1.typ=ait_instruction) and
-                     (taicpu(hp1).opcode=A_PUSH) and
-                     (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and
-                     ((getsupreg(taicpu(p).oper[0]^.reg) mod 2)=0) and
-
-                     GetNextInstruction(hp1,hp2) and
-                     (hp2.typ=ait_instruction) and
-                     (taicpu(hp2).opcode=A_POP) and
-
-                     GetNextInstruction(hp2,hp3) and
-                     (hp3.typ=ait_instruction) and
-                     (taicpu(hp3).opcode=A_POP) and
-                     (getsupreg(taicpu(hp2).oper[0]^.reg)=getsupreg(taicpu(hp3).oper[0]^.reg)+1) and
-                     ((getsupreg(taicpu(hp3).oper[0]^.reg) mod 2)=0) then
-                    begin
-                      taicpu(p).ops:=2;
-                      taicpu(p).opcode:=A_MOVW;
-
-                      taicpu(p).loadreg(1, taicpu(p).oper[0]^.reg);
-                      taicpu(p).loadreg(0, taicpu(hp3).oper[0]^.reg);
-
-                      asml.Remove(hp1);
-                      hp1.Free;
-                      asml.Remove(hp2);
-                      hp2.Free;
-                      asml.Remove(hp3);
-                      hp3.Free;
-
-                      result:=true;
-                    end;
-                end;
-              A_MOV:
-                begin
-                  { turn
-                    mov reg0, reg1
-                    push reg0
-                    dealloc reg0
-                    into
-                    push reg1
-                  }
-                  if (taicpu(p).ops=2) and
-                     (taicpu(p).oper[0]^.typ = top_reg) and
-                     (taicpu(p).oper[1]^.typ = top_reg) and
-                     GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-                     (not RegModifiedBetween(taicpu(p).oper[1]^.reg, p, hp1)) and
-                     (hp1.typ = ait_instruction) and
-                     (taicpu(hp1).opcode in [A_PUSH,A_MOV,A_CP,A_CPC,A_ADD,A_SUB,A_EOR,A_AND,A_OR]) and
-                     RegInInstruction(taicpu(p).oper[0]^.reg, hp1) and
-                     (not RegModifiedByInstruction(taicpu(p).oper[0]^.reg, hp1)) and
-                     {(taicpu(hp1).ops=1) and
-                     (taicpu(hp1).oper[0]^.typ = top_reg) and
-                     (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and  }
-                     assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
-                    begin
-                      for i := 0 to taicpu(hp1).ops-1 do
-                        if taicpu(hp1).oper[i]^.typ=top_reg then
-                          if taicpu(hp1).oper[i]^.reg=taicpu(p).oper[0]^.reg then
-                            taicpu(hp1).oper[i]^.reg:=taicpu(p).oper[1]^.reg;
-
-                      alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
-                      dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
-
-                      if assigned(alloc) and assigned(dealloc) then
+                A_IN:
+                    if GetNextInstruction(p,hp1) then
+                      begin
+                        {
+                          in rX,Y
+                          ori rX,n
+                          out Y,rX
+
+                          into
+                          sbi rX,lg(n)
+                        }
+                        if (taicpu(p).oper[1]^.val<=31) and
+                          MatchInstruction(hp1,A_ORI) and
+                          (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and
+                          (PopCnt(byte(taicpu(hp1).oper[1]^.val))=1) and
+                          GetNextInstruction(hp1,hp2) and
+                          MatchInstruction(hp2,A_OUT) and
+                          MatchOperand(taicpu(hp2).oper[1]^,taicpu(p).oper[0]^) and
+                          MatchOperand(taicpu(hp2).oper[0]^,taicpu(p).oper[1]^) then
+                          begin
+                            DebugMsg('Peephole InOriOut2Sbi performed', p);
+
+                            taicpu(p).opcode:=A_SBI;
+                            taicpu(p).loadconst(0,taicpu(p).oper[1]^.val);
+                            taicpu(p).loadconst(1,BsrByte(taicpu(hp1).oper[1]^.val));
+                            asml.Remove(hp1);
+                            hp1.Free;
+                            asml.Remove(hp2);
+                            hp2.Free;
+                            result:=true;
+                          end
+                         {
+                          in rX,Y
+                          andi rX,not(n)
+                          out Y,rX
+
+                          into
+                          cbi rX,lg(n)
+                        }
+                        else if (taicpu(p).oper[1]^.val<=31) and
+                           MatchInstruction(hp1,A_ANDI) and
+                           (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and
+                           (PopCnt(byte(not(taicpu(hp1).oper[1]^.val)))=1) and
+                           GetNextInstruction(hp1,hp2) and
+                           MatchInstruction(hp2,A_OUT) and
+                           MatchOperand(taicpu(hp2).oper[1]^,taicpu(p).oper[0]^) and
+                           MatchOperand(taicpu(hp2).oper[0]^,taicpu(p).oper[1]^) then
+                          begin
+                            DebugMsg('Peephole InAndiOut2Cbi performed', p);
+
+                            taicpu(p).opcode:=A_CBI;
+                            taicpu(p).loadconst(0,taicpu(p).oper[1]^.val);
+                            taicpu(p).loadconst(1,BsrByte(not(taicpu(hp1).oper[1]^.val)));
+                            asml.Remove(hp1);
+                            hp1.Free;
+                            asml.Remove(hp2);
+                            hp2.Free;
+                            result:=true;
+                          end
+                         {
+                              in rX,Y
+                              andi rX,n
+                              breq/brne L1
+
+                          into
+                              sbis/sbic Y,lg(n)
+                              jmp L1
+                            .Ltemp:
+                        }
+                        else if (taicpu(p).oper[1]^.val<=31) and
+                           MatchInstruction(hp1,A_ANDI) and
+                           (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and
+                           (PopCnt(byte(taicpu(hp1).oper[1]^.val))=1) and
+                           GetNextInstruction(hp1,hp2) and
+                           MatchInstruction(hp2,A_BRxx) and
+                           (taicpu(hp2).condition in [C_EQ,C_NE]) then
+                          begin
+                            if taicpu(hp2).condition=C_EQ then
+                              taicpu(p).opcode:=A_SBIS
+                            else
+                              taicpu(p).opcode:=A_SBIC;
+
+                            DebugMsg('Peephole InAndiBrx2SbixJmp performed', p);
+
+                            taicpu(p).loadconst(0,taicpu(p).oper[1]^.val);
+                            taicpu(p).loadconst(1,BsrByte(taicpu(hp1).oper[1]^.val));
+                            asml.Remove(hp1);
+                            hp1.Free;
+
+                            taicpu(hp2).condition:=C_None;
+                            if CPUAVR_HAS_JMP_CALL in cpu_capabilities[current_settings.cputype] then
+                              taicpu(hp2).opcode:=A_JMP
+                            else
+                              taicpu(hp2).opcode:=A_RJMP;
+
+                            current_asmdata.getjumplabel(l);
+                            l.increfs;
+                            asml.InsertAfter(tai_label.create(l), hp2);
+
+                            result:=true;
+                          end;
+                      end;
+                A_ANDI:
+                  begin
+                    {
+                      Turn
+                          andi rx, #pow2
+                          brne l
+                          <op>
+                        l:
+                      Into
+                          sbrs rx, #(1 shl imm)
+                          <op>
+                        l:
+                    }
+                    if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[1]^.typ=top_const) and
+                       ispowerof2(taicpu(p).oper[1]^.val,i) and
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(p.next))) and
+                       GetNextInstruction(p,hp1) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).opcode=A_BRxx) and
+                       (taicpu(hp1).condition in [C_EQ,C_NE]) and
+                       (taicpu(hp1).ops>0) and
+                       (taicpu(hp1).oper[0]^.typ = top_ref) and
+                       (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) and
+                       GetNextInstruction(hp1,hp2) and
+                       (hp2.typ=ait_instruction) and
+                       GetNextInstruction(hp2,hp3) and
+                       (hp3.typ=ait_label) and
+                       (taicpu(hp1).oper[0]^.ref^.symbol=tai_label(hp3).labsym) then
+                      begin
+                        DebugMsg('Peephole AndiBr2Sbr performed', p);
+
+                        taicpu(p).oper[1]^.val:=i;
+
+                        if taicpu(hp1).condition=C_NE then
+                          taicpu(p).opcode:=A_SBRS
+                        else
+                          taicpu(p).opcode:=A_SBRC;
+
+                        asml.Remove(hp1);
+                        hp1.free;
+
+                        result:=true;
+                      end
+                    {
+                      Remove
+                        andi rx, #y
+                        dealloc rx
+                    }
+                    else if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ=top_reg) and
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(p.next))) and
+                       (assigned(FindRegDeAlloc(NR_DEFAULTFLAGS,tai(p.Next))) or
+                        (not RegInUsedRegs(NR_DEFAULTFLAGS,UsedRegs))) then
+                      begin
+                        DebugMsg('Redundant Andi removed', p);
+
+                        GetNextInstruction(p,hp1);
+
+                        AsmL.Remove(p);
+                        p.free;
+
+                        p:=hp1;
+
+                        result:=true;
+                      end;
+                  end;
+                A_CLR:
+                  begin
+                    { turn the common
+                      clr rX
+                      mov/ld rX, rY
+                      into
+                      mov/ld rX, rY
+                    }
+                    if (taicpu(p).ops=1) and
+                       (taicpu(p).oper[0]^.typ=top_reg) and
+                       GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                       (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).opcode in [A_MOV,A_LD]) and
+                       (taicpu(hp1).ops>0) and
+                       (taicpu(hp1).oper[0]^.typ=top_reg) and
+                       (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) then
+                      begin
+                        DebugMsg('Peephole ClrMov2Mov performed', p);
+
+                        asml.Remove(p);
+                        p.Free;
+                        p:=hp1;
+                        result:=true;
+                      end
+                    { turn
+                      clr rX
+                      ...
+                      adc rY, rX
+                      into
+                      ...
+                      adc rY, r1
+                    }
+                    else if (taicpu(p).ops=1) and
+                       (taicpu(p).oper[0]^.typ=top_reg) and
+                       GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+                       (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).opcode in [A_ADC,A_SBC]) and
+                       (taicpu(hp1).ops=2) and
+                       (taicpu(hp1).oper[1]^.typ=top_reg) and
+                       (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
+                       (taicpu(hp1).oper[0]^.reg<>taicpu(p).oper[0]^.reg) and
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
+                      begin
+                        DebugMsg('Peephole ClrAdc2Adc performed', p);
+
+                        taicpu(hp1).oper[1]^.reg:=NR_R1;
+
+                        alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                        dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
+
+                        if assigned(alloc) and assigned(dealloc) then
+                          begin
+                            asml.Remove(alloc);
+                            alloc.Free;
+                            asml.Remove(dealloc);
+                            dealloc.Free;
+                          end;
+
+                        GetNextInstruction(p,hp1);
+                        asml.Remove(p);
+                        p.free;
+                        p:=hp1;
+
+                        result:=true;
+                      end;
+                  end;
+                A_PUSH:
+                  begin
+                    { turn
+                      push reg0
+                      push reg1
+                      pop reg3
+                      pop reg2
+                      into
+                      movw reg2,reg0
+                    }
+                    if (taicpu(p).ops=1) and
+                       (taicpu(p).oper[0]^.typ=top_reg) and
+                       GetNextInstruction(p,hp1) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).opcode=A_PUSH) and
+                       (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and
+                       ((getsupreg(taicpu(p).oper[0]^.reg) mod 2)=0) and
+
+                       GetNextInstruction(hp1,hp2) and
+                       (hp2.typ=ait_instruction) and
+                       (taicpu(hp2).opcode=A_POP) and
+
+                       GetNextInstruction(hp2,hp3) and
+                       (hp3.typ=ait_instruction) and
+                       (taicpu(hp3).opcode=A_POP) and
+                       (getsupreg(taicpu(hp2).oper[0]^.reg)=getsupreg(taicpu(hp3).oper[0]^.reg)+1) and
+                       ((getsupreg(taicpu(hp3).oper[0]^.reg) mod 2)=0) then
+                      begin
+                        DebugMsg('Peephole PushPushPopPop2Movw performed', p);
+
+                        taicpu(p).ops:=2;
+                        taicpu(p).opcode:=A_MOVW;
+
+                        taicpu(p).loadreg(1, taicpu(p).oper[0]^.reg);
+                        taicpu(p).loadreg(0, taicpu(hp3).oper[0]^.reg);
+
+                        asml.Remove(hp1);
+                        hp1.Free;
+                        asml.Remove(hp2);
+                        hp2.Free;
+                        asml.Remove(hp3);
+                        hp3.Free;
+
+                        result:=true;
+                      end;
+                  end;
+                A_MOV:
+                  begin
+                    { turn
+                      mov reg0, reg1
+                      push reg0
+                      dealloc reg0
+                      into
+                      push reg1
+                    }
+                    if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ = top_reg) and
+                       (taicpu(p).oper[1]^.typ = top_reg) and
+                       GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+                       (not RegModifiedBetween(taicpu(p).oper[1]^.reg, p, hp1)) and
+                       (hp1.typ = ait_instruction) and
+                       (taicpu(hp1).opcode in [A_PUSH,A_MOV,A_CP,A_CPC,A_ADD,A_SUB,A_ADC,A_SBC,A_EOR,A_AND,A_OR,
+                                               A_OUT,A_IN]) and
+                       RegInInstruction(taicpu(p).oper[0]^.reg, hp1) and
+                       (not RegModifiedByInstruction(taicpu(p).oper[0]^.reg, hp1)) and
+                       {(taicpu(hp1).ops=1) and
+                       (taicpu(hp1).oper[0]^.typ = top_reg) and
+                       (taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg) and  }
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) then
+                      begin
+                        DebugMsg('Peephole MovPush2Push performed', p);
+
+                        for i := 0 to taicpu(hp1).ops-1 do
+                          if taicpu(hp1).oper[i]^.typ=top_reg then
+                            if taicpu(hp1).oper[i]^.reg=taicpu(p).oper[0]^.reg then
+                              taicpu(hp1).oper[i]^.reg:=taicpu(p).oper[1]^.reg;
+
+                        alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                        dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
+
+                        if assigned(alloc) and assigned(dealloc) then
+                          begin
+                            asml.Remove(alloc);
+                            alloc.Free;
+                            asml.Remove(dealloc);
+                            dealloc.Free;
+                          end;
+
+                        GetNextInstruction(p,hp1);
+                        asml.Remove(p);
+                        p.free;
+                        p:=hp1;
+                        result:=true;
+                      end
+                    { remove
+                      mov reg0,reg0
+                    }
+                    else if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ = top_reg) and
+                       (taicpu(p).oper[1]^.typ = top_reg) and
+                       (taicpu(p).oper[0]^.reg = taicpu(p).oper[1]^.reg) then
+                      begin
+                        DebugMsg('Peephole RedundantMov performed', p);
+
+                        GetNextInstruction(p,hp1);
+                        asml.remove(p);
+                        p.free;
+                        p:=hp1;
+                        result:=true;
+                      end
+                    {
+                      Turn
+                        mov rx,ry
+                        op rx,rz
+                        mov ry, rx
+                      Into
+                        op ry,rz
+                    }
+                    else if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ = top_reg) and
+                       (taicpu(p).oper[1]^.typ = top_reg) and
+                       GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).ops >= 1) and
+                       (taicpu(hp1).oper[0]^.typ = top_reg) and
+                       GetNextInstructionUsingReg(hp1,hp2,taicpu(hp1).oper[0]^.reg) and
+                       (hp2.typ=ait_instruction) and
+                       (taicpu(hp2).opcode=A_MOV) and
+                       (taicpu(hp2).oper[0]^.typ = top_reg) and
+                       (taicpu(hp2).oper[1]^.typ = top_reg) and
+                       (taicpu(hp2).oper[0]^.reg = taicpu(p).oper[1]^.reg) and
+                       (taicpu(hp2).oper[1]^.reg = taicpu(hp1).oper[0]^.reg) and
+                       (taicpu(hp2).oper[1]^.reg = taicpu(p).oper[0]^.reg) and
+                       (not RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp2)) and
+                       (taicpu(hp1).opcode in [A_ADD,A_ADC,A_SUB,A_SBC,A_AND,A_OR,A_EOR,
+                                               A_LSL,A_LSR,A_ASR,A_ROR,A_ROL]) and
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg, tai(hp2.Next))) then
+                      begin
+                        DebugMsg('Peephole MovOpMov2Op performed', p);
+
+                        if (taicpu(hp1).ops=2) and
+                           (taicpu(hp1).oper[1]^.typ=top_reg) and
+                           (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then
+                          taicpu(hp1).oper[1]^.reg:=taicpu(p).oper[1]^.reg;
+
+                        taicpu(hp1).oper[0]^.reg:=taicpu(p).oper[1]^.reg;
+
+                        alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                        dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp2.Next));
+
+                        if assigned(alloc) and assigned(dealloc) then
+                          begin
+                            asml.Remove(alloc);
+                            alloc.Free;
+                            asml.Remove(dealloc);
+                            dealloc.Free;
+                          end;
+
+                        GetNextInstruction(p,hp1);
+
+                        asml.remove(p);
+                        p.free;
+                        asml.remove(hp2);
+                        hp2.free;
+
+                        p:=hp1;
+
+                        result:=true;
+                      end
+                    {
+                      Turn
+                        mov rx,ry
+                        op  rx,rw
+                        mov rw,rx
+                      Into
+                        op rw,ry
+                    }
+                    else if (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ = top_reg) and
+                       (taicpu(p).oper[1]^.typ = top_reg) and
+                       GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).ops = 2) and
+                       (taicpu(hp1).oper[0]^.typ = top_reg) and
+                       (taicpu(hp1).oper[1]^.typ = top_reg) and
+                       GetNextInstructionUsingReg(hp1,hp2,taicpu(hp1).oper[0]^.reg) and
+                       (hp2.typ=ait_instruction) and
+                       (taicpu(hp2).opcode=A_MOV) and
+                       (taicpu(hp2).oper[0]^.typ = top_reg) and
+                       (taicpu(hp2).oper[1]^.typ = top_reg) and
+                       (taicpu(hp2).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) and
+                       (taicpu(hp2).oper[1]^.reg = taicpu(hp1).oper[0]^.reg) and
+                       (taicpu(hp2).oper[1]^.reg = taicpu(p).oper[0]^.reg) and
+                       (not RegModifiedBetween(taicpu(p).oper[1]^.reg,p,hp1)) and
+                       (taicpu(hp1).opcode in [A_ADD,A_ADC,A_AND,A_OR,A_EOR]) and
+                       assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg, tai(hp2.Next))) then
+                      begin
+                        DebugMsg('Peephole MovOpMov2Op2 performed', p);
+
+                        taicpu(hp1).oper[0]^.reg:=taicpu(hp2).oper[0]^.reg;
+                        taicpu(hp1).oper[1]^.reg:=taicpu(p).oper[1]^.reg;
+
+                        alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
+                        dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp2.Next));
+
+                        if assigned(alloc) and assigned(dealloc) then
+                          begin
+                            asml.Remove(alloc);
+                            alloc.Free;
+                            asml.Remove(dealloc);
+                            dealloc.Free;
+                          end;
+
+                        GetNextInstruction(p,hp1);
+
+                        asml.remove(p);
+                        p.free;
+                        asml.remove(hp2);
+                        hp2.free;
+
+                        p:=hp1;
+
+                        result:=true;
+                      end
+                    { fold
+                      mov reg2,reg0
+                      mov reg3,reg1
+                      to
+                      movw reg2,reg0
+                    }
+                    else if (CPUAVR_HAS_MOVW in cpu_capabilities[current_settings.cputype]) and
+                       (taicpu(p).ops=2) and
+                       (taicpu(p).oper[0]^.typ = top_reg) and
+                       (taicpu(p).oper[1]^.typ = top_reg) and
+                       getnextinstruction(p,hp1) and
+                       (hp1.typ = ait_instruction) and
+                       (taicpu(hp1).opcode = A_MOV) and
+                       (taicpu(hp1).ops=2) and
+                       (taicpu(hp1).oper[0]^.typ = top_reg) and
+                       (taicpu(hp1).oper[1]^.typ = top_reg) and
+                       (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and
+                       ((getsupreg(taicpu(p).oper[0]^.reg) mod 2)=0) and
+                       ((getsupreg(taicpu(p).oper[1]^.reg) mod 2)=0) and
+                       (getsupreg(taicpu(hp1).oper[1]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)+1) then
+                      begin
+                        DebugMsg('Peephole MovMov2Movw performed', p);
+
+                        alloc:=FindRegAllocBackward(taicpu(hp1).oper[0]^.reg,tai(hp1.Previous));
+                        if assigned(alloc) then
+                          begin
+                            asml.Remove(alloc);
+                            asml.InsertBefore(alloc,p);
+                          end;
+
+                        taicpu(p).opcode:=A_MOVW;
+                        asml.remove(hp1);
+                        hp1.free;
+                        result:=true;
+                      end
+                    {
+                      This removes the first mov from
+                      mov rX,...
+                      mov rX,...
+                    }
+                    else if taicpu(hp1).opcode=A_MOV then
+                      while (hp1.typ=ait_instruction) and (taicpu(hp1).opcode=A_MOV) and
+                            MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^) and
+                            { don't remove the first mov if the second is a mov rX,rX }
+                            not(MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^)) do
                         begin
-                          asml.Remove(alloc);
-                          alloc.Free;
-                          asml.Remove(dealloc);
-                          dealloc.Free;
+                          DebugMsg('Peephole MovMov2Mov performed', p);
+
+                          asml.remove(p);
+                          p.free;
+                          p:=hp1;
+                          GetNextInstruction(hp1,hp1);
+                          result:=true;
+                          if not assigned(hp1) then
+                            break;
                         end;
-
-                      GetNextInstruction(p,hp1);
-                      asml.Remove(p);
-                      p.free;
-                      p:=hp1;
-                      result:=true;
-                    end
-                  { remove
-                    mov reg0,reg0
-                  }
-                  else if (taicpu(p).ops=2) and
-                     (taicpu(p).oper[0]^.typ = top_reg) and
-                     (taicpu(p).oper[1]^.typ = top_reg) and
-                     (taicpu(p).oper[0]^.reg = taicpu(p).oper[1]^.reg) then
-                    begin
-                      GetNextInstruction(p,hp1);
-                      asml.remove(p);
-                      p.free;
-                      p:=hp1;
-                      result:=true;
-                    end
-                  { fold
-                    mov reg2,reg0
-                    mov reg3,reg1
-                    to
-                    movw reg2,reg0
-                  }
-                  else if (CPUAVR_HAS_MOVW in cpu_capabilities[current_settings.cputype]) and
-                     (taicpu(p).ops=2) and
-                     (taicpu(p).oper[0]^.typ = top_reg) and
-                     (taicpu(p).oper[1]^.typ = top_reg) and
-                     getnextinstruction(p,hp1) and
-                     (hp1.typ = ait_instruction) and
-                     (taicpu(hp1).opcode = A_MOV) and
-                     (taicpu(hp1).ops=2) and
-                     (taicpu(hp1).oper[0]^.typ = top_reg) and
-                     (taicpu(hp1).oper[1]^.typ = top_reg) and
-                     (getsupreg(taicpu(hp1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and
-                     ((getsupreg(taicpu(p).oper[0]^.reg) mod 2)=0) and
-                     ((getsupreg(taicpu(p).oper[1]^.reg) mod 2)=0) and
-                     (getsupreg(taicpu(hp1).oper[1]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)+1) then
-                    begin
-                      alloc:=FindRegAllocBackward(taicpu(hp1).oper[0]^.reg,tai(hp1.Previous));
-                      if assigned(alloc) then
-                        begin
-                          asml.Remove(alloc);
-                          asml.InsertBefore(alloc,p);
-                        end;
-
-                      taicpu(p).opcode:=A_MOVW;
-                      asml.remove(hp1);
-                      hp1.free;
-                      result:=true;
-                    end;
-                end;
-            end;
+                  end;
+                A_SBIC,
+                A_SBIS:
+                  begin
+                    {
+                      Turn
+                          sbic/sbis X, y
+                          jmp .L1
+                          op
+                        .L1:
+
+                      into
+                          sbis/sbic X,y
+                          op
+                        .L1:
+                    }
+                    if GetNextInstruction(p, hp1) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).opcode in [A_JMP,A_RJMP]) and
+                       (taicpu(hp1).ops>0) and
+                       (taicpu(hp1).oper[0]^.typ = top_ref) and
+                       (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) and
+                       GetNextInstruction(hp1, hp2) and
+                       (hp2.typ=ait_instruction) and
+                       (not taicpu(hp2).is_jmp) and
+                       GetNextInstruction(hp2, hp3) and
+                       (hp3.typ=ait_label) and
+                       (taicpu(hp1).oper[0]^.ref^.symbol=tai_label(hp3).labsym) then
+                      begin
+                        DebugMsg('Peephole SbiJmp2Sbi performed',p);
+
+                        if taicpu(p).opcode=A_SBIC then
+                          taicpu(p).opcode:=A_SBIS
+                        else
+                          taicpu(p).opcode:=A_SBIC;
+
+                        tai_label(hp3).labsym.decrefs;
+
+                        AsmL.remove(hp1);
+                        taicpu(hp1).Free;
+
+                        result:=true;
+                      end
+                    {
+                      Turn
+                          sbiX X, y
+                          jmp .L1
+                          jmp .L2
+                        .L1:
+                          op
+                        .L2:
+
+                      into
+                          sbiX X,y
+                        .L1:
+                          op
+                        .L2:
+                    }
+                    else if GetNextInstruction(p, hp1) and
+                       (hp1.typ=ait_instruction) and
+                       (taicpu(hp1).opcode in [A_JMP,A_RJMP]) and
+                       (taicpu(hp1).ops>0) and
+                       (taicpu(hp1).oper[0]^.typ = top_ref) and
+                       (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) and
+
+                       GetNextInstruction(hp1, hp2) and
+                       (hp2.typ=ait_instruction) and
+                       (taicpu(hp2).opcode in [A_JMP,A_RJMP]) and
+                       (taicpu(hp2).ops>0) and
+                       (taicpu(hp2).oper[0]^.typ = top_ref) and
+                       (taicpu(hp2).oper[0]^.ref^.symbol is TAsmLabel) and
+
+                       GetNextInstruction(hp2, hp3) and
+                       (hp3.typ=ait_label) and
+                       (taicpu(hp1).oper[0]^.ref^.symbol=tai_label(hp3).labsym) and
+
+                       GetNextInstruction(hp3, hp4) and
+                       (hp4.typ=ait_instruction) and
+
+                       GetNextInstruction(hp4, hp5) and
+                       (hp3.typ=ait_label) and
+                       (taicpu(hp2).oper[0]^.ref^.symbol=tai_label(hp5).labsym) then
+                      begin
+                        DebugMsg('Peephole SbiJmpJmp2Sbi performed',p);
+
+                        tai_label(hp3).labsym.decrefs;
+                        tai_label(hp5).labsym.decrefs;
+
+                        AsmL.remove(hp1);
+                        taicpu(hp1).Free;
+
+                        AsmL.remove(hp2);
+                        taicpu(hp2).Free;
+
+                        result:=true;
+                      end;
+                  end;
+              end;
           end;
       end;
     end;

compiler/avr/aoptcpub.pas

@@ -99,7 +99,7 @@ Const
 
   StoreDst = 0;
 
-  aopt_uncondjmp = A_JMP;
+  aopt_uncondjmp = [A_RJMP,A_JMP];
   aopt_condjmp = A_BRxx;
 
 Implementation
@@ -121,6 +121,13 @@ Implementation
       i : Longint;
     begin
       result:=false;
+      If (p1.typ = ait_instruction) and (taicpu(p1).opcode in [A_MUL,A_MULS,A_FMUL,A_FMULS,A_FMULSU]) and
+              ((getsupreg(reg)=RS_R0) or (getsupreg(reg)=RS_R1)) then
+        begin
+          Result:=true;
+          exit;
+        end;
+
       for i:=0 to taicpu(p1).ops-1 do
         if (taicpu(p1).oper[i]^.typ=top_reg) and (taicpu(p1).oper[i]^.reg=Reg) and (taicpu(p1).spilling_get_operation_type(i) in [operand_write,operand_readwrite]) then
           begin

compiler/avr/cgcpu.pas

@@ -57,6 +57,8 @@ unit cgcpu;
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
         procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister); override;
+        procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); override;
+        procedure a_op_const_reg_reg(list : TAsmList;op : TOpCg;size : tcgsize; a : tcgint;src,dst : tregister); override;
 
         { move instructions }
         procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override;
@@ -107,6 +109,7 @@ unit cgcpu;
       protected
         procedure a_op_reg_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
         procedure a_op_const_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister);
+        procedure maybegetcpuregister(list : tasmlist; reg : tregister);
       end;
 
       tcg64favr = class(tcg64f32)
@@ -399,12 +402,12 @@ unit cgcpu;
     procedure tcgavr.a_call_reg(list : TAsmList;reg: tregister);
       begin
         a_reg_alloc(list,NR_ZLO);
+        emit_mov(list,NR_ZLO,reg);
         a_reg_alloc(list,NR_ZHI);
-        list.concat(taicpu.op_reg_reg(A_MOV,NR_ZLO,reg));
-        list.concat(taicpu.op_reg_reg(A_MOV,NR_ZHI,GetHigh(reg)));
+        emit_mov(list,NR_ZHI,GetHigh(reg));
         list.concat(taicpu.op_none(A_ICALL));
-        a_reg_dealloc(list,NR_ZLO);
         a_reg_dealloc(list,NR_ZHI);
+        a_reg_dealloc(list,NR_ZLO);
 
         include(current_procinfo.flags,pi_do_call);
       end;
@@ -426,6 +429,48 @@ unit cgcpu;
        end;
 
 
+     procedure tcgavr.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister);
+       begin
+         if (op in [OP_MUL,OP_IMUL]) and (size in [OS_16,OS_S16]) and
+            (CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype]) then
+           begin
+             getcpuregister(list,NR_R0);
+             getcpuregister(list,NR_R1);
+             list.concat(taicpu.op_reg_reg(A_MUL,src1,src2));
+             emit_mov(list,dst,NR_R0);
+             emit_mov(list,GetNextReg(dst),NR_R1);
+             list.concat(taicpu.op_reg_reg(A_MUL,GetNextReg(src1),src2));
+             list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
+             list.concat(taicpu.op_reg_reg(A_MUL,src1,GetNextReg(src2)));
+             list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
+             ungetcpuregister(list,NR_R0);
+             list.concat(taicpu.op_reg(A_CLR,NR_R1));
+             ungetcpuregister(list,NR_R1);
+           end
+         else
+          inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+       end;
+
+
+     procedure tcgavr.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister);
+       begin
+         if (op in [OP_MUL,OP_IMUL]) and (size in [OS_16,OS_S16]) and (a in [2,4,8]) then
+           begin
+             emit_mov(list,dst,src);
+             emit_mov(list,GetNextReg(dst),GetNextReg(src));
+             a:=a shr 1;
+             while a>0 do
+               begin
+                 list.concat(taicpu.op_reg(A_LSL,dst));
+                 list.concat(taicpu.op_reg(A_ROL,GetNextReg(dst)));
+                 a:=a shr 1;
+               end;
+           end
+         else
+           inherited a_op_const_reg_reg(list,op,size,a,src,dst);
+       end;
+
+
      procedure tcgavr.a_op_reg_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
        var
          countreg,
@@ -533,40 +578,64 @@ unit cgcpu;
              begin
                if size in [OS_8,OS_S8] then
                  begin
-                   cg.a_reg_alloc(list,NR_R0);
-                   cg.a_reg_alloc(list,NR_R1);
-                   list.concat(taicpu.op_reg_reg(topcg2asmop[op],dst,src));
-                   cg.a_reg_dealloc(list,NR_R1);
-                   list.concat(taicpu.op_reg_reg(A_MOV,dst,NR_R0));
-                   cg.a_reg_dealloc(list,NR_R0);
+                   if CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype] then
+                     begin
+                       cg.a_reg_alloc(list,NR_R0);
+                       cg.a_reg_alloc(list,NR_R1);
+                       list.concat(taicpu.op_reg_reg(topcg2asmop[op],dst,src));
+                       list.concat(taicpu.op_reg(A_CLR,NR_R1));
+                       cg.a_reg_dealloc(list,NR_R1);
+                       list.concat(taicpu.op_reg_reg(A_MOV,dst,NR_R0));
+                       cg.a_reg_dealloc(list,NR_R0);
+                     end
+                   else
+                     internalerror(2015061001);
                  end
                else if size=OS_16 then
                  begin
-                   pd:=search_system_proc('fpc_mul_word');
-                   paraloc1.init;
-                   paraloc2.init;
-                   paraloc3.init;
-                   paramanager.getintparaloc(list,pd,1,paraloc1);
-                   paramanager.getintparaloc(list,pd,2,paraloc2);
-                   paramanager.getintparaloc(list,pd,3,paraloc3);
-                   a_load_const_cgpara(list,OS_8,0,paraloc3);
-                   a_load_reg_cgpara(list,OS_16,src,paraloc2);
-                   a_load_reg_cgpara(list,OS_16,dst,paraloc1);
-                   paramanager.freecgpara(list,paraloc3);
-                   paramanager.freecgpara(list,paraloc2);
-                   paramanager.freecgpara(list,paraloc1);
-                   alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                   a_call_name(list,'FPC_MUL_WORD',false);
-                   dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-                   cg.a_reg_alloc(list,NR_R23);
-                   cg.a_reg_alloc(list,NR_R24);
-                   cg.a_load_reg_reg(list,OS_8,OS_8,NR_R23,dst);
-                   cg.a_reg_dealloc(list,NR_R23);
-                   cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,GetNextReg(dst));
-                   cg.a_reg_dealloc(list,NR_R24);
-                   paraloc3.done;
-                   paraloc2.done;
-                   paraloc1.done;
+                   if CPUAVR_HAS_MUL in cpu_capabilities[current_settings.cputype] then
+                     begin
+                       tmpreg:=getintregister(list,OS_16);
+                       emit_mov(list,tmpreg,dst);
+                       emit_mov(list,GetNextReg(tmpreg),GetNextReg(dst));
+                       list.concat(taicpu.op_reg_reg(A_MUL,tmpreg,src));
+                       emit_mov(list,dst,NR_R0);
+                       emit_mov(list,GetNextReg(dst),NR_R1);
+                       list.concat(taicpu.op_reg_reg(A_MUL,GetNextReg(tmpreg),src));
+                       list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
+                       list.concat(taicpu.op_reg_reg(A_MUL,tmpreg,GetNextReg(src)));
+                       list.concat(taicpu.op_reg_reg(A_ADD,GetNextReg(dst),NR_R0));
+                       list.concat(taicpu.op_reg(A_CLR,NR_R1));
+                     end
+                   else
+                     begin
+                       { keep code for muls with overflow checking }
+                       pd:=search_system_proc('fpc_mul_word');
+                       paraloc1.init;
+                       paraloc2.init;
+                       paraloc3.init;
+                       paramanager.getintparaloc(list,pd,1,paraloc1);
+                       paramanager.getintparaloc(list,pd,2,paraloc2);
+                       paramanager.getintparaloc(list,pd,3,paraloc3);
+                       a_load_const_cgpara(list,OS_8,0,paraloc3);
+                       a_load_reg_cgpara(list,OS_16,src,paraloc2);
+                       a_load_reg_cgpara(list,OS_16,dst,paraloc1);
+                       paramanager.freecgpara(list,paraloc3);
+                       paramanager.freecgpara(list,paraloc2);
+                       paramanager.freecgpara(list,paraloc1);
+                       alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                       a_call_name(list,'FPC_MUL_WORD',false);
+                       dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                       cg.a_reg_alloc(list,NR_R24);
+                       cg.a_reg_alloc(list,NR_R25);
+                       cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,dst);
+                       cg.a_reg_dealloc(list,NR_R24);
+                       cg.a_load_reg_reg(list,OS_8,OS_8,NR_R25,GetNextReg(dst));
+                       cg.a_reg_dealloc(list,NR_R25);
+                       paraloc3.done;
+                       paraloc2.done;
+                       paraloc1.done;
+                     end;
                  end
                else
                  internalerror(2011022002);
@@ -663,7 +732,7 @@ unit cgcpu;
        var
          mask : qword;
          shift : byte;
-         i : byte;
+         i,j : byte;
          tmpreg : tregister;
          tmpreg64 : tregister64;
 
@@ -679,9 +748,19 @@ unit cgcpu;
         curvalue : byte;
 
        begin
+         optimize_op_const(size,op,a);
          mask:=$ff;
          shift:=0;
          case op of
+           OP_NONE:
+             begin
+               { Opcode is optimized away }
+             end;
+           OP_MOVE:
+             begin
+               { Optimized, replaced with a simple load }
+               a_load_const_reg(list,size,a,reg);
+             end;
            OP_OR:
              begin
                for i:=1 to tcgsize2size[size] do
@@ -722,6 +801,71 @@ unit cgcpu;
                      end;
                  end;
              end;
+           OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR:
+             begin
+               if a*tcgsize2size[size]<=8 then
+                 begin
+                   for j:=1 to a do
+                     begin
+                       case op of
+                         OP_SHR:
+                           list.concat(taicpu.op_reg(A_LSR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
+                         OP_SHL:
+                           list.concat(taicpu.op_reg(A_LSL,reg));
+                         OP_SAR:
+                           list.concat(taicpu.op_reg(A_ASR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
+                         OP_ROR:
+                           begin
+                             { load carry? }
+                             if not(size in [OS_8,OS_S8]) then
+                               begin
+                                 list.concat(taicpu.op_none(A_CLC));
+                                 list.concat(taicpu.op_reg_const(A_SBRC,reg,0));
+                                 list.concat(taicpu.op_none(A_SEC));
+                               end;
+                             list.concat(taicpu.op_reg(A_ROR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1)));
+                           end;
+                         OP_ROL:
+                           begin
+                             { load carry? }
+                             if not(size in [OS_8,OS_S8]) then
+                               begin
+                                 list.concat(taicpu.op_none(A_CLC));
+                                 list.concat(taicpu.op_reg_const(A_SBRC,GetOffsetReg64(reg,reghi,tcgsize2size[size]-1),7));
+                                 list.concat(taicpu.op_none(A_SEC));
+                               end;
+                             list.concat(taicpu.op_reg(A_ROL,reg))
+                           end;
+                         else
+                           internalerror(2011030901);
+                       end;
+                       if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then
+                         begin
+                           for i:=2 to tcgsize2size[size] do
+                             begin
+                               case op of
+                                 OP_ROR,
+                                 OP_SHR:
+                                   list.concat(taicpu.op_reg(A_ROR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-i)));
+                                 OP_ROL,
+                                 OP_SHL:
+                                   list.concat(taicpu.op_reg(A_ROL,GetOffsetReg64(reg,reghi,i-1)));
+                                 OP_SAR:
+                                   list.concat(taicpu.op_reg(A_ROR,GetOffsetReg64(reg,reghi,tcgsize2size[size]-i)));
+                                 else
+                                   internalerror(2011030902);
+                               end;
+                           end;
+                         end;
+                   end;
+                 end
+               else
+                 begin
+                   tmpreg:=getintregister(list,size);
+                   a_load_const_reg(list,size,a,tmpreg);
+                   a_op_reg_reg(list,op,size,tmpreg,reg);
+                 end;
+             end;
            OP_ADD:
              begin
                curvalue:=a and mask;
@@ -765,9 +909,10 @@ unit cgcpu;
                end
              else
                begin
-                 { if (op=OP_SAR) and (a=31) and (size in [OS_32,OS_S32]) then
+{$if 0}
+                 { code not working yet }
+                 if (op=OP_SAR) and (a=31) and (size in [OS_32,OS_S32]) then
                    begin
-                     { code not working yet }
                      tmpreg:=reg;
                      for i:=1 to 4 do
                        begin
@@ -776,7 +921,7 @@ unit cgcpu;
                        end;
                    end
                  else
-                 }
+{$endif}
                    begin
                      tmpreg:=getintregister(list,size);
                      a_load_const_reg(list,size,a,tmpreg);
@@ -810,14 +955,15 @@ unit cgcpu;
        end;
 
 
-    function tcgavr.normalize_ref(list:TAsmList;ref: treference;tmpreg : tregister) : treference;
+    procedure tcgavr.maybegetcpuregister(list:tasmlist;reg : tregister);
+      begin
+        { allocate the register only, if a cpu register is passed }
+        if getsupreg(reg)<first_int_imreg then
+          getcpuregister(list,reg);
+      end;
 
-      procedure maybegetcpuregister(list:tasmlist;reg : tregister);
-        begin
-          { allocate the register only, if a cpu register is passed }
-          if getsupreg(reg)<first_int_imreg then
-            getcpuregister(list,reg);
-        end;
+
+    function tcgavr.normalize_ref(list:TAsmList;ref: treference;tmpreg : tregister) : treference;
 
       var
         tmpref : treference;
@@ -837,17 +983,47 @@ unit cgcpu;
             ref.base:=ref.index;
             ref.index:=NR_NO;
           end;
-        if assigned(ref.symbol) or (ref.offset<>0) then
+
+        { can we take advantage of adiw/sbiw? }
+        if (current_settings.cputype>=cpu_avr2) and not(assigned(ref.symbol)) and (ref.offset<>0) and (ref.offset>=-63) and (ref.offset<=63) and
+          ((tmpreg=NR_R24) or (tmpreg=NR_R26) or (tmpreg=NR_R28) or (tmpreg=NR_R30)) and (ref.base<>NR_NO) then
+          begin
+            maybegetcpuregister(list,tmpreg);
+            emit_mov(list,tmpreg,ref.base);
+            maybegetcpuregister(list,GetNextReg(tmpreg));
+            emit_mov(list,GetNextReg(tmpreg),GetNextReg(ref.base));
+            if ref.index<>NR_NO then
+              begin
+                list.concat(taicpu.op_reg_reg(A_ADD,tmpreg,ref.index));
+                list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(tmpreg),GetNextReg(ref.index)));
+              end;
+            if ref.offset>0 then
+              list.concat(taicpu.op_reg_const(A_ADIW,tmpreg,ref.offset))
+            else
+              list.concat(taicpu.op_reg_const(A_SBIW,tmpreg,-ref.offset));
+            ref.offset:=0;
+            ref.base:=tmpreg;
+            ref.index:=NR_NO;
+          end
+        else if assigned(ref.symbol) or (ref.offset<>0) then
           begin
             reference_reset(tmpref,0);
             tmpref.symbol:=ref.symbol;
             tmpref.offset:=ref.offset;
-            tmpref.refaddr:=addr_lo8;
+            if assigned(ref.symbol) and (ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) then
+              tmpref.refaddr:=addr_lo8_gs
+            else
+              tmpref.refaddr:=addr_lo8;
             maybegetcpuregister(list,tmpreg);
             list.concat(taicpu.op_reg_ref(A_LDI,tmpreg,tmpref));
-            tmpref.refaddr:=addr_hi8;
+
+            if assigned(ref.symbol) and (ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) then
+              tmpref.refaddr:=addr_hi8_gs
+            else
+              tmpref.refaddr:=addr_hi8;
             maybegetcpuregister(list,GetNextReg(tmpreg));
             list.concat(taicpu.op_reg_ref(A_LDI,GetNextReg(tmpreg),tmpref));
+
             if (ref.base<>NR_NO) then
               begin
                 list.concat(taicpu.op_reg_reg(A_ADD,tmpreg,ref.base));
@@ -905,20 +1081,39 @@ unit cgcpu;
          QuickRef : Boolean;
        begin
          QuickRef:=false;
-         if not((Ref.addressmode=AM_UNCHANGED) and
-                (Ref.symbol=nil) and
-                ((Ref.base=NR_R28) or
-                 (Ref.base=NR_R29)) and
-                 (Ref.Index=NR_No) and
-                 (Ref.Offset in [0..64-tcgsize2size[tosize]])) and
-           not((Ref.Base=NR_NO) and (Ref.Index=NR_NO)) then
-           href:=normalize_ref(list,Ref,NR_R30)
-         else
+
+         href:=Ref;
+         { ensure, href.base contains a valid register if there is any register used }
+         if href.base=NR_NO then
            begin
-             QuickRef:=true;
-             href:=Ref;
+             href.base:=href.index;
+             href.index:=NR_NO;
            end;
 
+         { try to use std/sts }
+         if not((href.Base=NR_NO) and (href.Index=NR_NO)) then
+           begin
+             if not((href.addressmode=AM_UNCHANGED) and
+                    (href.symbol=nil) and
+                     (href.Index=NR_NO) and
+                     (href.Offset in [0..64-tcgsize2size[fromsize]])) then
+               href:=normalize_ref(list,href,NR_R30)
+             else
+               begin
+                 if (href.base<>NR_R28) and (href.base<>NR_R30) then
+                   begin
+                     maybegetcpuregister(list,NR_R30);
+                     emit_mov(list,NR_R30,href.base);
+                     maybegetcpuregister(list,NR_R31);
+                     emit_mov(list,NR_R31,GetNextReg(href.base));
+                     href.base:=NR_R30;
+                   end;
+                 QuickRef:=true;
+               end;
+           end
+         else
+           QuickRef:=true;
+
          if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then
            internalerror(2011021307);
 
@@ -1077,20 +1272,39 @@ unit cgcpu;
          QuickRef : boolean;
        begin
          QuickRef:=false;
-         if not((Ref.addressmode=AM_UNCHANGED) and
-                (Ref.symbol=nil) and
-                ((Ref.base=NR_R28) or
-                 (Ref.base=NR_R29)) and
-                 (Ref.Index=NR_No) and
-                 (Ref.Offset in [0..64-tcgsize2size[fromsize]])) and
-           not((Ref.Base=NR_NO) and (Ref.Index=NR_NO)) then
-           href:=normalize_ref(list,Ref,NR_R30)
-         else
+
+         href:=Ref;
+         { ensure, href.base contains a valid register if there is any register used }
+         if href.base=NR_NO then
            begin
-             QuickRef:=true;
-             href:=Ref;
+             href.base:=href.index;
+             href.index:=NR_NO;
            end;
 
+         { try to use ldd/lds }
+         if not((href.Base=NR_NO) and (href.Index=NR_NO)) then
+           begin
+             if not((href.addressmode=AM_UNCHANGED) and
+                    (href.symbol=nil) and
+                     (href.Index=NR_NO) and
+                     (href.Offset in [0..64-tcgsize2size[fromsize]])) then
+               href:=normalize_ref(list,href,NR_R30)
+             else
+               begin
+                 if (href.base<>NR_R28) and (href.base<>NR_R30) then
+                   begin
+                     maybegetcpuregister(list,NR_R30);
+                     emit_mov(list,NR_R30,href.base);
+                     maybegetcpuregister(list,NR_R31);
+                     emit_mov(list,NR_R31,GetNextReg(href.base));
+                     href.base:=NR_R30;
+                   end;
+                 QuickRef:=true;
+               end;
+           end
+         else
+           QuickRef:=true;
+
          if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then
            internalerror(2011021307);
 
@@ -1552,29 +1766,77 @@ unit cgcpu;
          regs : tcpuregisterset;
          reg : tsuperregister;
       begin
-        if not(nostackframe) then
+        if po_interrupt in current_procinfo.procdef.procoptions then
           begin
-            { save int registers }
-            regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
-            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+            { check if the framepointer is actually used, this is done here because
+              we have to know the size of the locals (must be 0), avr does not know
+              an sp based stack }
+
+            if not(current_procinfo.procdef.stack_tainting_parameter(calleeside)) and
+              (localsize=0) then
+              current_procinfo.framepointer:=NR_NO;
+
+            { save int registers,
+              but only if the procedure returns }
+            if not(po_noreturn in current_procinfo.procdef.procoptions) then
+              regs:=rg[R_INTREGISTER].used_in_proc
+            else
+              regs:=[];
+            { if the framepointer is potentially used, save it always because we need a proper stack frame,
+              even if the procedure never returns, the procedure could be e.g. a nested one accessing
+              an outer stackframe }
+            if current_procinfo.framepointer<>NR_NO then
               regs:=regs+[RS_R28,RS_R29];
 
+            regs:=regs+[RS_R0];
+
             for reg:=RS_R31 downto RS_R0 do
               if reg in regs then
                 list.concat(taicpu.op_reg(A_PUSH,newreg(R_INTREGISTER,reg,R_SUBWHOLE)));
 
-            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+            { Save SREG }
+            list.concat(taicpu.op_reg_const(A_IN, NR_R0, $3F));
+            list.concat(taicpu.op_reg(A_PUSH, NR_R0));
+
+            if current_procinfo.framepointer<>NR_NO then
               begin
                 list.concat(taicpu.op_reg_const(A_IN,NR_R28,NIO_SP_LO));
                 list.concat(taicpu.op_reg_const(A_IN,NR_R29,NIO_SP_HI));
-              end
+                a_adjust_sp(list,-localsize);
+              end;
+          end
+        else if not(nostackframe) then
+          begin
+            { check if the framepointer is actually used, this is done here because
+              we have to know the size of the locals (must be 0), avr does not know
+              an sp based stack }
+
+            if not(current_procinfo.procdef.stack_tainting_parameter(calleeside)) and
+              (localsize=0) then
+              current_procinfo.framepointer:=NR_NO;
+
+            { save int registers,
+              but only if the procedure returns }
+            if not(po_noreturn in current_procinfo.procdef.procoptions) then
+              regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)
             else
-              { the framepointer cannot be omitted on avr because sp
-                is not a register but part of the i/o map
-              }
-              internalerror(2011021901);
+              regs:=[];
+            { if the framepointer is potentially used, save it always because we need a proper stack frame,
+              even if the procedure never returns, the procedure could be e.g. a nested one accessing
+              an outer stackframe }
+            if current_procinfo.framepointer<>NR_NO then
+              regs:=regs+[RS_R28,RS_R29];
 
-            a_adjust_sp(list,-localsize);
+            for reg:=RS_R31 downto RS_R0 do
+              if reg in regs then
+                list.concat(taicpu.op_reg(A_PUSH,newreg(R_INTREGISTER,reg,R_SUBWHOLE)));
+
+            if current_procinfo.framepointer<>NR_NO then
+              begin
+                list.concat(taicpu.op_reg_const(A_IN,NR_R28,NIO_SP_LO));
+                list.concat(taicpu.op_reg_const(A_IN,NR_R29,NIO_SP_HI));
+                a_adjust_sp(list,-localsize);
+              end;
           end;
       end;
 
@@ -1585,28 +1847,49 @@ unit cgcpu;
         reg : TSuperRegister;
         LocalSize : longint;
       begin
-        if not(nostackframe) then
+        { every byte counts for avr, so if a subroutine is marked as non-returning, we do
+          not generate any exit code, so we really trust the noreturn directive
+        }
+        if po_noreturn in current_procinfo.procdef.procoptions then
+          exit;
+        if po_interrupt in current_procinfo.procdef.procoptions then
           begin
-            if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
+            regs:=rg[R_INTREGISTER].used_in_proc;
+            if current_procinfo.framepointer<>NR_NO then
               begin
+                regs:=regs+[RS_R28,RS_R29];
                 LocalSize:=current_procinfo.calc_stackframe_size;
                 a_adjust_sp(list,LocalSize);
-                regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
-                if current_procinfo.framepointer<>NR_STACK_POINTER_REG then
-                  regs:=regs+[RS_R28,RS_R29];
+              end;
 
-                for reg:=RS_R0 to RS_R31 do
-                  if reg in regs then
-                    list.concat(taicpu.op_reg(A_POP,newreg(R_INTREGISTER,reg,R_SUBWHOLE)));
+            { Reload SREG }
+            regs:=regs+[RS_R0];
 
-              end
-            else
-              { the framepointer cannot be omitted on avr because sp
-                is not a register but part of the i/o map
-              }
-              internalerror(2011021902);
-          end;
-        list.concat(taicpu.op_none(A_RET));
+            list.concat(taicpu.op_reg(A_POP, NR_R0));
+            list.concat(taicpu.op_const_reg(A_OUT, $3F, NR_R0));
+
+            for reg:=RS_R0 to RS_R31 do
+              if reg in regs then
+                list.concat(taicpu.op_reg(A_POP,newreg(R_INTREGISTER,reg,R_SUBWHOLE)));
+
+            list.concat(taicpu.op_none(A_RETI));
+          end
+        else if not(nostackframe) then
+          begin
+            regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall);
+            if current_procinfo.framepointer<>NR_NO then
+              begin
+                regs:=regs+[RS_R28,RS_R29];
+                LocalSize:=current_procinfo.calc_stackframe_size;
+                a_adjust_sp(list,LocalSize);
+              end;
+            for reg:=RS_R0 to RS_R31 do
+              if reg in regs then
+                list.concat(taicpu.op_reg(A_POP,newreg(R_INTREGISTER,reg,R_SUBWHOLE)));
+            list.concat(taicpu.op_none(A_RET));
+          end
+        else
+          list.concat(taicpu.op_none(A_RET));
       end;
 
 
@@ -1622,10 +1905,19 @@ unit cgcpu;
             reference_reset(tmpref,0);
             tmpref.symbol:=ref.symbol;
             tmpref.offset:=ref.offset;
-            tmpref.refaddr:=addr_lo8;
+
+            if assigned(ref.symbol) and (ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) then
+              tmpref.refaddr:=addr_lo8_gs
+            else
+              tmpref.refaddr:=addr_lo8;
             list.concat(taicpu.op_reg_ref(A_LDI,r,tmpref));
-            tmpref.refaddr:=addr_hi8;
+
+            if assigned(ref.symbol) and (ref.symbol.typ in [AT_FUNCTION,AT_LABEL]) then
+              tmpref.refaddr:=addr_hi8_gs
+            else
+              tmpref.refaddr:=addr_hi8;
             list.concat(taicpu.op_reg_ref(A_LDI,GetNextReg(r),tmpref));
+
             if (ref.base<>NR_NO) then
               begin
                 list.concat(taicpu.op_reg_reg(A_ADD,r,ref.base));
@@ -1732,7 +2024,7 @@ unit cgcpu;
             cg.a_label(list,l);
             list.concat(taicpu.op_reg_ref(GetLoad(srcref),NR_R0,srcref));
             list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,NR_R0));
-            a_op_const_reg(list,OP_SUB,countregsize,1,countreg);
+            list.concat(taicpu.op_reg(A_DEC,countreg));
             a_jmp_flags(list,F_NE,l);
             // keep registers alive
             list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg));
@@ -1744,7 +2036,7 @@ unit cgcpu;
             if not((source.addressmode=AM_UNCHANGED) and
                    (source.symbol=nil) and
                    ((source.base=NR_R28) or
-                    (source.base=NR_R29)) and
+                    (source.base=NR_R30)) and
                     (source.Index=NR_NO) and
                     (source.Offset in [0..64-len])) and
               not((source.Base=NR_NO) and (source.Index=NR_NO)) then
@@ -1758,7 +2050,7 @@ unit cgcpu;
             if not((dest.addressmode=AM_UNCHANGED) and
                    (dest.symbol=nil) and
                    ((dest.base=NR_R28) or
-                    (dest.base=NR_R29)) and
+                    (dest.base=NR_R30)) and
                     (dest.Index=NR_No) and
                     (dest.Offset in [0..64-len])) and
               not((dest.Base=NR_NO) and (dest.Index=NR_NO)) then

compiler/avr/cpubase.pas

@@ -44,14 +44,16 @@ unit cpubase;
 
     type
       TAsmOp=(A_None,
-        A_ADD,A_ADC,A_ADIW,A_SUB,A_SUBI,A_SBC,A_SBCI,A_SBRC,A_SBRS,A_CLC,A_SEC,A_SBIW,A_AND,A_ANDI,
-        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_ADD,A_ADC,A_ADIW,A_SUB,A_SUBI,A_SBC,A_SBCI,A_SBRC,A_SBRS,A_SBIW,A_AND,A_ANDI,
+        A_OR,A_ORI,A_EOR,A_COM,A_NEG,A_SBR,A_CBR,A_INC,A_DEC,A_TST,
+        A_MUL,A_MULS,A_MULSU,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_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_CLI,A_BRAK,A_NOP,A_SLEEP,A_WDR);
+        A_SEC,A_SEH,A_SEI,A_SEN,A_SER,A_SES,A_SET,A_SEV,A_SEZ,
+        A_CLC,A_CLH,A_CLI,A_CLN,A_CLR,A_CLS,A_CLT,A_CLV,A_CLZ,
+        A_BST,A_BLD,A_BREAK,A_NOP,A_SLEEP,A_WDR);
 
 
       { This should define the array of instructions as string }
@@ -66,6 +68,7 @@ unit cpubase;
       { call/reg instructions (A_RCALL,A_ICALL,A_CALL,A_RET,A_RETI) are not considered as jmp instructions for the usage cases of
         this set }
       jmp_instructions = [A_BRxx,A_SBIC,A_SBIS,A_JMP,A_EIJMP,A_RJMP,A_CPSE,A_IJMP];
+      call_jmp_instructions = [A_ICALL,A_RCALL,A_CALL,A_RET,A_RETI]+jmp_instructions;
 
 {*****************************************************************************
                                   Registers
@@ -212,9 +215,13 @@ unit cpubase;
       { Defines the default address size for a processor, }
       OS_ADDR = OS_16;
       { the natural int size for a processor,
-        has to match osuinttype/ossinttype as initialized in psystem }
-      OS_INT = OS_16;
-      OS_SINT = OS_S16;
+        has to match osuinttype/ossinttype as initialized in psystem,
+        initially, this was OS_16/OS_S16 on avr, but experience has
+        proven that it is better to make it 8 Bit thus having the same
+        size as a register.
+      }
+      OS_INT = OS_8;
+      OS_SINT = OS_S8;
       { the maximum float size for a processor,           }
       OS_FLOAT = OS_F64;
       { the size of a vector register for a processor     }
@@ -481,7 +488,7 @@ unit cpubase;
 
     function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
       begin
-        is_calljmp:= o in jmp_instructions;
+        is_calljmp:= o in call_jmp_instructions;
       end;
 
 

compiler/avr/cpuinfo.pas

@@ -58,11 +58,150 @@ Type
 
       ct_avrsim,
 
+      ct_atmega645,
+      ct_atmega165a,
+      ct_attiny44a,
+      ct_atmega649a,
+      ct_atmega32u4,
+      ct_attiny26,
+      ct_at90usb1287,
+      ct_at90pwm161,
+      ct_attiny48,
+      ct_atmega168p,
+      ct_attiny10,
+      ct_attiny84a,
+      ct_at90usb82,
+      ct_attiny2313,
+      ct_attiny461,
+      ct_atmega3250pa,
+      ct_atmega3290a,
+      ct_atmega165p,
+      ct_attiny43u,
+      ct_at90usb162,
+      ct_atmega16u4,
+      ct_attiny24a,
+      ct_atmega88p,
+      ct_attiny88,
+      ct_atmega6490p,
+      ct_attiny40,
+      ct_atmega324p,
+      ct_attiny167,
+      ct_atmega328,
+      ct_attiny861,
+      ct_attiny85,
+      ct_atmega64m1,
+      ct_atmega645p,
+      ct_atmega8u2,
+      ct_atmega329a,
+      ct_atmega8a,
+      ct_atmega324pa,
+      ct_atmega32hvb,
+      ct_at90pwm316,
+      ct_at90pwm3b,
+      ct_at90usb646,
+      ct_attiny20,
       ct_atmega16,
-      ct_atmega32,
+      ct_atmega48a,
+      ct_attiny24,
+      ct_atmega644,
+      ct_atmega1284,
+      ct_ata6285,
+      ct_at90can64,
       ct_atmega48,
+      ct_at90can32,
+      ct_attiny9,
+      ct_attiny87,
+      ct_atmega1281,
+      ct_at90pwm216,
+      ct_atmega3250a,
+      ct_atmega88a,
+      ct_atmega128rfa1,
+      ct_atmega3290pa,
+      ct_at90pwm81,
+      ct_atmega325p,
+      ct_attiny84,
+      ct_atmega328p,
+      ct_attiny13a,
+      ct_atmega8,
+      ct_atmega1284p,
+      ct_atmega16u2,
+      ct_attiny45,
+      ct_atmega3250,
+      ct_atmega329,
+      ct_atmega32a,
+      ct_attiny5,
+      ct_at90can128,
+      ct_atmega6490,
+      ct_atmega8515,
+      ct_atmega88pa,
+      ct_atmega168a,
+      ct_atmega128,
+      ct_at90usb1286,
+      ct_atmega164pa,
+      ct_attiny828,
+      ct_atmega88,
+      ct_atmega645a,
+      ct_atmega3290p,
+      ct_atmega644p,
+      ct_atmega164a,
+      ct_attiny4313,
+      ct_atmega162,
+      ct_atmega32c1,
+      ct_atmega128a,
+      ct_atmega324a,
+      ct_attiny13,
+      ct_atmega2561,
+      ct_atmega169a,
+      ct_attiny261,
+      ct_atmega644a,
+      ct_atmega3290,
+      ct_atmega64a,
+      ct_atmega169p,
+      ct_atmega2560,
+      ct_atmega32,
+      ct_attiny861a,
+      ct_attiny28,
+      ct_atmega48p,
+      ct_atmega8535,
+      ct_atmega168pa,
+      ct_atmega16m1,
+      ct_atmega16hvb,
+      ct_atmega164p,
+      ct_atmega325a,
+      ct_atmega640,
+      ct_atmega6450,
+      ct_atmega329p,
+      ct_ata6286,
+      ct_at90usb647,
+      ct_atmega168,
+      ct_atmega6490a,
+      ct_atmega32m1,
+      ct_atmega64c1,
+      ct_atmega32u2,
+      ct_attiny4,
+      ct_atmega644pa,
+      ct_at90pwm1,
+      ct_attiny44,
+      ct_atmega325pa,
+      ct_atmega6450a,
+      ct_attiny2313a,
+      ct_atmega329pa,
+      ct_attiny461a,
+      ct_atmega6450p,
       ct_atmega64,
-      ct_atmega128
+      ct_atmega165pa,
+      ct_atmega16a,
+      ct_atmega649,
+      ct_atmega1280,
+      ct_at90pwm2b,
+      ct_atmega649p,
+      ct_atmega3250p,
+      ct_atmega48pa,
+      ct_attiny1634,
+      ct_atmega325,
+      ct_atmega169pa,
+      ct_attiny261a,
+      ct_attiny25
      );
 
 Const
@@ -113,7 +252,7 @@ Const
    {$WARN 3177 OFF}
    embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
    ((
-   	controllertypestr:'';
+        controllertypestr:'';
         controllerunitstr:'';
         flashbase:0;
         flashsize:0;
@@ -121,60 +260,10 @@ Const
         sramsize:0;
         eeprombase:0;
         eepromsize:0
-   	),
-   	(
-        controllertypestr:'AVRSIM';
-        controllerunitstr:'AVRSIM';
-        flashbase:0;
-        flashsize:$20000;
-        srambase:0;
-        sramsize:4096;
-        eeprombase:0;
-        eepromsize:4096;
-        ),
-        (
-   	controllertypestr:'ATMEGA16';
-        controllerunitstr:'ATMEGA16';
-        flashbase:0;
-        flashsize:$4000;
-        srambase:0;
-        sramsize:1024;
-        eeprombase:0;
-        eepromsize:512
         ),
         (
-   	controllertypestr:'ATMEGA32';
-        controllerunitstr:'ATMEGA32';
-        flashbase:0;
-        flashsize:$8000;
-        srambase:0;
-        sramsize:1024;
-        eeprombase:0;
-        eepromsize:512
-        ),
-   	(
-        controllertypestr:'ATMEGA48';
-        controllerunitstr:'ATMEGA48';
-        flashbase:0;
-        flashsize:$1000;
-        srambase:0;
-        sramsize:512;
-        eeprombase:0;
-        eepromsize:256;
-        ),
-   	(
-        controllertypestr:'ATMEGA64';
-        controllerunitstr:'ATMEGA64';
-        flashbase:0;
-        flashsize:$10000;
-        srambase:0;
-        sramsize:4096;
-        eeprombase:0;
-        eepromsize:2048;
-        ),
-   	(
-        controllertypestr:'ATMEGA128';
-        controllerunitstr:'ATMEGA128';
+        controllertypestr:'AVRSIM';
+        controllerunitstr:'AVRSIM';
         flashbase:0;
         flashsize:$20000;
         srambase:0;
@@ -182,6 +271,150 @@ Const
         eeprombase:0;
         eepromsize:4096;
         )
+        ,(controllertypestr:'ATMEGA645'; controllerunitstr:'ATMEGA645'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA165A'; controllerunitstr:'ATMEGA165A'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY44A'; controllerunitstr:'ATTINY44A'; flashbase:0; flashsize:4096; srambase:96; sramsize:256; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA649A'; controllerunitstr:'ATMEGA649A'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA32U4'; controllerunitstr:'ATMEGA32U4'; flashbase:0; flashsize:32768; srambase:256; sramsize:2560; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY26'; controllerunitstr:'ATTINY26'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
+        ,(controllertypestr:'AT90USB1287'; controllerunitstr:'AT90USB1287'; flashbase:0; flashsize:131072; srambase:256; sramsize:8192; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'AT90PWM161'; controllerunitstr:'AT90PWM161'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY48'; controllerunitstr:'ATTINY48'; flashbase:0; flashsize:4096; srambase:256; sramsize:256; eeprombase:0; eepromsize:64)
+        ,(controllertypestr:'ATMEGA168P'; controllerunitstr:'ATMEGA168P'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY10'; controllerunitstr:'ATTINY10'; flashbase:0; flashsize:1024; srambase:64; sramsize:32; eeprombase:0; eepromsize:0)
+        ,(controllertypestr:'ATTINY84A'; controllerunitstr:'ATTINY84A'; flashbase:0; flashsize:8192; srambase:96; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'AT90USB82'; controllerunitstr:'AT90USB82'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY2313'; controllerunitstr:'ATTINY2313'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
+        ,(controllertypestr:'ATTINY461'; controllerunitstr:'ATTINY461'; flashbase:0; flashsize:4096; srambase:96; sramsize:256; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA3250PA'; controllerunitstr:'ATMEGA3250PA'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA3290A'; controllerunitstr:'ATMEGA3290A'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA165P'; controllerunitstr:'ATMEGA165P'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY43U'; controllerunitstr:'ATTINY43U'; flashbase:0; flashsize:4096; srambase:96; sramsize:256; eeprombase:0; eepromsize:64)
+        ,(controllertypestr:'AT90USB162'; controllerunitstr:'AT90USB162'; flashbase:0; flashsize:16384; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA16U4'; controllerunitstr:'ATMEGA16U4'; flashbase:0; flashsize:16384; srambase:256; sramsize:1280; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY24A'; controllerunitstr:'ATTINY24A'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
+        ,(controllertypestr:'ATMEGA88P'; controllerunitstr:'ATMEGA88P'; flashbase:0; flashsize:8192; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY88'; controllerunitstr:'ATTINY88'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:64)
+        ,(controllertypestr:'ATMEGA6490P'; controllerunitstr:'ATMEGA6490P'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATTINY40'; controllerunitstr:'ATTINY40'; flashbase:0; flashsize:4096; srambase:64; sramsize:256; eeprombase:0; eepromsize:0)
+        ,(controllertypestr:'ATMEGA324P'; controllerunitstr:'ATMEGA324P'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY167'; controllerunitstr:'ATTINY167'; flashbase:0; flashsize:16384; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA328'; controllerunitstr:'ATMEGA328'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY861'; controllerunitstr:'ATTINY861'; flashbase:0; flashsize:8192; srambase:96; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY85'; controllerunitstr:'ATTINY85'; flashbase:0; flashsize:8192; srambase:96; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA64M1'; controllerunitstr:'ATMEGA64M1'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA645P'; controllerunitstr:'ATMEGA645P'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA8U2'; controllerunitstr:'ATMEGA8U2'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA329A'; controllerunitstr:'ATMEGA329A'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA8A'; controllerunitstr:'ATMEGA8A'; flashbase:0; flashsize:8192; srambase:96; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA324PA'; controllerunitstr:'ATMEGA324PA'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA32HVB'; controllerunitstr:'ATMEGA32HVB'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'AT90PWM316'; controllerunitstr:'AT90PWM316'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'AT90PWM3B'; controllerunitstr:'AT90PWM3B'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'AT90USB646'; controllerunitstr:'AT90USB646'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATTINY20'; controllerunitstr:'ATTINY20'; flashbase:0; flashsize:2048; srambase:64; sramsize:128; eeprombase:0; eepromsize:0)
+        ,(controllertypestr:'ATMEGA16'; controllerunitstr:'ATMEGA16'; flashbase:0; flashsize:16384; srambase:96; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA48A'; controllerunitstr:'ATMEGA48A'; flashbase:0; flashsize:4096; srambase:256; sramsize:512; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATTINY24'; controllerunitstr:'ATTINY24'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
+        ,(controllertypestr:'ATMEGA644'; controllerunitstr:'ATMEGA644'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA1284'; controllerunitstr:'ATMEGA1284'; flashbase:0; flashsize:131072; srambase:256; sramsize:16384; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATA6285'; controllerunitstr:'ATA6285'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:320)
+        ,(controllertypestr:'AT90CAN64'; controllerunitstr:'AT90CAN64'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA48'; controllerunitstr:'ATMEGA48'; flashbase:0; flashsize:4096; srambase:256; sramsize:512; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'AT90CAN32'; controllerunitstr:'AT90CAN32'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY9'; controllerunitstr:'ATTINY9'; flashbase:0; flashsize:1024; srambase:64; sramsize:32; eeprombase:0; eepromsize:0)
+        ,(controllertypestr:'ATTINY87'; controllerunitstr:'ATTINY87'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA1281'; controllerunitstr:'ATMEGA1281'; flashbase:0; flashsize:131072; srambase:512; sramsize:8192; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'AT90PWM216'; controllerunitstr:'AT90PWM216'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA3250A'; controllerunitstr:'ATMEGA3250A'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA88A'; controllerunitstr:'ATMEGA88A'; flashbase:0; flashsize:8192; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA128RFA1'; controllerunitstr:'ATMEGA128RFA1'; flashbase:0; flashsize:131072; srambase:512; sramsize:16384; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA3290PA'; controllerunitstr:'ATMEGA3290PA'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'AT90PWM81'; controllerunitstr:'AT90PWM81'; flashbase:0; flashsize:8192; srambase:256; sramsize:256; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA325P'; controllerunitstr:'ATMEGA325P'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY84'; controllerunitstr:'ATTINY84'; flashbase:0; flashsize:8192; srambase:96; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA328P'; controllerunitstr:'ATMEGA328P'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY13A'; controllerunitstr:'ATTINY13A'; flashbase:0; flashsize:1024; srambase:96; sramsize:64; eeprombase:0; eepromsize:64)
+        ,(controllertypestr:'ATMEGA8'; controllerunitstr:'ATMEGA8'; flashbase:0; flashsize:8192; srambase:96; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA1284P'; controllerunitstr:'ATMEGA1284P'; flashbase:0; flashsize:131072; srambase:256; sramsize:16384; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA16U2'; controllerunitstr:'ATMEGA16U2'; flashbase:0; flashsize:16384; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY45'; controllerunitstr:'ATTINY45'; flashbase:0; flashsize:4096; srambase:96; sramsize:256; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA3250'; controllerunitstr:'ATMEGA3250'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA329'; controllerunitstr:'ATMEGA329'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA32A'; controllerunitstr:'ATMEGA32A'; flashbase:0; flashsize:32768; srambase:96; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY5'; controllerunitstr:'ATTINY5'; flashbase:0; flashsize:512; srambase:64; sramsize:32; eeprombase:0; eepromsize:0)
+        ,(controllertypestr:'AT90CAN128'; controllerunitstr:'AT90CAN128'; flashbase:0; flashsize:131072; srambase:256; sramsize:4096; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA6490'; controllerunitstr:'ATMEGA6490'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA8515'; controllerunitstr:'ATMEGA8515'; flashbase:0; flashsize:8192; srambase:96; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA88PA'; controllerunitstr:'ATMEGA88PA'; flashbase:0; flashsize:8192; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA168A'; controllerunitstr:'ATMEGA168A'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA128'; controllerunitstr:'ATMEGA128'; flashbase:0; flashsize:131072; srambase:256; sramsize:4096; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'AT90USB1286'; controllerunitstr:'AT90USB1286'; flashbase:0; flashsize:131072; srambase:256; sramsize:8192; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA164PA'; controllerunitstr:'ATMEGA164PA'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY828'; controllerunitstr:'ATTINY828'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA88'; controllerunitstr:'ATMEGA88'; flashbase:0; flashsize:8192; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA645A'; controllerunitstr:'ATMEGA645A'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA3290P'; controllerunitstr:'ATMEGA3290P'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA644P'; controllerunitstr:'ATMEGA644P'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA164A'; controllerunitstr:'ATMEGA164A'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY4313'; controllerunitstr:'ATTINY4313'; flashbase:0; flashsize:4096; srambase:96; sramsize:256; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA162'; controllerunitstr:'ATMEGA162'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA32C1'; controllerunitstr:'ATMEGA32C1'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA128A'; controllerunitstr:'ATMEGA128A'; flashbase:0; flashsize:131072; srambase:256; sramsize:4096; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA324A'; controllerunitstr:'ATMEGA324A'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY13'; controllerunitstr:'ATTINY13'; flashbase:0; flashsize:1024; srambase:96; sramsize:64; eeprombase:0; eepromsize:64)
+        ,(controllertypestr:'ATMEGA2561'; controllerunitstr:'ATMEGA2561'; flashbase:0; flashsize:262144; srambase:512; sramsize:8192; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA169A'; controllerunitstr:'ATMEGA169A'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY261'; controllerunitstr:'ATTINY261'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
+        ,(controllertypestr:'ATMEGA644A'; controllerunitstr:'ATMEGA644A'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA3290'; controllerunitstr:'ATMEGA3290'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA64A'; controllerunitstr:'ATMEGA64A'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA169P'; controllerunitstr:'ATMEGA169P'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA2560'; controllerunitstr:'ATMEGA2560'; flashbase:0; flashsize:262144; srambase:512; sramsize:8192; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA32'; controllerunitstr:'ATMEGA32'; flashbase:0; flashsize:32768; srambase:96; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY861A'; controllerunitstr:'ATTINY861A'; flashbase:0; flashsize:8192; srambase:96; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY28'; controllerunitstr:'ATTINY28'; flashbase:0; flashsize:2048; srambase:0; sramsize:0; eeprombase:0; eepromsize:0)
+        ,(controllertypestr:'ATMEGA48P'; controllerunitstr:'ATMEGA48P'; flashbase:0; flashsize:4096; srambase:256; sramsize:512; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA8535'; controllerunitstr:'ATMEGA8535'; flashbase:0; flashsize:8192; srambase:96; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA168PA'; controllerunitstr:'ATMEGA168PA'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA16M1'; controllerunitstr:'ATMEGA16M1'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA16HVB'; controllerunitstr:'ATMEGA16HVB'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA164P'; controllerunitstr:'ATMEGA164P'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA325A'; controllerunitstr:'ATMEGA325A'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA640'; controllerunitstr:'ATMEGA640'; flashbase:0; flashsize:65536; srambase:512; sramsize:8192; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'ATMEGA6450'; controllerunitstr:'ATMEGA6450'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA329P'; controllerunitstr:'ATMEGA329P'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATA6286'; controllerunitstr:'ATA6286'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:320)
+        ,(controllertypestr:'AT90USB647'; controllerunitstr:'AT90USB647'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA168'; controllerunitstr:'ATMEGA168'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA6490A'; controllerunitstr:'ATMEGA6490A'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA32M1'; controllerunitstr:'ATMEGA32M1'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA64C1'; controllerunitstr:'ATMEGA64C1'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA32U2'; controllerunitstr:'ATMEGA32U2'; flashbase:0; flashsize:32768; srambase:256; sramsize:1024; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY4'; controllerunitstr:'ATTINY4'; flashbase:0; flashsize:512; srambase:64; sramsize:32; eeprombase:0; eepromsize:0)
+        ,(controllertypestr:'ATMEGA644PA'; controllerunitstr:'ATMEGA644PA'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'AT90PWM1'; controllerunitstr:'AT90PWM1'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY44'; controllerunitstr:'ATTINY44'; flashbase:0; flashsize:4096; srambase:96; sramsize:256; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA325PA'; controllerunitstr:'ATMEGA325PA'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA6450A'; controllerunitstr:'ATMEGA6450A'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATTINY2313A'; controllerunitstr:'ATTINY2313A'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
+        ,(controllertypestr:'ATMEGA329PA'; controllerunitstr:'ATMEGA329PA'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATTINY461A'; controllerunitstr:'ATTINY461A'; flashbase:0; flashsize:4096; srambase:96; sramsize:256; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA6450P'; controllerunitstr:'ATMEGA6450P'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA64'; controllerunitstr:'ATMEGA64'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA165PA'; controllerunitstr:'ATMEGA165PA'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA16A'; controllerunitstr:'ATMEGA16A'; flashbase:0; flashsize:16384; srambase:96; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA649'; controllerunitstr:'ATMEGA649'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA1280'; controllerunitstr:'ATMEGA1280'; flashbase:0; flashsize:131072; srambase:512; sramsize:8192; eeprombase:0; eepromsize:4096)
+        ,(controllertypestr:'AT90PWM2B'; controllerunitstr:'AT90PWM2B'; flashbase:0; flashsize:8192; srambase:256; sramsize:512; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATMEGA649P'; controllerunitstr:'ATMEGA649P'; flashbase:0; flashsize:65536; srambase:256; sramsize:4096; eeprombase:0; eepromsize:2048)
+        ,(controllertypestr:'ATMEGA3250P'; controllerunitstr:'ATMEGA3250P'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA48PA'; controllerunitstr:'ATMEGA48PA'; flashbase:0; flashsize:4096; srambase:256; sramsize:512; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATTINY1634'; controllerunitstr:'ATTINY1634'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:256)
+        ,(controllertypestr:'ATMEGA325'; controllerunitstr:'ATMEGA325'; flashbase:0; flashsize:32768; srambase:256; sramsize:2048; eeprombase:0; eepromsize:1024)
+        ,(controllertypestr:'ATMEGA169PA'; controllerunitstr:'ATMEGA169PA'; flashbase:0; flashsize:16384; srambase:256; sramsize:1024; eeprombase:0; eepromsize:512)
+        ,(controllertypestr:'ATTINY261A'; controllerunitstr:'ATTINY261A'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
+        ,(controllertypestr:'ATTINY25'; controllerunitstr:'ATTINY25'; flashbase:0; flashsize:2048; srambase:96; sramsize:128; eeprombase:0; eepromsize:128)
    );
 
    { Supported optimizations, only used for information }
@@ -214,17 +447,17 @@ Const
 
  const
    cpu_capabilities : array[tcputype] of set of tcpuflags =
-     ( { cpu_none } [],
-       { cpu_avr1 } [CPUAVR_2_BYTE_PC],
-       { cpu_avr2 } [CPUAVR_2_BYTE_PC],
+     ( { cpu_none  } [],
+       { cpu_avr1  } [CPUAVR_2_BYTE_PC],
+       { cpu_avr2  } [CPUAVR_2_BYTE_PC],
        { cpu_avr25 } [CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_2_BYTE_PC],
-       { cpu_avr3 } [CPUAVR_HAS_JMP_CALL,CPUAVR_2_BYTE_PC],
+       { cpu_avr3  } [CPUAVR_HAS_JMP_CALL,CPUAVR_2_BYTE_PC],
        { cpu_avr31 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_RAMPZ,CPUAVR_HAS_ELPM,CPUAVR_2_BYTE_PC],
        { cpu_avr35 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_2_BYTE_PC],
-       { cpu_avr4 } [CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_2_BYTE_PC],
-       { cpu_avr5 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_2_BYTE_PC],
+       { cpu_avr4  } [CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_2_BYTE_PC],
+       { cpu_avr5  } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_2_BYTE_PC],
        { cpu_avr51 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_HAS_RAMPZ,CPUAVR_HAS_ELPM,CPUAVR_HAS_ELPMX,CPUAVR_2_BYTE_PC],
-       { cpu_avr6 } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_HAS_RAMPZ,CPUAVR_HAS_ELPM,CPUAVR_HAS_ELPMX,CPUAVR_3_BYTE_PC]
+       { cpu_avr6  } [CPUAVR_HAS_JMP_CALL,CPUAVR_HAS_MOVW,CPUAVR_HAS_LPMX,CPUAVR_HAS_MUL,CPUAVR_HAS_RAMPZ,CPUAVR_HAS_ELPM,CPUAVR_HAS_ELPMX,CPUAVR_3_BYTE_PC]
      );
 
 Implementation

compiler/avr/cpupara.pas

@@ -99,7 +99,10 @@ unit cpupara;
             filedef:
               getparaloc:=LOC_REGISTER;
             arraydef:
-              getparaloc:=LOC_REFERENCE;
+              if is_dynamic_array(p) then
+                getparaloc:=LOC_REGISTER
+              else
+                getparaloc:=LOC_REFERENCE;
             setdef:
               if is_smallset(p) then
                 getparaloc:=LOC_REGISTER
@@ -252,7 +255,7 @@ unit cpupara;
 
             if push_addr_param(hp.varspez,paradef,p.proccalloption) then
               begin
-                paradef:=getpointerdef(paradef);
+                paradef:=cpointerdef.getreusable(paradef);
                 loc:=LOC_REGISTER;
                 paracgsize:=OS_ADDR;
                 paralen:=tcgsize2size[OS_ADDR];
@@ -343,13 +346,14 @@ unit cpupara;
                         else
                           { parameters are always passed completely in registers or in memory on avr }
                           internalerror(2015041002);
+                        dec(paralen,tcgsize2size[paraloc^.size]);
                       end;
                     LOC_REFERENCE:
                       begin
                         if push_addr_param(hp.varspez,paradef,p.proccalloption) then
                           begin
                             paraloc^.size:=OS_ADDR;
-                            paraloc^.def:=getpointerdef(paradef);
+                            paraloc^.def:=cpointerdef.getreusable(paradef);
                             assignintreg
                           end
                         else
@@ -360,6 +364,7 @@ unit cpupara;
                              paraloc^.reference.offset:=stack_offset;
                              inc(stack_offset,hp.vardef.size);
                           end;
+                        dec(paralen,hp.vardef.size);
                       end;
                     else
                       internalerror(2002071002);
@@ -372,7 +377,6 @@ unit cpupara;
                          inc(paraloc^.reference.offset,2);
                        end;
                    end;
-                 dec(paralen,tcgsize2size[paraloc^.size]);
                  firstparaloc:=false;
                end;
           end;

compiler/avr/cpupi.pas

@@ -56,7 +56,9 @@ unit cpupi;
     procedure tavrprocinfo.set_first_temp_offset;
       begin
         if tg.direction = -1 then
-          tg.setfirsttemp(0)
+          tg.setfirsttemp(-1)
+        else if not (po_nostackframe in procdef.procoptions) then
+          tg.setfirsttemp(maxpushedparasize+1)
         else
           tg.setfirsttemp(maxpushedparasize);
       end;
@@ -64,8 +66,13 @@ unit cpupi;
 
     function tavrprocinfo.calc_stackframe_size:longint;
       begin
-        maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,4));
-        result:=Align(tg.direction*tg.lasttemp,max(current_settings.alignment.localalignmin,4))+maxpushedparasize;
+        if tg.lasttemp=2 then
+          { correct that lasttemp is 2 in case of an empty stack due to the post-decrement pushing and an additional correction
+            in tgobj.setfirsttemp.
+          }
+          result:=maxpushedparasize
+        else
+          result:=tg.direction*tg.lasttemp+maxpushedparasize;
       end;
 
 

compiler/avr/itcpugas.pas

@@ -35,14 +35,16 @@ interface
       processor manufacturer.
     }
     gas_op2str : op2strtable = ('',
-        'add','adc','adiw','sub','subi','sbc','sbci','sbrc','sbrs','clc','sec','sbiw','and','andi',
-        'or','ori','eor','com','neg','sbr','cbr','inc','dec','tst','clr',
-        'ser','mul','muls','fmul','fmuls','fmulsu','rjmp','ijmp',
+        'add','adc','adiw','sub','subi','sbc','sbci','sbrc','sbrs','sbiw','and','andi',
+        'or','ori','eor','com','neg','sbr','cbr','inc','dec','tst',
+        'mul','muls','mulsu','fmul','fmuls','fmulsu','rjmp','ijmp',
         'eijmp','jmp','rcall','icall','eicall','call','ret','reti','cpse',
         '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','cli','brak','nop','sleep','wdr');
+        'sec','seh','sei','sen','ser','ses','set','sev','sez',
+        'clc','clh','cli','cln','clr','cls','clt','clv','clz',
+        'bst','bld','break','nop','sleep','wdr');
 
     function gas_regnum_search(const s:string):Tregister;
     function gas_regname(r:Tregister):string;

compiler/avr/navradd.pas

@@ -198,7 +198,7 @@ interface
             swapleftright;
             { if we have to swap back and left is a constant, force it to a register because we cannot generate
               the needed code using a constant }
-            if left.location.loc=LOC_CONSTANT then
+            if (left.location.loc=LOC_CONSTANT) and (left.location.value<>0) then
               hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
           end;
 
@@ -206,12 +206,16 @@ interface
           begin
             { decrease register pressure on registers >= r16 }
             if (right.location.value and $ff)=0 then
-              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,left.location.register,NR_R1))
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,left.location.register,NR_R1))
             else
               current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CPI,left.location.register,right.location.value and $ff))
           end
+        { on the left side, we allow only a constant if it is 0 }
+        else if (left.location.loc=LOC_CONSTANT) and (left.location.value=0) then
+          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,NR_R1,right.location.register))
         else
           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,left.location.register,right.location.register));
+
         tmpreg1:=left.location.register;
         tmpreg2:=right.location.register;
 
@@ -219,26 +223,35 @@ interface
           begin
             if i=5 then
               begin
-                tmpreg1:=left.location.registerhi;
+                if left.location.loc<>LOC_CONSTANT then
+                  tmpreg1:=left.location.registerhi;
                 if right.location.loc<>LOC_CONSTANT then
                   tmpreg2:=right.location.registerhi;
               end
             else
               begin
-                tmpreg1:=GetNextReg(tmpreg1);
+                if left.location.loc<>LOC_CONSTANT then
+                  tmpreg1:=GetNextReg(tmpreg1);
                 if right.location.loc<>LOC_CONSTANT then
                   tmpreg2:=GetNextReg(tmpreg2);
               end;
             if right.location.loc=LOC_CONSTANT then
               begin
-                tmpreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_8);
-                cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_8,(right.location.value64 shr (i*8)) and $ff,tmpreg2);
-                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg1,tmpreg2));
+                { just use R1? }
+                if ((right.location.value64 shr ((i-1)*8)) and $ff)=0 then
+                  current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg1,NR_R1))
+                else
+                  begin
+                    tmpreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_8);
+                    cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_8,(right.location.value64 shr ((i-1)*8)) and $ff,tmpreg2);
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg1,tmpreg2));
+                  end;
               end
+            { above it is checked, if left=0, then a constant is allowed }
+            else if (left.location.loc=LOC_CONSTANT) and (left.location.value=0) then
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,NR_R1,tmpreg2))
             else
-              begin
-                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg1,tmpreg2));
-              end;
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg1,tmpreg2));
           end;
 
         location_reset(location,LOC_FLAGS,OS_NO);

compiler/avr/navrmat.pas

@@ -29,20 +29,20 @@ interface
       node,nmat,ncgmat;
 
     type
-      tavrmoddivnode = class(tmoddivnode)
-        function first_moddivint: tnode;override;
-        procedure pass_generate_code;override;
-      end;
-
       tavrnotnode = class(tcgnotnode)
         procedure second_boolean;override;
       end;
 
+      tavrshlshrnode = class(tcgshlshrnode)
+        procedure second_integer;override;
+      end;
+
 implementation
 
     uses
       globtype,systems,
       cutils,verbose,globals,constexp,
+      symtype,symdef,
       aasmbase,aasmcpu,aasmtai,aasmdata,
       defutil,
       cgbase,cgobj,hlcgobj,cgutils,
@@ -51,159 +51,6 @@ implementation
       cpubase,
       ncgutil,cgcpu;
 
-{*****************************************************************************
-                             TAVRMODDIVNODE
-*****************************************************************************}
-
-    function tavrmoddivnode.first_moddivint: tnode;
-      var
-        power  : longint;
-      begin
-        if (right.nodetype=ordconstn) and
-          (nodetype=divn) and
-          (ispowerof2(tordconstnode(right).value,power) or
-           (tordconstnode(right).value=1) or
-           (tordconstnode(right).value=int64(-1))
-          ) and
-          not(is_64bitint(resultdef)) then
-          result:=nil
-        else
-          result:=inherited first_moddivint;
-      end;
-
-
-    procedure tavrmoddivnode.pass_generate_code;
-      var
-        power  : longint;
-        numerator,
-        helper1,
-        helper2,
-        resultreg  : tregister;
-        size       : Tcgsize;
-       procedure genOrdConstNodeDiv;
-         begin
-{
-           if tordconstnode(right).value=0 then
-             internalerror(2005061701)
-           else if tordconstnode(right).value=1 then
-             cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, numerator, resultreg)
-           else if (tordconstnode(right).value = int64(-1)) then
-             begin
-               // note: only in the signed case possible..., may overflow
-               current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MVN,
-                 resultreg,numerator),toppostfix(ord(cs_check_overflow in current_settings.localswitches)*ord(PF_S))));
-             end
-           else if ispowerof2(tordconstnode(right).value,power) then
-             begin
-               if (is_signed(right.resultdef)) then
-                 begin
-                    helper1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                    helper2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                    shifterop_reset(so);
-                    so.shiftmode:=SM_ASR;
-                    so.shiftimm:=31;
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,helper1,numerator,so));
-                    shifterop_reset(so);
-                    so.shiftmode:=SM_LSR;
-                    so.shiftimm:=32-power;
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,helper2,numerator,helper1,so));
-                    shifterop_reset(so);
-                    so.shiftmode:=SM_ASR;
-                    so.shiftimm:=power;
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,resultreg,helper2,so));
-                  end
-               else
-                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,numerator,resultreg)
-             end;
-}
-         end;
-
-
-       procedure genOrdConstNodeMod;
-         var
-             modreg, maskreg, tempreg : tregister;
-         begin
-{
-             if (tordconstnode(right).value = 0) then begin
-                 internalerror(2005061702);
-             end
-             else if (abs(tordconstnode(right).value.svalue) = 1) then
-             begin
-                // x mod +/-1 is always zero
-                cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 0, resultreg);
-             end
-             else if (ispowerof2(tordconstnode(right).value, power)) then
-             begin
-                 if (is_signed(right.resultdef)) then begin
-
-                     tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
-                     maskreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
-                     modreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT);
-
-                     cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, abs(tordconstnode(right).value.svalue)-1, modreg);
-                     cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, 31, numerator, maskreg);
-                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, numerator, modreg, tempreg);
-
-                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg));
-                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0));
-                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg));
-                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, modreg, maskreg, maskreg);
-                     cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_INT, maskreg, tempreg, resultreg);
-                 end else begin
-                     cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, tordconstnode(right).value.svalue-1, numerator, resultreg);
-                 end;
-             end else begin
-                 genOrdConstNodeDiv();
-                 cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg, resultreg);
-                 cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg);
-             end;
-}
-         end;
-
-      begin
-        secondpass(left);
-        secondpass(right);
-        location_copy(location,left.location);
-
-{$ifdef dummy}
-        { put numerator in register }
-        size:=def_cgsize(left.resultdef);
-        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,
-          left.resultdef,left.resultdef,true);
-        location_copy(location,left.location);
-        numerator:=location.register;
-        resultreg:=location.register;
-        if location.loc=LOC_CREGISTER then
-          begin
-            location.loc := LOC_REGISTER;
-            location.register := cg.getintregister(current_asmdata.CurrAsmList,size);
-            resultreg:=location.register;
-          end
-        else if (nodetype=modn) or (right.nodetype=ordconstn) then
-          begin
-            // for a modulus op, and for const nodes we need the result register
-            // to be an extra register
-            resultreg:=cg.getintregister(current_asmdata.CurrAsmList,size);
-          end;
-
-        if right.nodetype=ordconstn then
-          begin
-            if nodetype=divn then
-              genOrdConstNodeDiv
-            else
-              genOrdConstNodeMod;
-          end;
-
-        location.register:=resultreg;
-
-        { unsigned division/module can only overflow in case of division by zero }
-        { (but checking this overflow flag is more convoluted than performing a  }
-        {  simple comparison with 0)                                             }
-        if is_signed(right.resultdef) then
-          cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef);
-{$endif dummy}
-      end;
-
 {*****************************************************************************
                                TAVRNOTNODE
 *****************************************************************************}
@@ -263,7 +110,65 @@ implementation
           end;
       end;
 
+
+    procedure tavrshlshrnode.second_integer;
+      var
+         op : topcg;
+         opdef: tdef;
+         hcountreg : tregister;
+         opsize : tcgsize;
+         shiftval : longint;
+      begin
+        { determine operator }
+        case nodetype of
+          shln: op:=OP_SHL;
+          shrn: op:=OP_SHR;
+          else
+            internalerror(2013120102);
+        end;
+        opsize:=left.location.size;
+        opdef:=left.resultdef;
+
+        if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or
+          { location_force_reg can be also used to change the size of a register }
+          (left.location.size<>opsize) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,opdef,true);
+        location_reset(location,LOC_REGISTER,opsize);
+        location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+
+        { shifting by a constant directly coded: }
+        if (right.nodetype=ordconstn) then
+          begin
+             { shl/shr must "wrap around", so use ... and 31 }
+             { In TP, "byte/word shl 16 = 0", so no "and 15" in case of
+               a 16 bit ALU }
+             if tcgsize2size[opsize]<=4 then
+               shiftval:=tordconstnode(right).value.uvalue and 31
+             else
+               shiftval:=tordconstnode(right).value.uvalue and 63;
+             hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,opdef,
+               shiftval,left.location.register,location.register);
+          end
+        else
+          begin
+             { load right operators in a register - this
+               is done since most target cpu which will use this
+               node do not support a shift count in a mem. location (cec)
+             }
+             hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,sinttype,true);
+             hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,opdef,right.location.register,left.location.register,location.register);
+          end;
+        { shl/shr nodes return the same type as left, which can be different
+          from opdef }
+        if opdef<>resultdef then
+          begin
+            hcountreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+            hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,opdef,resultdef,location.register,hcountreg);
+            location.register:=hcountreg;
+          end;
+      end;
+
 begin
-  cmoddivnode:=tavrmoddivnode;
   cnotnode:=tavrnotnode;
+  cshlshrnode:=tavrshlshrnode;
 end.

compiler/avr/raavrgas.pas

@@ -344,19 +344,42 @@ Unit raavrgas;
           AS_MINUS,
           AS_PLUS:
             Begin
-              { Constant memory offset }
-              { This must absolutely be followed by (  }
-              oper.InitRef;
-              oper.opr.ref.offset:=BuildConstExpression(True,False);
+              if (actasmtoken=AS_MINUS) and
+                 (actopcode in [A_LD,A_ST]) then
+                begin
+                  { Special handling of predecrement addressing }
+                  oper.InitRef;
+                  oper.opr.ref.addressmode:=AM_PREDRECEMENT;
+
+                  consume(AS_MINUS);
 
-              { absolute memory addresss? }
-              if actopcode in [A_LDS,A_STS] then
-                BuildReference(oper)
+                  if actasmtoken=AS_REGISTER then
+                    begin
+                      oper.opr.ref.base:=actasmregister;
+                      consume(AS_REGISTER);
+                    end
+                  else
+                    begin
+                      Message(asmr_e_invalid_reference_syntax);
+                      RecoverConsume(false);
+                    end;
+                end
               else
                 begin
-                  ofs:=oper.opr.ref.offset;
-                  BuildConstantOperand(oper);
-                  inc(oper.opr.val,ofs);
+                  { Constant memory offset }
+                  { This must absolutely be followed by (  }
+                  oper.InitRef;
+                  oper.opr.ref.offset:=BuildConstExpression(True,False);
+
+                  { absolute memory addresss? }
+                  if actopcode in [A_LDS,A_STS] then
+                    BuildReference(oper)
+                  else
+                    begin
+                      ofs:=oper.opr.ref.offset;
+                      BuildConstantOperand(oper);
+                      inc(oper.opr.val,ofs);
+                    end;
                 end;
             end;
 

compiler/avr/rgcpu.pas

@@ -137,7 +137,7 @@ unit rgcpu;
           end
         else
           inherited;
-    end;
+      end;
 
 
     procedure trgintcpu.add_cpu_interferences(p : tai);

compiler/avr/symcpu.pas

@@ -115,6 +115,10 @@ type
   end;
   tcpuunitsymclass = class of tcpuunitsym;
 
+  tcpuprogramparasym = class(tprogramparasym)
+  end;
+  tcpuprogramparasymclass = class(tprogramparasym);
+
   tcpunamespacesym = class(tnamespacesym)
   end;
   tcpunamespacesymclass = class of tcpunamespacesym;
@@ -195,6 +199,7 @@ begin
   { used tsym classes }
   clabelsym:=tcpulabelsym;
   cunitsym:=tcpuunitsym;
+  cprogramparasym:=tcpuprogramparasym;
   cnamespacesym:=tcpunamespacesym;
   cprocsym:=tcpuprocsym;
   ctypesym:=tcputypesym;

compiler/bsdcompile

@@ -1,3 +0,0 @@
-#!/bin/sh
-ppc386 -OG3p3 -Ch8000000 -dI386 -dGDB -dBROWSERLOG -Sg pp.pas -a -s -g %1 %2 %3 %4 %5 %6 %7 %8 %9
-

compiler/cgbase.pas

@@ -95,7 +95,9 @@ interface
          {$ENDIF}
          {$IFDEF AVR}
          ,addr_lo8
+         ,addr_lo8_gs
          ,addr_hi8
+         ,addr_hi8_gs
          {$ENDIF}
          {$IFDEF i8086}
          ,addr_dgroup      // the data segment group

compiler/cgobj.pas

@@ -348,7 +348,6 @@ unit cgobj;
           procedure optimize_op_const(size: TCGSize; var op: topcg; var a : tcgint);virtual;
 
 
-          procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
              to destination.
 
@@ -1761,6 +1760,20 @@ implementation
     procedure Tcg.a_op_const_reg_reg(list:TAsmList;op:Topcg;size:Tcgsize;
                                      a:tcgint;src,dst:Tregister);
     begin
+      optimize_op_const(size, op, a);
+      case op of
+        OP_NONE:
+          begin
+            if src <> dst then
+              a_load_reg_reg(list, size, size, src, dst);
+            exit;
+          end;
+        OP_MOVE:
+          begin
+            a_load_const_reg(list, size, a, dst);
+            exit;
+          end;
+      end;
       a_load_reg_reg(list,size,size,src,dst);
       a_op_const_reg(list,op,size,a,dst);
     end;
@@ -2171,52 +2184,6 @@ implementation
 {$endif cpuflags}
 
 
-    procedure tcg.g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
-      var
-        hrefvmt : treference;
-        cgpara1,cgpara2 : TCGPara;
-        pd: tprocdef;
-      begin
-        cgpara1.init;
-        cgpara2.init;
-        if (cs_check_object in current_settings.localswitches) then
-         begin
-           pd:=search_system_proc('fpc_check_object_ext');
-           paramanager.getintparaloc(list,pd,1,cgpara1);
-           paramanager.getintparaloc(list,pd,2,cgpara2);
-           reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname,AT_DATA),0,sizeof(pint));
-           if pd.is_pushleftright then
-             begin
-               a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
-               a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2);
-             end
-           else
-             begin
-               a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2);
-               a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
-             end;
-           paramanager.freecgpara(list,cgpara1);
-           paramanager.freecgpara(list,cgpara2);
-           allocallcpuregisters(list);
-           a_call_name(list,'fpc_check_object_ext',false);
-           deallocallcpuregisters(list);
-         end
-        else
-         if (cs_check_range in current_settings.localswitches) then
-          begin
-            pd:=search_system_proc('fpc_check_object');
-            paramanager.getintparaloc(list,pd,1,cgpara1);
-            a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
-            paramanager.freecgpara(list,cgpara1);
-            allocallcpuregisters(list);
-            a_call_name(list,'fpc_check_object',false);
-            deallocallcpuregisters(list);
-          end;
-        cgpara1.done;
-        cgpara2.done;
-      end;
-
-
 {*****************************************************************************
                             Entry/Exit Code Functions
 *****************************************************************************}

compiler/dbgdwarf.pas

@@ -3347,6 +3347,12 @@ implementation
       begin
         { this function will always terminate the lineinfo block }
         generated_lineinfo := true;
+        { if this unit only contains code without debug info (implicit init
+          or final etc), make sure the file table contains at least one entry
+          (the main source of the unit), because normally this table gets
+          populated via calls to get_file_index and that won't happen in this
+          case }
+        get_file_index(current_module.sourcefiles.get_file(1));
         FillChar(lastfileinfo,sizeof(lastfileinfo),0);
         currfuncname:=nil;
         currsectype:=sec_code;

compiler/defcmp.pas

@@ -247,12 +247,12 @@ implementation
 
          if cdo_strict_undefined_check in cdoptions then
            begin
-             { undefined defs are considered equal if both are undefined defs }
+             { two different undefined defs are not considered equal }
              if (def_from.typ=undefineddef) and
                 (def_to.typ=undefineddef) then
               begin
-                doconv:=tc_equal;
-                compare_defs_ext:=te_exact;
+                doconv:=tc_not_possible;
+                compare_defs_ext:=te_incompatible;
                 exit;
               end;
 
@@ -2010,15 +2010,18 @@ implementation
                 if (vo_is_hidden_para in currpara1.varoptions)<>(vo_is_hidden_para in currpara2.varoptions) then
                   exit;
                 eq:=te_exact;
-                if not(vo_is_self in currpara1.varoptions) and
-                   not(vo_is_self in currpara2.varoptions) then
+                if (([vo_is_self,vo_is_vmt]*currpara1.varoptions)=[]) and
+                   (([vo_is_self,vo_is_vmt]*currpara2.varoptions)=[]) then
                  begin
                    if not(cpo_ignorevarspez in cpoptions) and
                       (currpara1.varspez<>currpara2.varspez) then
                     exit;
                    eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn,
                                         convtype,hpd,cdoptions);
-                 end;
+                 end
+                else if ([vo_is_self,vo_is_vmt]*currpara1.varoptions)<>
+                         ([vo_is_self,vo_is_vmt]*currpara2.varoptions) then
+                   eq:=te_incompatible;
               end
              else
               begin

compiler/defutil.pas

@@ -337,7 +337,7 @@ interface
 implementation
 
     uses
-       verbose,cutils,symcpu;
+       verbose,cutils;
 
     { returns true, if def uses FPU }
     function is_fpu(def : tdef) : boolean;
@@ -1208,21 +1208,10 @@ implementation
           classrefdef,
           pointerdef:
             begin
-{$ifdef x86}
-              if (def.typ=pointerdef) and
-                 (tcpupointerdef(def).x86pointertyp in [x86pt_far,x86pt_huge]) then
-                begin
-                  {$if defined(i8086)}
-                    result := OS_32;
-                  {$elseif defined(i386)}
-                    internalerror(2013052201);  { there's no OS_48 }
-                  {$elseif defined(x86_64)}
-                    internalerror(2013052202);  { there's no OS_80 }
-                  {$endif}
-                end
-              else
-{$endif x86}
-                result := int_cgsize(def.size);
+              result:=int_cgsize(def.size);
+              { can happen for far/huge pointers on non-i8086 }
+              if result=OS_NO then
+                internalerror(2013052201);
             end;
           formaldef:
             result := int_cgsize(voidpointertype.size);

compiler/fmodule.pas

@@ -44,7 +44,7 @@ interface
     uses
        cutils,cclasses,cfileutl,
        globtype,finput,ogbase,
-       symbase,symconst,symsym,symcpu,
+       symbase,symconst,symsym,
        wpobase,
        aasmbase,aasmtai,aasmdata;
 
@@ -142,8 +142,9 @@ interface
         checkforwarddefs,
         deflist,
         symlist       : TFPObjectList;
-        ptrdefs       : tPtrDefHashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
+        ptrdefs       : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
         arraydefs     : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
+        procaddrdefs  : THashSet; { list of procvardefs created when getting the address of a procdef (not saved/restored) }
 {$ifdef llvm}
         llvmdefs      : THashSet; { defs added for llvm-specific reasons (not saved/restored) }
 {$endif llvm}
@@ -570,8 +571,9 @@ implementation
         derefdataintflen:=0;
         deflist:=TFPObjectList.Create(false);
         symlist:=TFPObjectList.Create(false);
-        ptrdefs:=cPtrDefHashSet.Create;
+        ptrdefs:=THashSet.Create(64,true,false);
         arraydefs:=THashSet.Create(64,true,false);
+        procaddrdefs:=THashSet.Create(64,true,false);
 {$ifdef llvm}
         llvmdefs:=THashSet.Create(64,true,false);
 {$endif llvm}
@@ -689,6 +691,7 @@ implementation
         symlist.free;
         ptrdefs.free;
         arraydefs.free;
+        procaddrdefs.free;
 {$ifdef llvm}
         llvmdefs.free;
 {$endif llvm}
@@ -753,9 +756,11 @@ implementation
         symlist.free;
         symlist:=TFPObjectList.Create(false);
         ptrdefs.free;
-        ptrdefs:=cPtrDefHashSet.Create;
+        ptrdefs:=THashSet.Create(64,true,false);
         arraydefs.free;
         arraydefs:=THashSet.Create(64,true,false);
+        procaddrdefs.free;
+        procaddrdefs:=THashSet.Create(64,true,false);
 {$ifdef llvm}
         llvmdefs.free;
         llvmdefs:=THashSet.Create(64,true,false);

compiler/fpcdefs.inc

@@ -56,7 +56,7 @@
   {$define SUPPORT_SAFECALL}
   {$define cpuneedsmulhelper}
   { TODO: add another define in order to disable the div helper for 16-bit divs? }
-  {$define cpuneedsdiv32helper}
+  {$define cpuneedsdivhelper}
   {$define VOLATILE_ES}
   {$define SUPPORT_GET_FRAME}
 {$endif i8086}
@@ -145,7 +145,7 @@
   {$define cpu32bitalu}
   {$define cpuflags}
   {$define cpufpemu}
-  {$define cpuneedsdiv32helper}
+  {$define cpuneedsdivhelper}
   {$define cpurox}
   {$define cputargethasfixedstack}
   {$define cpurefshaveindexreg}
@@ -178,7 +178,7 @@
   {$define cpufpemu}
   {$define cpurefshaveindexreg}
   {$define cpucapabilities}
-  {$define cpuneedsdiv32helper}
+  {$define cpuneedsdivhelper}
 {$endif m68k}
 
 {$ifdef avr}
@@ -188,7 +188,7 @@
   {$define cpuflags}
   {$define cpunofpu}
   {$define cpunodefaultint}
-  {$define cpuneedsdiv32helper}
+  {$define cpuneedsdivhelper}
   {$define cpuneedsmulhelper}
   {$define cpurefshaveindexreg}
   {$define cpucapabilities}
@@ -269,4 +269,5 @@
   {$undef cpu32bitalu}
   {$define cpu64bitalu}
   {$define cpuhighleveltarget}
+  {$define symansistr}
 {$endif}

compiler/generic/symcpu.pas

@@ -115,6 +115,10 @@ type
   end;
   tcpuunitsymclass = class of tcpuunitsym;
 
+  tcpuprogramparasym = class(tprogramparasym)
+  end;
+  tcpuprogramparasymclass = class(tprogramparasym);
+
   tcpunamespacesym = class(tnamespacesym)
   end;
   tcpunamespacesymclass = class of tcpunamespacesym;
@@ -195,6 +199,7 @@ begin
   { used tsym classes }
   clabelsym:=tcpulabelsym;
   cunitsym:=tcpuunitsym;
+  cprogramparasym:=tcpuprogramparasym;
   cnamespacesym:=tcpunamespacesym;
   cprocsym:=tcpuprocsym;
   ctypesym:=tcputypesym;

compiler/globals.pas

@@ -398,7 +398,7 @@ interface
         optimizerswitches : [];
         genwpoptimizerswitches : [];
         dowpoptimizerswitches : [];
-        debugswitches : [];
+        debugswitches : [ds_dwarf_sets];
 
         setalloc : 0;
         packenum : 4;

compiler/globtype.pas

@@ -269,7 +269,7 @@ interface
        toptimizerswitch = (cs_opt_none,
          cs_opt_level1,cs_opt_level2,cs_opt_level3,cs_opt_level4,
          cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe,
-         cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse,
+         cs_opt_peephole,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse,
          cs_opt_nodedfa,cs_opt_loopstrength,cs_opt_scheduler,cs_opt_autoinline,cs_useebp,cs_userbp,
          cs_opt_reorder_fields,cs_opt_fastmath,
          { Allow removing expressions whose result is not used, even when this
@@ -315,7 +315,7 @@ interface
        OptimizerSwitchStr : array[toptimizerswitch] of string[17] = ('',
          'LEVEL1','LEVEL2','LEVEL3','LEVEL4',
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
-         'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE',
+         'PEEPHOLE','LOOPUNROLL','TAILREC','CSE',
          'DFA','STRENGTH','SCHEDULE','AUTOINLINE','USEEBP','USERBP',
          'ORDERFIELDS','FASTMATH','DEADVALUES','REMOVEEMPTYPROCS',
          'CONSTPROP',

compiler/hlcgobj.pas

@@ -563,6 +563,7 @@ unit hlcgobj;
 
           procedure gen_proc_symbol(list:TAsmList);virtual;
           procedure gen_proc_symbol_end(list:TAsmList);virtual;
+          procedure handle_external_proc(list: TAsmList; pd: tprocdef; const importname: TSymStr); virtual;
 
           procedure gen_initialize_code(list:TAsmList);virtual;
           procedure gen_finalize_code(list:TAsmList);virtual;
@@ -1596,8 +1597,12 @@ implementation
     end;
 
   procedure thlcgobj.a_bit_test_const_ref_reg(list: TAsmList; fromsize, destsize: tdef; bitnumber: aint; const ref: treference; destreg: tregister);
+    var
+      href: treference;
     begin
-      a_load_subsetref_reg(list,u8inttype,destsize,get_bit_const_ref_sref(bitnumber,fromsize,ref),destreg);
+      href:=ref;
+      g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(u8inttype),href);
+      a_load_subsetref_reg(list,u8inttype,destsize,get_bit_const_ref_sref(bitnumber,fromsize,href),destreg);
     end;
 
   procedure thlcgobj.a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tdef; bitnumber: aint; setreg, destreg: tregister);
@@ -1621,8 +1626,12 @@ implementation
     end;
 
   procedure thlcgobj.a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, refsize, destsize: tdef; bitnumber: tregister; const ref: treference; destreg: tregister);
+    var
+      href: treference;
     begin
-      a_load_subsetref_reg(list,u8inttype,destsize,get_bit_reg_ref_sref(list,bitnumbersize,refsize,bitnumber,ref),destreg);
+      href:=ref;
+      g_ptrtypecast_ref(list,cpointerdef.getreusable(refsize),cpointerdef.getreusable(u8inttype),href);
+      a_load_subsetref_reg(list,u8inttype,destsize,get_bit_reg_ref_sref(list,bitnumbersize,refsize,bitnumber,href),destreg);
     end;
 
   procedure thlcgobj.a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, locsize, destsize: tdef; bitnumber: tregister; const loc: tlocation; destreg: tregister);
@@ -1705,12 +1714,17 @@ implementation
     end;
 
   procedure thlcgobj.a_bit_set_const_ref(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; const ref: treference);
+    var
+      href: treference;
     begin
-      a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_const_ref_sref(bitnumber,destsize,ref));
+      href:=ref;
+      g_ptrtypecast_ref(list,cpointerdef.getreusable(destsize),cpointerdef.getreusable(u8inttype),href);
+      a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_const_ref_sref(bitnumber,destsize,href));
     end;
 
   procedure thlcgobj.a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; destreg: tregister);
     begin
+      g_ptrtypecast_reg(list,cpointerdef.getreusable(destsize),cpointerdef.getreusable(u8inttype),destreg);
       a_load_const_subsetreg(list,u8inttype,ord(doset),get_bit_const_reg_sreg(destsize,bitnumber,destreg));
     end;
 
@@ -1730,7 +1744,11 @@ implementation
     end;
 
   procedure thlcgobj.a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference);
+    var
+      href: treference;
     begin
+      href:=ref;
+      g_ptrtypecast_ref(list,cpointerdef.getreusable(tosize),cpointerdef.getreusable(u8inttype),href);
       a_load_const_subsetref(list,u8inttype,ord(doset),get_bit_reg_ref_sref(list,fromsize,tosize,bitnumber,ref));
     end;
 
@@ -2401,7 +2419,7 @@ implementation
       if result.ref.index<>NR_NO then
         begin
           { don't just add to ref.index, as it may be scaled }
-          refptrdef:=getpointerdef(refsize);
+          refptrdef:=cpointerdef.getreusable(refsize);
           newbase:=getaddressregister(list,refptrdef);
           a_loadaddr_ref_reg(list,refsize,refptrdef,ref,newbase);
           reference_reset_base(result.ref,refptrdef,newbase,0,result.ref.alignment);
@@ -2528,7 +2546,7 @@ implementation
               internalerror(2014080603);
             { convert the reference from a floating point location to an
               integer location, and load that }
-            intptrdef:=getpointerdef(cgpara.location^.def);
+            intptrdef:=cpointerdef.getreusable(cgpara.location^.def);
             hreg:=getaddressregister(list,intptrdef);
             a_loadaddr_ref_reg(list,fromsize,intptrdef,ref,hreg);
             reference_reset_base(href,intptrdef,hreg,0,ref.alignment);
@@ -3659,7 +3677,7 @@ implementation
       a_op_const_reg_reg(list,OP_ADD,sinttype,1,lenreg,sizereg);
       a_op_const_reg(list,OP_IMUL,sinttype,arrdef.elesize,sizereg);
       { load source }
-      ptrarrdef:=getpointerdef(arrdef);
+      ptrarrdef:=cpointerdef.getreusable(arrdef);
       sourcereg:=getaddressregister(list,ptrarrdef);
       a_loadaddr_ref_reg(list,arrdef,ptrarrdef,ref,sourcereg);
 
@@ -3722,7 +3740,7 @@ implementation
       cgpara1.init;
       paramanager.getintparaloc(list,pd,1,cgpara1);
       { load source }
-      a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1);
+      a_load_loc_cgpara(list,cpointerdef.getreusable(arrdef),l,cgpara1);
       paramanager.freecgpara(list,cgpara1);
       g_call_system_proc(list,pd,[@cgpara1],nil);
       cgpara1.done;
@@ -3988,6 +4006,8 @@ implementation
     end;
 
     procedure thlcgobj.location_get_data_ref(list: TAsmList; def: tdef; const l: tlocation; var ref: treference; loadref: boolean; alignment: longint);
+      var
+        pdef: tdef;
       begin
         case l.loc of
           LOC_REGISTER,
@@ -3995,16 +4015,17 @@ implementation
             begin
               if not loadref then
                 internalerror(200410231);
-              reference_reset_base(ref,voidpointertype,l.register,0,alignment);
+              reference_reset_base(ref,cpointerdef.getreusable(def),l.register,0,alignment);
             end;
           LOC_REFERENCE,
           LOC_CREFERENCE :
             begin
               if loadref then
                 begin
-                  reference_reset_base(ref,voidpointertype,getaddressregister(list,voidpointertype),0,alignment);
+                  pdef:=cpointerdef.getreusable(def);
+                  reference_reset_base(ref,pdef,getaddressregister(list,voidpointertype),0,alignment);
                   { it's a pointer to def }
-                  a_load_ref_reg(list,voidpointertype,voidpointertype,l.reference,ref.base);
+                  a_load_ref_reg(list,pdef,pdef,l.reference,ref.base);
                 end
               else
                 ref:=l.reference;
@@ -4357,6 +4378,40 @@ implementation
         end;
     end;
 
+
+  procedure thlcgobj.handle_external_proc(list: TAsmList; pd: tprocdef; const importname: TSymStr);
+    begin
+      { External declared in implementation, and there was already a
+        forward (or interface) declaration then we need to generate
+        a stub that calls the external routine }
+      if (not pd.forwarddef) and
+         (pd.hasforward) then
+        begin
+          if importname<>'' then
+            begin
+             { add the procedure to the al_procedures }
+             maybe_new_object_file(list);
+             new_section(list,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
+             if (po_global in pd.procoptions) then
+               list.concat(Tai_symbol.createname_global(pd.mangledname,AT_FUNCTION,0))
+             else
+               list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
+
+             g_external_wrapper(list,pd,importname);
+            end;
+          { remove the external stuff, so that the interface crc
+            doesn't change. This makes the function calls less
+            efficient, but it means that the interface doesn't
+            change if the function is ever redirected to another
+            function or implemented in the unit. }
+          pd.procoptions:=pd.procoptions-[po_external,po_has_importname,po_has_importdll];
+          stringdispose(pd.import_name);
+          stringdispose(pd.import_dll);
+          pd.import_nr:=0;
+        end;
+    end;
+
+
   procedure thlcgobj.gen_initialize_code(list: TAsmList);
     begin
       { initialize local data like ansistrings }
@@ -4843,7 +4898,9 @@ implementation
       for i:=0 to current_procinfo.procdef.paras.count-1 do
         begin
           currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
-          gen_load_cgpara_loc(list,currpara.vardef,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
+          { don't use currpara.vardef, as this will be wrong in case of
+            call-by-reference parameters (it won't contain the pointer) }
+          gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
         end;
 
       { generate copies of call by value parameters, must be done before
@@ -5123,7 +5180,7 @@ implementation
           retdef:=ressym.vardef;
           { and TP-style constructors return a pointer to self }
           if is_object(ressym.vardef) then
-            retdef:=getpointerdef(retdef);
+            retdef:=cpointerdef.getreusable(retdef);
         end
       else
         begin

compiler/htypechk.pas

@@ -1500,17 +1500,25 @@ implementation
                         is_open_array(fromdef) or
                         is_open_array(todef) or
                         ((fromdef.typ=pointerdef) and (todef.typ=arraydef)) or
-                        (def_is_related(fromdef,todef))) and
-                    (fromdef.size<>todef.size) then
+                        (def_is_related(fromdef,todef))) then
                   begin
-                    { in TP it is allowed to typecast to smaller types. But the variable can't
-                      be in a register }
-                    if (m_tp7 in current_settings.modeswitches) or
-                       (todef.size<fromdef.size) then
-                      make_not_regable(hp,[ra_addr_regable])
+                    if (fromdef.size<>todef.size) then
+                      begin
+                        { in TP it is allowed to typecast to smaller types. But the variable can't
+                          be in a register }
+                        if (m_tp7 in current_settings.modeswitches) or
+                           (todef.size<fromdef.size) then
+                          make_not_regable(hp,[ra_addr_regable])
+                        else
+                          if report_errors then
+                            CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));
+                      end
+{$ifdef llvm}
+                    { we can never typecast a non-memory value on the assignment
+                      side in llvm }
                     else
-                      if report_errors then
-                        CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));
+                      make_not_regable(hp,[ra_addr_regable])
+{$endif llvm}
                   end;
 
                  { don't allow assignments to typeconvs that need special code }

compiler/i386/aopt386.pas

@@ -37,7 +37,7 @@ Implementation
 Uses
   globtype,
   globals,
-  DAOpt386,POpt386,CSOpt386;
+  DAOpt386,POpt386;
 
 
 Procedure Optimize(AsmL: TAsmList);
@@ -74,13 +74,6 @@ Begin
                if pass = 0 then
                  PeepHoleOptPass1(AsmL, BlockStart, BlockEnd);
            end;
-        { Data flow analyzer }
-         If (cs_opt_asmcse in current_settings.optimizerswitches) Then
-           begin
-             if dfa.pass_generate_code then
-              { common subexpression elimination }
-               changed := CSE(asmL, blockStart, blockEnd, pass) or changed;
-           end;
         { More peephole optimizations }
          if (cs_opt_peephole in current_settings.optimizerswitches) then
            begin

compiler/i386/cpuinfo.pas

@@ -139,7 +139,7 @@ Const
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
                                  [cs_opt_peephole,cs_opt_regvar,cs_opt_stackframe,
-                                  cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain,
+                                  cs_opt_loopunroll,cs_opt_uncertain,
                                   cs_opt_tailrecursion,cs_opt_nodecse,cs_useebp,
 				  cs_opt_reorder_fields,cs_opt_fastmath];
 

compiler/i386/cpupara.pas

@@ -446,7 +446,7 @@ unit cpupara;
               begin
                 paralen:=sizeof(aint);
                 paracgsize:=OS_ADDR;
-                paradef:=getpointerdef(paradef);
+                paradef:=cpointerdef.getreusable(paradef);
               end
             else
               begin
@@ -598,7 +598,7 @@ unit cpupara;
                       begin
                         paralen:=sizeof(aint);
                         paracgsize:=OS_ADDR;
-                        paradef:=getpointerdef(paradef);
+                        paradef:=cpointerdef.getreusable(paradef);
                       end
                     else
                       begin
@@ -625,7 +625,8 @@ unit cpupara;
                     if (parareg<=high(parasupregs)) and
                        (paralen<=sizeof(aint)) and
                        (not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
-                        pushaddr) and
+                        pushaddr or
+                        is_dynamic_array(hp.vardef)) and
                        (not(vo_is_parentfp in hp.varoptions) or
                         not(po_delphi_nested_cc in p.procoptions)) then
                       begin

compiler/i386/csopt386.pas

@@ -1,2265 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
-      development team
-
-    This unit contains the common subexpression elimination procedure.
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit CSOpt386;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses aasmbase,aasmtai,aasmdata,aasmcpu, cpuinfo, cpubase, cgbase;
-
-function CSE(asml: TAsmList; first, last: tai; pass: longint): boolean;
-
-function doReplaceReg(hp: taicpu; newReg, orgReg: tsuperregister): boolean;
-function changeOp(var o: toper; newReg, orgReg: tsuperregister): boolean;
-function storeBack(start, current: tai; orgReg, newReg: tsuperregister): boolean;
-function NoHardCodedRegs(p: taicpu; orgReg, newReg: tsuperregister): boolean;
-function RegSizesOK(oldReg,newReg: tsuperregister; p: taicpu): boolean;
-
-implementation
-
-uses
-{$ifdef csdebug}
-  cutils,
-{$else}
-  {$ifdef replaceregdebug}cutils,{$endif}
-{$endif}
-  globtype, verbose, procinfo, globals, daopt386, rgobj, rropt386,cgutils;
-
-{
-function TaiInSequence(P: tai; Const Seq: TContent): Boolean;
-var P1: tai;
-    Counter: Byte;
-    TmpResult: Boolean;
-begin
-  TmpResult := False;
-  P1 := Seq.StartMod;
-  Counter := 1;
-  while not(TmpResult) and
-        (Counter <= Seq.NrofMods) do
-    begin
-      if (P = P1) then TmpResult := True;
-      inc(Counter);
-      p1 := tai(p1.Next);
-    end;
-  TaiInSequence := TmpResult;
-end;
-}
-
-function modifiesConflictingMemLocation(p1: tai; supreg: tsuperregister; c: tregContent;
-   var regsStillValid: tregset; onlymem: boolean; var invalsmemwrite: boolean): boolean;
-var
-  p: taicpu;
-  tmpRef: treference;
-  regCounter: tsuperregister;
-  opCount: longint;
-  dummy: boolean;
-begin
-  modifiesConflictingMemLocation := false;
-  invalsmemwrite := false;
-  if p1.typ <> ait_instruction then
-    exit;
-  p := taicpu(p1);
-  case p.opcode of
-    A_MOV,A_MOVSX,A_MOVZX:
-      if p.oper[1]^.typ = top_ref then
-        for regCounter := RS_EAX to RS_EDI do
-          begin
-            if (p.oper[0]^.typ<>top_reg) or
-               (getregtype(p.oper[0]^.reg) <> R_INTREGISTER) then
-               break;
-            if writeToMemDestroysContents(getsupreg(p.oper[0]^.reg),p.oper[1]^.ref^,
-                 regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then
-              begin
-                exclude(regsStillValid,regCounter);
-                modifiesConflictingMemLocation := not(supreg in regsStillValid);
-              end;
-            if (regcounter = supreg) then
-              invalsmemwrite := invalsmemwrite or dummy;
-          end
-      else
-{         if is_reg_var[getsupreg(p.oper[1]^.reg)] then }
-        if not onlymem  then
-          for regCounter := RS_EAX to RS_EDI do
-            begin
-              if writeDestroysContents(p.oper[1]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then
-                begin
-                  exclude(regsStillValid,regCounter);
-                  modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                end
-            end;
-    A_DIV, A_IDIV, A_MUL, A_IMUL:
-      begin
-        if not onlymem then
-          if (p.ops = 1) then
-            begin
-              for regCounter := RS_EAX to RS_EDI do
-                begin
-                  if writeToRegDestroysContents(RS_EDX,regCounter,c[regCounter]) then
-                    begin
-                      exclude(regsStillValid,RS_EDX);
-                      modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                    end;
-                  if writeToRegDestroysContents(RS_EAX,regCounter,c[regCounter]) then
-                    begin
-                      exclude(regsStillValid,RS_EAX);
-                      modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                    end;
-                end
-            end
-          else
-            { only possible for imul }
-            { last operand is always destination }
-            for regCounter := RS_EAX to RS_EDI do
-              begin
-                if writeDestroysContents(p.oper[p.ops-1]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then
-                  begin
-                    exclude(regsStillValid,regCounter);
-                    modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                  end
-              end
-      end;
-    else
-      for opCount := 1 to maxinschanges do
-        case InsProp[p.opcode].Ch[opCount] of
-          Ch_MOp1,CH_WOp1,CH_RWOp1:
-              if not(onlymem) or
-                 (p.oper[0]^.typ = top_ref) then
-{                or ((p.oper[0]^.typ = top_reg) and }
-{                 is_reg_var[getsupreg(p.oper[0]^.reg)]) then }
-                for regCounter := RS_EAX to RS_EDI do
-                  begin
-                    if writeDestroysContents(p.oper[0]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then
-                      begin
-                        exclude(regsStillValid,regCounter);
-                        modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                      end;
-                    if (regcounter = supreg) then
-                      invalsmemwrite := invalsmemwrite or dummy;
-                  end;
-          Ch_MOp2,CH_WOp2,CH_RWOp2:
-              if not(onlymem) or
-                 (p.oper[1]^.typ = top_ref) then
-{                or ((p.oper[1]^.typ = top_reg) and }
-{                 is_reg_var[getsupreg(p.oper[1]^.reg)]) then }
-                for regCounter := RS_EAX to RS_EDI do
-                  begin
-                    if writeDestroysContents(p.oper[1]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then
-                      begin
-                        exclude(regsStillValid,regCounter);
-                        modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                      end;
-                    if (regcounter = supreg) then
-                      invalsmemwrite := invalsmemwrite or dummy;
-                  end;
-          Ch_MOp3,CH_WOp3,CH_RWOp3:
-              if not(onlymem) or
-                 (p.oper[2]^.typ = top_ref) then
-{                or ((p.oper[2]^.typ = top_reg) and }
-{                 is_reg_var[getsupreg(p.oper[2]^.reg)]) then }
-                for regCounter := RS_EAX to RS_EDI do
-                  begin
-                    if writeDestroysContents(p.oper[2]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then
-                      begin
-                        exclude(regsStillValid,regCounter);
-                        modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                      end;
-                    if (regcounter = supreg) then
-                      invalsmemwrite := invalsmemwrite or dummy;
-                  end;
-          Ch_WMemEDI:
-            begin
-              fillchar(tmpref,sizeof(tmpref),0);
-              tmpRef.base := NR_EDI;
-              tmpRef.index := NR_EDI;
-              for regCounter := RS_EAX to RS_EDI do
-                begin
-                  if writeToMemDestroysContents(RS_INVALID,tmpRef,regCounter,OS_32,c[regCounter],dummy) then
-                    begin
-                      exclude(regsStillValid,regCounter);
-                      modifiesConflictingMemLocation := not(supreg in regsStillValid);
-                   end;
-                  if (regcounter = supreg) then
-                    invalsmemwrite := invalsmemwrite or dummy;
-                end;
-            end;
-        end;
-  end;
-end;
-
-
-function isSimpleMemLoc(const ref: treference): boolean;
-begin
-{  isSimpleMemLoc :=
-    (ref.index = RS_NO) and
-    not(ref.base in (rg.usableregsint+[RS_EDI]));}
-  isSimpleMemLoc :=
-    (ref.index = NR_NO) and
-    ((ref.base = NR_NO) or
-     not(getsupreg(ref.base) in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]));
-end;
-
-
-{checks whether the current instruction sequence (starting with p) and the
- one between StartMod and EndMod of Reg are the same. if so, the number of
- instructions that match is stored in Found and true is returned, otherwise
- Found holds the number of instructions between StartMod and EndMod and false
- is returned}
-function CheckSequence(p: tai; var prev: tai; supreg: tsuperregister; var Found: Longint;
-           var reginfo: toptreginfo; findPrevSeqs: boolean): Boolean;
-
-var
-  regsNotRead, regsStillValid : tregset;
-  checkingPrevSequences,
-  passedFlagsModifyingInstr   : boolean;
-
-  function getPrevSequence(p: tai; supreg: tsuperregister; currentPrev: tai; var newPrev: tai): tsuperregister;
-
-  const
-    current_reg: tsuperregister = RS_INVALID;
-
-    function stillValid(p: tai): boolean;
-      var
-        hp: tai;
-      begin
-        { only regvars are still used at jump instructions }
-        if (cs_opt_regvar in current_settings.optimizerswitches) and
-           (p.typ = ait_instruction) and
-           taicpu(p).is_jmp then
-         regsstillvalid := regsstillvalid - ptaiprop(p.optinfo)^.usedregs;
-
-        stillValid :=
-          (p.typ = ait_instruction) and
-          (taicpu(p).opcode <> a_jmp) and
-          (ptaiprop(p.optinfo)^.regs[supreg].wstate =
-            ptaiprop(currentPrev.optinfo)^.regs[supreg].wstate) and
-        { in case destroyreg is called with doIncState = false }
-          (ptaiprop(p.optinfo)^.regs[supreg].typ =
-            ptaiprop(currentPrev.optinfo)^.regs[supreg].typ) and
-          (supreg in (regsNotRead * regsStillValid));
-        { stop if the register was still used right before a (conditional) }
-        { jump, since in that case its current contents could still be     }
-        { used in the other path of the jump)                              }
-        if (p.typ = ait_instruction) and
-           (taicpu(p).is_jmp) and
-           getlastinstruction(p,hp) then
-          stillValid := stillValid and
-           not(supreg in ptaiprop(hp.optinfo)^.usedregs);
-        passedFlagsModifyingInstr := passedFlagsModifyingInstr or
-          instrWritesFlags(currentPrev);
-      end;
-
-
-    function findChangedRegister(p: tai): tsuperregister;
-    var
-      regCounter, loopstart: tsuperregister;
-    begin
-      if (current_reg <> RS_INVALID) then
-        loopstart := succ(current_reg)
-      else
-        loopstart := RS_EAX;
-      for regCounter := loopstart to RS_EDI do
-        with ptaiprop(p.optinfo)^.regs[regCounter] do
-        if ((startmod <>
-             ptaiprop(currentPrev.optinfo)^.regs[regCounter].startmod)  or
-            (nrofMods <>
-             ptaiprop(currentPrev.optinfo)^.regs[regCounter].nrofMods)) and
-           (ptaiprop(p.optinfo)^.regs[regCounter].typ in [con_ref,con_noRemoveRef]) then
-          begin
-            findChangedRegister := regCounter;
-            current_reg := regCounter;
-            exit;
-          end;
-      current_reg := RS_INVALID;
-      findChangedRegister := RS_INVALID;
-    end;
-
-
-  var
-    hp, prevFound: tai;
-    tmpResult, regCounter: tsuperregister;
-    invalsmemwrite: boolean;
-  begin
-    if (current_reg <> RS_EDI) and
-       (current_reg <> RS_INVALID) then
-      begin
-        tmpResult := findChangedRegister(currentPrev);
-        if tmpResult <> RS_INVALID then
-          begin
-            getPrevSequence := tmpResult;
-            exit;
-          end;
-      end;
-
-    getPrevSequence := RS_INVALID;
-    passedFlagsModifyingInstr := passedFlagsModifyingInstr or
-      instrWritesFlags(currentPrev);
-    if (cs_opt_regvar in current_settings.optimizerswitches) and
-       (currentprev.typ = ait_instruction) and
-       taicpu(currentprev).is_jmp then
-      regsstillvalid := regsstillvalid - ptaiprop(currentprev.optinfo)^.usedregs;
-
-    if not getLastInstruction(currentPrev,hp) then
-      exit;
-
-    prevFound := currentPrev;
-    tmpResult := RS_INVALID;
-
-    while (tmpResult = RS_INVALID) and
-          stillValid(hp) and
-          (ptaiprop(prevFound.optinfo)^.canBeRemoved or
-           not(modifiesConflictingMemLocation(prevFound,supreg,
-             ptaiprop(p.optinfo)^.regs,regsStillValid,false, invalsmemwrite))) do
-      begin
-        { only update the regsread for the instructions we already passed }
-        if not(ptaiprop(prevFound.optinfo)^.canBeRemoved) then
-          for regCounter := RS_EAX to RS_EDI do
-            if regReadByInstruction(regCounter,prevFound) then
-              exclude(regsNotRead,regCounter);
-
-        { in case getPreviousInstruction fails and sets hp to nil in the }
-        { next iteration                                                 }
-        prevFound := hp;
-        if not(ptaiprop(hp.optinfo)^.canBeRemoved) then
-          tmpResult := findChangedRegister(hp);
-        if not getLastInstruction(hp,hp) then
-          break;
-      end;
-    getPrevSequence := tmpResult;
-    if tmpResult <> RS_INVALID then
-      newPrev := prevFound;
-  end;
-
-
-  function getNextRegToTest(var prev: tai; currentReg: tsuperregister): tsuperregister;
-  begin
-    getNextRegToTest := RS_INVALID;
-    if not checkingPrevSequences then
-      begin
-        if (currentreg = RS_INVALID) then
-          currentreg := RS_EAX
-        else
-          inc(currentreg);
-        while (currentReg <= RS_EDI) and
-              not(ptaiprop(prev.optinfo)^.regs[currentReg].typ in [con_ref,con_noRemoveRef]) do
-          inc(currentReg);
-        if currentReg > RS_EDI then
-          begin
-            if (taicpu(p).oper[0]^.typ <> top_ref) or
-               isSimpleMemLoc(taicpu(p).oper[0]^.ref^) then
-              begin
-                checkingPrevSequences := true;
-              end
-            else
-              getNextRegToTest := RS_INVALID;
-          end
-        else
-          getNextRegToTest := currentReg;
-      end;
-    if checkingPrevSequences then
-      if findPrevSeqs then
-        getNextRegToTest :=
-          getPrevSequence(p,supreg,prev,prev)
-      else
-        getNextRegToTest := RS_INVALID;
-  end;
-
-
-  function changedreginvalidatedbetween(const oldreginfo: toptreginfo; var newreginfo: toptreginfo; startp,endp,current: tai): boolean;
-    var
-      orgdiffregs,diffregs: tregset;
-      runner: tai;
-      invalsmemwrite: boolean;
-    begin
-      diffregs := newreginfo.newregsencountered - oldreginfo.newregsencountered;
-      orgdiffregs := diffregs;
-      if diffregs <> [] then
-        begin
-          runner := startp;
-          repeat
-            modifiesConflictingMemLocation(runner,RS_EAX { dummy },ptaiprop(current.optinfo)^.regs,diffregs,true,invalsmemwrite);
-            if orgdiffregs <> diffregs then
-              begin
-                changedreginvalidatedbetween := true;
-                newreginfo := oldreginfo;
-                exit;
-              end;
-            getnextinstruction(runner,runner);
-          until (runner = endp);
-        end;
-      changedreginvalidatedbetween := false;
-    end;
-
-var
-  prevreginfo: toptreginfo;
-  hp2, hp3{, EndMod}, prevhp3, highPrev, orgPrev, pprev: tai;
-  {Cnt,} OldNrofMods: Longint;
-  startRegInfo, OrgRegInfo, HighRegInfo: toptreginfo;
-  regModified, lastregloadremoved: array[RS_EAX..RS_ESP] of boolean;
-  HighFound, OrgRegFound: longint;
-  regcounter, regCounter2, tmpreg, base, index: tsuperregister;
-  OrgRegResult: Boolean;
-  TmpResult, flagResultsNeeded: Boolean;
-begin {CheckSequence}
-  TmpResult := False;
-  FillChar(OrgRegInfo, Sizeof(OrgRegInfo), 0);
-  FillChar(startRegInfo, sizeof(startRegInfo), 0);
-  FillChar(HighRegInfo, sizeof(HighRegInfo), 0);
-  FillChar(prevreginfo, sizeof(prevreginfo), 0);
-  OrgRegFound := 0;
-  HighFound := 0;
-  OrgRegResult := False;
-  highPrev := nil;
-  orgPrev := nil;
-  with startRegInfo do
-    begin
-      newRegsEncountered := [RS_EBP, RS_ESP];
-      fillword(new2oldreg,sizeof(new2oldreg),RS_INVALID);
-      new2OldReg[RS_EBP] := RS_EBP;
-      new2OldReg[RS_ESP] := RS_ESP;
-      oldRegsEncountered := newRegsEncountered;
-    end;
-
-  checkingPrevSequences := false;
-  passedFlagsModifyingInstr := false;
-  flagResultsNeeded := false;
-  regsNotRead := [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESP,RS_EBP,RS_EDI,RS_ESI];
-  regsStillValid := regsNotRead;
-  GetLastInstruction(p, prev);
-  pprev := prev;
-  tmpreg:=RS_INVALID;
-  regCounter := getNextRegToTest(prev,tmpreg);
-  while (regcounter <> RS_INVALID) do
-    begin
-      fillchar(regModified,sizeof(regModified),0);
-      fillchar(lastregloadremoved,sizeof(lastregloadremoved),0);
-      reginfo := startRegInfo;
-      Found := 0;
-      hp2 := ptaiprop(prev.optinfo)^.Regs[regcounter].StartMod;
-      if (prev <> ptaiprop(prev.optinfo)^.Regs[regcounter].StartMod) then
-        OldNrofMods := ptaiprop(prev.optinfo)^.Regs[regcounter].NrofMods
-      else
-        OldNrofMods := 1;
-      hp3 := p;
-      if checkingprevsequences then
-        prevreginfo := reginfo;
-      while (Found <> OldNrofMods) and
-                                  { old  new }
-             InstructionsEquivalent(hp2, hp3, reginfo) and
-             (not(checkingprevsequences) or
-              not(changedreginvalidatedbetween(prevreginfo,reginfo,prev,p,hp3))) do
-        begin
-          if checkingprevsequences then
-            begin
-              prevreginfo := reginfo;
-            end;
-          if (hp3.typ = ait_instruction) and
-             ((taicpu(hp3).opcode = A_MOV) or
-              (taicpu(hp3).opcode = A_MOVZX) or
-              (taicpu(hp3).opcode = A_LEA) or
-             (taicpu(hp3).opcode = A_MOVSX)) and
-             (taicpu(hp3).oper[1]^.typ = top_reg) and
-             not(regInOp(getsupreg(taicpu(hp3).oper[1]^.reg),taicpu(hp3).oper[0]^)) then
-            begin
-              tmpreg := getsupreg(taicpu(hp3).oper[1]^.reg);
-              lastregloadremoved[tmpreg] := ptaiprop(hp2.optinfo)^.canberemoved;
-              reginfo.lastReload[tmpreg] := hp3;
-              case taicpu(hp3).oper[0]^.typ of
-                top_ref:
-                  begin
-                    base := getsupreg(taicpu(hp3).oper[0]^.ref^.base);
-                    index := getsupreg(taicpu(hp3).oper[0]^.ref^.index);
-                    if (found <> 0) and
-                       ((taicpu(hp3).oper[0]^.ref^.base = NR_NO) or
-                        regModified[base] or
-                        (base = getsupreg(current_procinfo.framepointer))) and
-                       ((taicpu(hp3).oper[0]^.ref^.index = NR_NO) or
-                        regModified[index]) and
-                       not(regInRef(tmpReg,taicpu(hp3).oper[0]^.ref^)) then
-                      begin
-                        with ptaiprop(hp3.optinfo)^.regs[tmpreg] do
-                          if nrofMods > (oldNrofMods - found) then
-                            oldNrofMods := found + nrofMods;
-                        { next is safe because instructions are equivalent }
-                        with ptaiprop(hp2.optinfo)^.regs[getsupreg(taicpu(hp2).oper[1]^.reg)] do
-                          if nrofMods > (oldNrofMods - found) then
-                            oldNrofMods := found + nrofMods;
-                      end;
-                  end;
-                top_reg:
-                  if regModified[getsupreg(taicpu(hp3).oper[0]^.reg)] then
-                    begin
-                      with ptaiprop(hp3.optinfo)^.regs[tmpreg] do
-                        if nrofMods > (oldNrofMods - found) then
-                          oldNrofMods := found + nrofMods;
-                      with ptaiprop(hp2.optinfo)^.regs[getsupreg(taicpu(hp2).oper[1]^.reg)] do
-                        if nrofMods > (oldNrofMods - found) then
-                          oldNrofMods := found + nrofMods;
-                    end;
-              end;
-            end;
-          for regCounter2 := RS_EAX to RS_EDI do
-            regModified[regCounter2] := regModified[regCounter2] or
-              regModifiedByInstruction(regCounter2,hp3);
-          if flagResultsNeeded then
-            flagResultsNeeded := not instrReadsFlags(hp3);
-          if not flagResultsNeeded then
-            flagResultsNeeded := ptaiprop(hp3.optinfo)^.FlagsUsed;
-          inc(Found);
-          prevhp3 := hp3;
-          if (Found <> OldNrofMods) then
-            if not GetNextInstruction(hp2, hp2) or
-               not GetNextInstruction(hp3, hp3) then
-              break;
-        end;
-
-      if assigned(hp3) then
-        begin
-          prevhp3 := hp3;
-          getnextinstruction(hp3,hp3);
-        end;
-      if not assigned(hp3) or
-         { a marker has no optinfo, which is used below }
-         (hp3.typ = ait_marker) then
-        hp3 := prevhp3;
-{
-a) movl  -4(%ebp),%edx
-   movl -12(%ebp),%ecx
-   ...
-   movl  -8(%ebp),%eax
-   movl -12(%ebp),%edx (marked as removable)
-   movl  (%eax,%edx),%eax (replaced by "movl (%eax,%ecx),%eax")
-   ...
-   movl  -8(%ebp),%eax
-   movl -12(%ebp),%edx
-   movl  (%eax,%edx),%eax
-   movl  (%edx),%edx
-
--> the "movl -12(ebp),%edx" can't be removed in the last sequence, because
-   edx has not been replaced with ecx there, and edx is still used after the
-   sequence
-
-b) tests/webtbs/tw4266.pp
-}
-
-      { hp2 = instruction after previous sequence, pprev = instruction before }
-      { current sequence, prev = instruction where the loads of the registers }
-      { will be inserted                                                      }
-      for regCounter2 := RS_EAX to RS_EDI do
-        if (reginfo.new2OldReg[regCounter2] <> RS_INVALID) and
-           { case a) above }
-           (((regCounter2 in ptaiprop(hp3.optinfo)^.usedRegs) and
-             (not regLoadedWithNewValue(regCounter2,false,hp3) and
-              lastregloadremoved[regcounter2])) or
-           { case b) above }
-            ((ptaiprop(hp2.optinfo)^.regs[regCounter2].wstate <>
-              ptaiprop(pprev.optinfo)^.regs[regcounter2].wstate)) or
-            ((ptaiprop(hp2.optinfo)^.regs[reginfo.new2OldReg[regCounter2]].wstate <>
-              ptaiprop(prev.optinfo)^.regs[reginfo.new2OldReg[regCounter2]].wstate))) then
-          begin
-            found := 0;
-            break;
-          end;
-
-      if checkingPrevSequences then
-        begin
-          for regCounter2 := RS_EAX to RS_EDI do
-            if (reginfo.new2OldReg[regCounter2] <> RS_INVALID) and
-               (reginfo.new2OldReg[regCounter2] <> regCounter2) and
-               (not(regCounter2 in (regsNotRead * regsStillValid)) or
-               not(reginfo.new2OldReg[regCounter2] in regsStillValid)) then
-              begin
-                found := 0;
-                break;
-              end;
-           if passedFlagsModifyingInstr and flagResultsNeeded then
-              found := 0;
-        end;
-
-      TmpResult := true;
-      if (found <> OldNrofMods) then
-        TmpResult := false
-      else if assigned(hp3) then
-        for regcounter2 := RS_EAX to RS_EDI do
-          if (regcounter2 in reginfo.regsLoadedforRef) and
-             regModified[regcounter2] and
-             (regcounter2 in ptaiprop(hp3.optinfo)^.usedRegs) and
-             not regLoadedWithNewValue(regcounter2,false,hp3) then
-            begin
-              TmpResult := False;
-              if (found > 0) then
-    {this is correct because we only need to turn off the CanBeRemoved flag
-    when an instruction has already been processed by CheckSequence
-    (otherwise CanBeRemoved can't be true and thus can't have to be turned off).
-    if it has already been processed by CheckSequence and flagged to be
-    removed, it means that it has been checked against a previous sequence
-    and that it was equal (otherwise CheckSequence would have returned false
-    and the instruction wouldn't have been removed). if this "if found > 0"
-    check is left out, incorrect optimizations are performed.}
-                Found := ptaiprop(tai(p).optinfo)^.Regs[supreg].NrofMods;
-              break;
-            end;
-
-      if TmpResult and
-         (Found > HighFound) then
-        begin
-          highPrev := prev;
-          HighFound := Found;
-          HighRegInfo := reginfo;
-        end;
-      if (regcounter = supreg) then
-        begin
-          orgPrev := prev;
-          OrgRegFound := Found;
-          OrgRegResult := TmpResult;
-          OrgRegInfo := reginfo
-        end;
-      regCounter := getNextRegToTest(prev,regCounter);
-    end;
-  if (HighFound > 0) and
-     (not(OrgRegResult) Or
-      (HighFound > OrgRegFound))
-    then
-      begin
-        CheckSequence := True;
-        prev := highPrev;
-        reginfo := HighRegInfo;
-        Found := HighFound
-      end
-    else
-      begin
-        CheckSequence := OrgRegResult;
-        prev := orgPrev;
-        Found := OrgRegFound;
-        reginfo := OrgRegInfo;
-      end;
-end; {CheckSequence}
-
-
-procedure SetAlignReg(p: tai);
-Const alignSearch = 12;
-var regsUsable: TRegSet;
-    prevInstrCount, nextInstrCount: Longint;
-    prevState, nextWState,nextRState: Array[RS_EAX..RS_EDI] of byte;
-    regCounter, lastRemoved: tsuperregister;
-    prev, next: tai;
-{$ifdef alignregdebug}
-    temp: tai;
-{$endif alignregdebug}
-begin
-  regsUsable := [RS_EAX,RS_ECX,RS_EDX,RS_EBX,{R_ESP,RS_EBP,}RS_ESI,RS_EDI];
-  for regCounter := RS_EAX to RS_EDI do
-    begin
-      prevState[regCounter] := ptaiprop(p.optinfo)^.Regs[regCounter].wState;
-      nextWState[regCounter] := ptaiprop(p.optinfo)^.Regs[regCounter].wState;
-      nextRState[regCounter] := ptaiprop(p.optinfo)^.Regs[regCounter].rState;
-    end;
-  getLastInstruction(p,prev);
-  getNextInstruction(p,next);
-  lastRemoved := getsupreg(tai_align(p).reg);
-  nextInstrCount := 0;
-  prevInstrCount := 0;
-  while ((assigned(prev) and
-          assigned(prev.optinfo) and
-          (prevInstrCount < alignSearch)) or
-         (assigned(next) and
-          assigned(next.optinfo) and
-          (nextInstrCount < alignSearch))) and
-        (regsUsable <> []) do
-    begin
-{$ifdef alignregdebug}
-      if assigned(prev) then
-        begin
-          temp := tai_comment.Create(strpnew('got here'));
-          temp.next := prev.next;
-          temp.previous := prev;
-          prev.next := temp;
-          if assigned(temp.next) then
-            temp.next.previous := temp;
-        end;
-{$endif alignregdebug}
-      if assigned(prev) and assigned(prev.optinfo) and
-         (prevInstrCount < alignSearch) then
-        begin
-          if (prev.typ = ait_instruction) and
-             (insProp[taicpu(prev).opcode].ch[1] <> Ch_ALL) and
-             (taicpu(prev).opcode <> A_JMP) then
-            begin
-              inc(prevInstrCount);
-              for regCounter := RS_EAX to RS_EDI do
-                begin
-                  if (regCounter in regsUsable) and
-                     (ptaiprop(prev.optinfo)^.Regs[regCounter].wState <>
-                       prevState[regCounter]) then
-                    begin
-                      lastRemoved := regCounter;
-                      exclude(regsUsable,regCounter);
-{$ifdef alignregdebug}
-                      temp := tai_comment.Create(strpnew(
-                                std_regname(newreg(R_INTREGISTER,regCounter,R_SUBWHOLE))+' removed')));
-                      temp.next := prev.next;
-                      temp.previous := prev;
-                      prev.next := temp;
-                      if assigned(temp.next) then
-                        temp.next.previous := temp;
-                      if regsUsable = [] then
-                        begin
-                          temp := tai_comment.Create(strpnew(
-                                    'regsUsable empty here')));
-                          temp.next := prev.next;
-                          temp.previous := prev;
-                          prev.next := temp;
-                          if assigned(temp.next) then
-                            temp.next.previous := temp;
-                        end;
-{$endif alignregdebug}
-                    end;
-                  prevState[regCounter] :=
-                    ptaiprop(prev.optinfo)^.Regs[regCounter].wState;
-                end;
-              getLastInstruction(prev,prev);
-            end
-          else
-            if GetLastInstruction(prev,prev) and
-               assigned(prev.optinfo) then
-              for regCounter := RS_EAX to RS_EDI do
-                prevState[regCounter] :=
-                  ptaiprop(prev.optinfo)^.Regs[regCounter].wState
-        end;
-      if assigned(next) and assigned(next.optinfo) and
-         (nextInstrCount < alignSearch) then
-        begin
-          if (next.typ = ait_instruction) and
-             (insProp[taicpu(next).opcode].ch[1] <> Ch_ALL) and
-             (taicpu(next).opcode <> A_JMP) then
-            begin
-              inc(nextInstrCount);
-              for regCounter := RS_EAX to RS_EDI do
-                begin
-                  if (regCounter in regsUsable) and
-                     ((ptaiprop(next.optinfo)^.Regs[regCounter].wState <>
-                       nextWState[regCounter]) or
-                      (ptaiprop(next.optinfo)^.Regs[regCounter].rState <>
-                       nextRState[regCounter])) then
-                    begin
-                      lastRemoved := regCounter;
-                      exclude(regsUsable,regCounter);
-{$ifdef alignregdebug}
-                      temp := tai_comment.Create(strpnew(
-                                std_regname(newreg(R_INTREGISTER,regCounter,R_SUBWHOLE))+' removed')));
-                      temp.next := next.next;
-                      temp.previous := next;
-                      next.next := temp;
-                      if assigned(temp.next) then
-                        temp.next.previous := temp;
-                      if regsUsable = [] then
-                        begin
-                          temp := tai_comment.Create(strpnew(
-                                    'regsUsable empty here')));
-                          temp.next := next.next;
-                          temp.previous := next;
-                          next.next := temp;
-                          if assigned(temp.next) then
-                            temp.next.previous := temp;
-                        end;
-{$endif alignregdebug}
-                    end;
-                  nextWState[regCounter] :=
-                    ptaiprop(next.optinfo)^.Regs[regCounter].wState;
-                  nextRState[regCounter] :=
-                    ptaiprop(next.optinfo)^.Regs[regCounter].rState;
-                end
-            end
-          else
-            for regCounter := RS_EAX to RS_EDI do
-              begin
-                nextWState[regCounter] :=
-                  ptaiprop(next.optinfo)^.Regs[regCounter].wState;
-                nextRState[regCounter] :=
-                  ptaiprop(next.optinfo)^.Regs[regCounter].rState;
-              end;
-          getNextInstruction(next,next);
-        end;
-    end;
-  if regsUsable <> [] then
-    for regCounter := RS_EAX to RS_EDI do
-      if regCounter in regsUsable then
-        begin
-          lastRemoved := regCounter;
-          break
-        end;
-{$ifdef alignregdebug}
-  next := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,lastremoved,R_SUBWHOLE))+
-               ' chosen as alignment register')));
-  next.next := p.next;
-  next.previous := p;
-  p.next := next;
-  if assigned(next.next) then
-    next.next.previous := next;
-{$endif alignregdebug}
-  tai_align(p).reg := newreg(R_INTREGISTER,lastRemoved,R_SUBWHOLE);
-end;
-
-
-procedure clearmemwrites(p: tai; supreg: tsuperregister);
-var
-  beginmemwrite: tai;
-begin
-  beginmemwrite := ptaiprop(p.optinfo)^.regs[supreg].memwrite;
-  repeat
-    ptaiprop(p.optinfo)^.regs[supreg].memwrite := nil;
-  until not getnextinstruction(p,p) or
-        (ptaiprop(p.optinfo)^.regs[supreg].memwrite <> beginmemwrite);
-end;
-
-
-procedure ClearRegContentsFrom(asml: TAsmList; supreg: tsuperregister; p, endP: tai);
-{ first clears the contents of reg from p till endP. then the contents are }
-{ cleared until the first instruction that changes reg                     }
-var
-{$ifdef replaceregdebug}
-    hp: tai;
-    l: longint;
-{$endif replaceregdebug}
-    regcounter: tsuperregister;
-    oldStartmod: tai;
-    regstoclear: tregset;
-begin
-{$ifdef replaceregdebug}
-  l := random(1000);
-  hp := tai_comment.Create(strpnew(
-          'cleared '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' from here... '+tostr(l)));
-  insertllitem(asml,p.previous,p,hp);
-{$endif replaceregdebug}
-  ptaiprop(p.optinfo)^.Regs[supreg].typ := con_unknown;
-  regstoclear := [supreg];
-  while (p <> endP) do
-    begin
-      for regcounter := RS_EAX to RS_EDI do
-        begin
-          if (regcounter <> supreg) and
-             assigned(ptaiprop(p.optinfo)^.regs[supreg].memwrite) and
-             reginref(regcounter,ptaiprop(p.optinfo)^.regs[supreg].memwrite.oper[1]^.ref^) then
-            clearmemwrites(p,regcounter);
-          { needs double loop to cheack for each dependency combination? }
-          if assigned(ptaiprop(p.optinfo)^.regs[regcounter].startmod) and
-             sequencedependsonreg(ptaiprop(p.optinfo)^.regs[regcounter],regcounter,supreg) then
-            include(regstoclear,regcounter);
-
-          if regcounter in regstoclear then
-            with ptaiprop(p.optinfo)^.Regs[regcounter] do
-              begin
-                typ := con_unknown;
-                memwrite := nil;
-                startmod := nil;
-                nrofmods := 0;
-              end;
-        end;
-      getNextInstruction(p,p);
-    end;
-  oldStartmod := ptaiprop(p.optinfo)^.Regs[supreg].startmod;
-  repeat
-    for regcounter := RS_EAX to RS_EDI do
-      begin
-        { needs double loop to cheack for each dependency combination? }
-        if assigned(ptaiprop(p.optinfo)^.regs[regcounter].startmod) and
-           sequencedependsonreg(ptaiprop(p.optinfo)^.regs[regcounter],regcounter,supreg) then
-          include(regstoclear,regcounter);
-        with ptaiprop(p.optinfo)^.Regs[supreg] do
-          if regcounter in regstoclear then
-            begin
-              typ := con_unknown;
-              memwrite := nil;
-            end;
-      end;
-  until not getNextInstruction(p,p) or
-        (ptaiprop(p.optinfo)^.Regs[supreg].startmod <> oldStartmod);
-{$ifdef replaceregdebug}
-  if assigned(p) then
-    begin
-      hp := tai_comment.Create(strpnew(
-        'cleared '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' till here... '+tostr(l)));
-      insertllitem(asml,p.previous,p,hp);
-    end;
-{$endif replaceregdebug}
-end;
-
-procedure RestoreRegContentsTo(asml: TAsmList; supreg: tsuperregister; const c: TContent; p, endP: tai);
-var
-{$ifdef replaceregdebug}
-  l: longint;
-{$endif replaceregdebug}
-  hp: tai;
-  validregs, prevvalidregs: tregset;
-  regcounter: tsuperregister;
-  tmpState, newrstate: byte;
-  prevcontenttyp: byte;
-  memconflict: boolean;
-  invalsmemwrite: boolean;
-begin
-{$ifdef replaceregdebug}
-  l := random(1000);
-  hp := tai_comment.Create(strpnew(
-          'restored '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' with data from here... '+tostr(l)));
-  insertllitem(asml,p.previous,p,hp);
-{$endif replaceregdebug}
-{  ptaiprop(p.optinfo)^.Regs[reg] := c;}
-  newrstate := c.rstate;
-  incstate(newrstate,$7f);
-  memconflict := false;
-  invalsmemwrite := false;
-  validregs := [RS_EAX..RS_EDI];
-  prevvalidregs := validregs;
-  while (p <> endP) and
-        not(memconflict) and
-        not(invalsmemwrite) do
-    begin
-      if not(ptaiprop(p.optinfo)^.canberemoved) and
-         regreadbyinstruction(supreg,p) then
-        incstate(newrstate,1);
-      // is this a write to memory that destroys the contents we are restoring?
-      memconflict := modifiesConflictingMemLocation(p,supreg,ptaiprop(p.optinfo)^.regs,validregs,false,invalsmemwrite);
-      if (validregs <> prevvalidregs) then
-        begin
-          prevvalidregs := validregs >< prevvalidregs;
-          for regcounter := RS_EAX to RS_EDI do
-            if regcounter in prevvalidregs then
-              clearRegContentsFrom(asml,regcounter,p,endP);
-        end;
-      prevvalidregs := validregs;
-      if (not memconflict and not invalsmemwrite) then
-        begin
-          ptaiprop(p.optinfo)^.Regs[supreg] := c;
-          ptaiprop(p.optinfo)^.Regs[supreg].rstate := newrstate;
-        end
-      else
-        begin
-          clearRegContentsFrom(asml,supreg,p,endP);
-{$ifdef replaceregdebug}
-           if assigned(p) then
-             begin
-               hp := tai_comment.Create(strpnew(
-                 'stopping restoring of '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+'because memory conflict... '+tostr(l)));
-               insertllitem(asml,p,p.next,hp);
-             end;
-{$endif replaceregdebug}
-          exit
-        end;
-
-      getNextInstruction(p,p);
-    end;
-
-  tmpState := ptaiprop(p.optinfo)^.Regs[supreg].wState;
-  if (newrstate = ptaiprop(p.optinfo)^.Regs[supreg].rState) then
-    begin
-      incstate(ptaiprop(p.optinfo)^.regs[supreg].rstate,63);
-      if not getnextinstruction(p,hp) then
-        exit;
-      if (ptaiprop(hp.optinfo)^.regs[supreg].rstate = ptaiprop(p.optinfo)^.regs[supreg].rstate) then
-        internalerror(2004122710);
-     end;
-  repeat
-    newrstate := ptaiprop(p.optinfo)^.Regs[supreg].rState;
-    prevcontenttyp := ptaiprop(p.optinfo)^.Regs[supreg].typ;
-    // is this a write to memory that destroys the contents we are restoring?
-    memconflict := modifiesConflictingMemLocation(p,supreg,ptaiprop(p.optinfo)^.regs,validregs,false,invalsmemwrite);
-    if (validregs <> prevvalidregs) then
-      begin
-        prevvalidregs := validregs >< prevvalidregs;
-        for regcounter := RS_EAX to RS_EDI do
-          if regcounter in prevvalidregs then
-            clearRegContentsFrom(asml,regcounter,p,p);
-      end;
-    prevvalidregs := validregs;
-    if (not memconflict and not invalsmemwrite) then
-      begin
-        ptaiprop(p.optinfo)^.Regs[supreg] := c;
-        ptaiprop(p.optinfo)^.Regs[supreg].rstate := newrstate;
-      end;
-  until invalsmemwrite or
-        memconflict or
-        not getNextInstruction(p,p) or
-        (ptaiprop(p.optinfo)^.Regs[supreg].wState <> tmpState) or
-        (p.typ = ait_label) or
-        ((prevcontenttyp <> con_invalid) and
-         (ptaiprop(p.optinfo)^.Regs[supreg].typ = con_invalid));
-  if assigned(p) and
-     (p.typ <> ait_marker) then
-    if ((p.typ = ait_label) or
-       memconflict or
-       invalsmemwrite) then
-      clearRegContentsFrom(asml,supreg,p,p)
-    else if (ptaiprop(p.optinfo)^.Regs[supreg].rstate = newrstate) then
-      incstate(ptaiprop(p.optinfo)^.Regs[supreg].rstate,20);
-{$ifdef replaceregdebug}
-  if assigned(p) then
-    begin
-      hp := tai_comment.Create(strpnew(
-        'restored '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' till here... '+tostr(l)));
-     insertllitem(asml,p,p.next,hp);
-    end;
-{$endif replaceregdebug}
-end;
-
-function NoHardCodedRegs(p: taicpu; orgReg, newReg: tsuperregister): boolean;
-var
-  chCount: byte;
-begin
-  case p.opcode of
-    A_IMUL: noHardCodedRegs := p.ops <> 1;
-    A_SHL,A_SHR,A_ROR,A_ROL,A_SAR,A_SHLD,A_SHRD: noHardCodedRegs :=
-      (p.oper[0]^.typ <> top_reg) or
-      ((orgReg <> RS_ECX) and (newReg <> RS_ECX));
-    else
-      begin
-        NoHardCodedRegs := true;
-        with InsProp[p.opcode] do
-          for chCount := 1 to maxinschanges do
-            if Ch[chCount] in ([Ch_REAX..Ch_MEDI,Ch_WMemEDI,Ch_All]-[Ch_RESP,Ch_WESP,Ch_RWESP]) then
-              begin
-                NoHardCodedRegs := false;
-                break
-              end;
-      end;
-  end;
-end;
-
-
-function ChangeReg(var Reg: TRegister; newReg, orgReg: tsuperregister): boolean;
-begin
-  changereg := false;
-  if (reg <> NR_NO) and
-     (getregtype(reg) = R_INTREGISTER) and
-     (getsupreg(reg) = newreg) then
-    begin
-      changereg := true;
-      setsupreg(reg,orgreg);
-    end;
-end;
-
-
-function changeOp(var o: toper; newReg, orgReg: tsuperregister): boolean;
-var
-  tmpresult: boolean;
-begin
-  changeOp := false;
-  case o.typ of
-    top_reg: changeOp := changeReg(o.reg,newReg,orgReg);
-    top_ref:
-      begin
-        tmpresult := changeReg(o.ref^.base,newReg,orgReg);
-        changeop := changeReg(o.ref^.index,newReg,orgReg) or tmpresult;
-      end;
-  end;
-end;
-
-
-procedure updateStates(orgReg,newReg: tsuperregister; hp: tai; writeStateToo: boolean);
-var
-  prev: tai;
-  newOrgRegRState, newOrgRegWState: byte;
-begin
-  newOrgRegwState := 0;
-  if getLastInstruction(hp,prev) then
-    with ptaiprop(prev.optinfo)^ do
-      begin
-        newOrgRegRState := byte(longint(regs[orgReg].rState) +
-          longint(ptaiprop(hp.optinfo)^.regs[newReg].rState) - regs[newReg].rstate);
-        if writeStateToo then
-          newOrgRegWState := byte(longint(regs[orgReg].wState) +
-            longint(ptaiprop(hp.optinfo)^.regs[newReg].wState) - regs[newReg].wstate);
-      end
-  else
-    with ptaiprop(hp.optinfo)^.regs[newReg] do
-      begin
-        newOrgRegRState := rState;
-        if writeStateToo then
-          newOrgRegWState := wState;
-      end;
-  with ptaiprop(hp.optinfo)^.regs[orgReg] do
-    begin
-      rState := newOrgRegRState;
-      if writeStateToo then
-        wState := newOrgRegwState;
-    end;
-end;
-
-
-function doReplaceReg(hp: taicpu; newReg, orgReg: tsuperregister): boolean;
-var
-  opCount: longint;
-  tmpResult: boolean;
-begin
-  tmpresult := false;
-  for opCount := 0 to hp.ops-1 do
-    tmpResult :=
-      changeOp(hp.oper[opCount]^,newReg,orgReg) or tmpResult;
-  doReplaceReg := tmpResult;
-end;
-
-
-function RegSizesOK(oldReg,newReg: tsuperregister; p: taicpu): boolean;
-{ oldreg and newreg must be 32bit components }
-var
-  opCount: longint;
-  tmpreg: tsuperregister;
-begin
-  RegSizesOK := true;
-  { if only one of them is a general purpose register ... }
-  if (IsGP32reg(oldReg) xor IsGP32Reg(newReg)) then
-    begin
-      for opCount := 0 to p.ops-1 do
-        if (p.oper[opCount]^.typ = top_reg) and
-           (getsubreg(p.oper[opCount]^.reg) in [R_SUBL,R_SUBH]) then
-          begin
-            tmpreg := getsupreg(p.oper[opCount]^.reg);
-            if (tmpreg = oldreg) or
-               (tmpreg = newreg) then
-              begin
-                RegSizesOK := false;
-                break
-              end
-          end;
-    end;
-end;
-
-
-function doReplaceReadReg(p: taicpu; newReg,orgReg: tsuperregister): boolean;
-var
-  opCount: longint;
-begin
-  doReplaceReadReg := false;
-  { handle special case }
-  case p.opcode of
-    A_IMUL:
-      begin
-        case p.ops of
-          1: internalerror(1301001);
-          2,3:
-            begin
-              if changeOp(p.oper[0]^,newReg,orgReg) then
-                begin
-{                  updateStates(orgReg,newReg,p,false);}
-                  doReplaceReadReg := true;
-                end;
-             if p.ops = 3 then
-                if changeOp(p.oper[1]^,newReg,orgReg) then
-                  begin
-{                    updateStates(orgReg,newReg,p,false);}
-                    doReplaceReadReg := true;
-                  end;
-            end;
-        end;
-      end;
-    A_DIV,A_IDIV,A_MUL: internalerror(1301002);
-    else
-      begin
-        for opCount := 0 to p.ops-1 do
-          if p.oper[opCount]^.typ = top_ref then
-            if changeOp(p.oper[opCount]^,newReg,orgReg) then
-              begin
-{                updateStates(orgReg,newReg,p,false);}
-                doReplaceReadReg := true;
-              end;
-        for opCount := 1 to maxinschanges do
-          case InsProp[p.opcode].Ch[opCount] of
-            Ch_ROp1:
-              if p.oper[0]^.typ = top_reg then
-                if changeReg(p.oper[0]^.reg,newReg,orgReg) then
-                  begin
-{                    updateStates(orgReg,newReg,p,false);}
-                    doReplaceReadReg := true;
-                  end;
-            Ch_ROp2:
-              if p.oper[1]^.typ = top_reg then
-                if changeReg(p.oper[1]^.reg,newReg,orgReg) then
-                  begin
-{                    updateStates(orgReg,newReg,p,false);}
-                    doReplaceReadReg := true;
-                  end;
-            Ch_ROp3:
-              if p.oper[2]^.typ = top_reg then
-                if changeReg(p.oper[2]^.reg,newReg,orgReg) then
-                  begin
-{                    updateStates(orgReg,newReg,p,false);}
-                    doReplaceReadReg := true;
-                  end;
-          end;
-      end;
-  end;
-end;
-
-
-procedure updateState(supreg: tsuperregister; p: tai);
-{ this procedure updates the read and write states of the instructions }
-{ coming after p. It's called when the read/write state of p has been  }
-{ changed and this change has to be propagated to the following        }
-{ instructions as well                                                 }
-var
-  newRState, newWState: byte;
-  prevRState, prevWState: byte;
-  doRState, doWState: boolean;
-begin
-  { get the new read/write states from p }
-  with ptaiprop(p.optinfo)^.regs[supreg] do
-    begin
-      newRState := rState;
-      newWState := wState;
-    end;
-  if not GetNextInstruction(p,p) then
-    exit;
-  { get the old read/write states from the next instruction, to know }
-  { when we can stop updating                                        }
-  with ptaiprop(p.optinfo)^.regs[supreg] do
-    begin
-      prevRState := rState;
-      prevWState := wState;
-    end;
-  { adjust the states if this next instruction reads/writes the register }
-  if regReadByInstruction(supreg,p) then
-    incState(newRState,1);
-  if regModifiedByInstruction(supreg,p) then
-    incState(newWState,1);
-  { do we still have to update the read and/or write states? }
-  doRState := true;
-  doWState := true;
-  repeat
-    { update the states }
-    with ptaiprop(p.optinfo)^.regs[supreg] do
-      begin
-        if doRState then
-          rState := newRState;
-        if doWState then
-          wState := newWState;
-      end;
-    if not getNextInstruction(p,p) then
-      break;
-    with ptaiprop(p.optinfo)^.regs[supreg] do
-      begin
-        { stop updating the read state if it changes }
-        doRState :=
-          doRState and (rState = prevRState);
-        { if, by accident, this changed state is the same as the one }
-        { we've been using, change it to a value that's definitely   }
-        { different from the previous and next state                 }
-        if not doRState and
-           (rState = newRState) then
-          begin
-            incState(newRState,1);
-            prevRState := rState;
-            doRState := true;
-          end;
-        { ditto for the write state }
-        doWState :=
-          doWState and (WState = prevWState);
-        if not doWState and
-           (wState = newWState) then
-          begin
-            incState(newWState,1);
-            prevWState := wState;
-            doWState := true;
-          end;
-      end;
-  { stop when we don't have to update either state anymore }
-  until not(doRState or doWState);
-end;
-
-
-function storeBack(start, current: tai; orgReg, newReg: tsuperregister): boolean;
-{ returns true if p1 contains an instruction that stores the contents }
-{ of newReg back to orgReg                                            }
-begin
-  storeback := false;
-  if (current.typ = ait_instruction) and
-     (taicpu(current).opcode = A_MOV) and
-     (taicpu(current).oper[0]^.typ = top_reg) and
-     (getsupreg(taicpu(current).oper[0]^.reg) = newReg) and
-     (taicpu(current).oper[1]^.typ = top_reg) and
-     (getsupreg(taicpu(current).oper[1]^.reg) = orgReg) then
-    case taicpu(current).opsize of
-      S_B:
-        storeback := true;
-      S_W:
-        storeback := taicpu(start).opsize <> S_B;
-      S_L:
-        storeback := taicpu(start).opsize = S_L;
-      else
-        internalerror(2003121501);
-    end;
-end;
-
-
-function canreplacereg(orgsupreg, newsupreg: tsuperregister; p: tai;
-  orgRegCanBeModified: boolean; var resnewregmodified, resorgregread, resremovelast: boolean; var returnendp: tai): boolean;
-var
-  endP, hp: tai;
-  removeLast, sequenceEnd, tmpResult, newRegModified, orgRegRead: boolean;
-begin
-  canreplacereg := false;
-  tmpResult := true;
-  sequenceEnd := false;
-  newRegModified := false;
-  orgRegRead := false;
-  removeLast := false;
-  endP := p;
-  while tmpResult and not sequenceEnd do
-    begin
-      tmpResult :=
-        getNextInstruction(endP,endP) and
-        (endp.typ = ait_instruction) and
-        not(taicpu(endp).is_jmp);
-      if tmpresult and not assigned(endp.optinfo) then
-        begin
-{          hp := tai_comment.Create(strpnew('next no optinfo'));
-          hp.next := endp;
-          hp.previous := endp.previous;
-          endp.previous := hp;
-          if assigned(hp.previous) then
-            hp.previous.next := hp;}
-          exit;
-        end;
-      if tmpResult and
-         { don't take into account instructions that will be removed }
-         not (ptaiprop(endp.optinfo)^.canBeRemoved) then
-        begin
-          { if the newsupreg gets stored back to the oldReg, we can change }
-          { "mov %oldReg,%newReg; <operations on %newReg>; mov %newReg, }
-          { %oldReg" to "<operations on %oldReg>"                       }
-          removeLast := storeBack(p,endP, orgsupreg, newsupreg);
-          sequenceEnd :=
-            { no support for (i)div, mul and imul with hardcoded operands }
-            noHardCodedRegs(taicpu(endP),orgsupreg,newsupreg) and
-            { if newsupreg gets loaded with a new value, we can stop   }
-            { replacing newsupreg with oldReg here (possibly keeping   }
-            { the original contents of oldReg so we still know them }
-            { afterwards)                                           }
-             (RegLoadedWithNewValue(newsupreg,true,taicpu(endP)) or
-            { we can also stop if we reached the end of the use of }
-            { newReg's current contents                            }
-              (GetNextInstruction(endp,hp) and
-               FindRegDealloc(newsupreg,hp)));
-          { to be able to remove the first and last instruction of  }
-          {   movl %reg1, %reg2                                     }
-          {   <operations on %reg2> (replacing reg2 with reg1 here) }
-          {   movl %reg2, %reg1                                     }
-          { %reg2 must not be use afterwards (it can be as the      }
-          { result of a peepholeoptimization)                       }
-          removeLast := removeLast and sequenceEnd;
-          newRegModified :=
-            newRegModified or
-            (not(regLoadedWithNewValue(newsupreg,true,taicpu(endP))) and
-             RegModifiedByInstruction(newsupreg,endP));
-          orgRegRead := newRegModified and RegReadByInstruction(orgsupreg,endP);
-          sequenceEnd := SequenceEnd and
-                         (removeLast or
-    { since newsupreg will be replaced by orgsupreg, we can't allow that newsupreg }
-    { gets modified if orgsupreg is still read afterwards (since after       }
-    { replacing, this would mean that orgsupreg first gets modified and then }
-    { gets read in the assumption it still contains the unmodified value) }
-                         not(newRegModified and orgRegRead)) (* and
-    { since newsupreg will be replaced by orgsupreg, we can't allow that newsupreg }
-    { gets modified if orgRegCanBeModified = false                        }
-
-    { this now gets checked after the loop (JM) }
-                         (orgRegCanBeModified or not(newRegModified)) *);
-          tmpResult :=
-            not(removeLast) and
-            not(newRegModified and orgRegRead) and
-(*            (orgRegCanBeModified or not(newRegModified)) and *)
-(*          already checked at the top
-            (endp.typ = ait_instruction) and  *)
-            NoHardCodedRegs(taicpu(endP),orgsupreg,newsupreg) and
-            RegSizesOk(orgsupreg,newsupreg,taicpu(endP)) and
-            not RegModifiedByInstruction(orgsupreg,endP);
-        end;
-    end;
-  canreplacereg := sequenceEnd and
-     (removeLast  or
-      (orgRegCanBeModified or not(newRegModified))) and
-     (not(assigned(endp)) or
-      not(endp.typ = ait_instruction) or
-      (noHardCodedRegs(taicpu(endP),orgsupreg,newsupreg) and
-       RegSizesOk(orgsupreg,newsupreg,taicpu(endP)) and
-       not(newRegModified and
-           (orgsupreg in ptaiprop(endp.optinfo)^.usedRegs) and
-           not(RegLoadedWithNewValue(orgsupreg,true,taicpu(endP))))));
-  if canreplacereg then
-    begin
-      resnewregmodified := newregmodified;
-      resorgregread := orgregread;
-      resremovelast := removelast;
-    end;
-  { needed for replaceregdebug code }
-  returnendp := endp;
-end;
-
-
-
-function ReplaceReg(asml: TAsmList; orgsupreg, newsupreg: tsuperregister; p,
-          seqstart: tai; const c: TContent; orgRegCanBeModified: Boolean;
-          var returnEndP: tai): Boolean;
-{ Tries to replace orgsupreg with newsupreg in all instructions coming after p }
-{ until orgsupreg gets loaded with a new value. Returns true if successful, }
-{ false otherwise. if successful, the contents of newsupreg are set to c,   }
-{ which should hold the contents of newsupreg before the current sequence   }
-{ started                                                                }
-{ if the function returns true, returnEndP holds the last instruction    }
-{ where newsupreg was replaced by orgsupreg                                    }
-var
-  endP, hp: tai;
-  removeLast, newRegModified, orgRegRead,
-    stateChanged, readStateChanged: Boolean;
-{$ifdef replaceregdebug}
-  l: longint;
-{$endif replaceregdebug}
-
-begin
-  replacereg := false;
-  readStateChanged := false;
-  if canreplacereg(orgsupreg,newsupreg,p,orgregcanbemodified,newregmodified, orgregread, removelast,endp) then
-    begin
-{$ifdef replaceregdebug}
-      l := random(1000);
-      hp := tai_comment.Create(strpnew(
-        'replacing '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+
-        ' from here... '+tostr(l)));
-      insertllitem(asml,p.previous,p,hp);
-      hp := tai_comment.Create(strpnew(
-        'replaced '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+
-        ' till here ' + tostr(l)));
-      insertllitem(asml,endp,endp.next,hp);
-{$endif replaceregdebug}
-      replaceReg := true;
-      returnEndP := endP;
-
-      if not getNextInstruction(p,hp) then
-        exit;
-      stateChanged := false;
-      while hp <> endP do
-        begin
-          if {not(ptaiprop(hp.optinfo)^.canBeRemoved) and }
-             (hp.typ = ait_instruction) then
-            stateChanged :=
-              doReplaceReg(taicpu(hp),newsupreg,orgsupreg) or stateChanged;
-            if stateChanged then
-              updateStates(orgsupreg,newsupreg,hp,true);
-          getNextInstruction(hp,hp)
-        end;
-      if assigned(endp) and (endp.typ = ait_instruction) then
-        readStateChanged :=
-          doReplaceReadReg(taicpu(endP),newsupreg,orgsupreg);
-      if stateChanged or readStateChanged then
-        updateStates(orgsupreg,newsupreg,endP,stateChanged);
-
-      if stateChanged or readStateChanged then
-        updateState(orgsupreg,endP);
-
-{ We replaced newreg with oldreg between p and endp, so restore the contents }
-{ of newreg there with its contents from before the sequence.                }
-      if removeLast or
-         RegLoadedWithNewValue(newsupreg,true,endP) then
-        GetLastInstruction(endP,hp)
-      else hp := endP;
-      RestoreRegContentsTo(asml,newsupreg,c,seqstart,hp);
-
-{ Ot is possible that the new register was modified (e.g. an add/sub), so if  }
-{ it was replaced by oldreg in that instruction, oldreg's contents have been  }
-{ changed. To take this into account, we simply set the contents of orgsupreg }
-{ to "unknown" after this sequence                                            }
-      if newRegModified then
-        ClearRegContentsFrom(asml,orgsupreg,p,hp);
-      if removeLast then
-        ptaiprop(endp.optinfo)^.canBeRemoved := true;
-      allocRegBetween(asml,newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE),p,endP,ptaiprop(p.optinfo)^.usedregs);
-
-    end
-{$ifdef replaceregdebug}
-     else
-       begin
-         l := random(1000);
-         hp := tai_comment.Create(strpnew(
-           'replacing '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+
-           ' from here... '+ tostr(l)));
-         insertllitem(asml,p.previous,p,hp);
-        hp := tai_comment.Create(strpnew(
-          'replacing '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+
-          ' failed here ' + tostr(l)));
-        insertllitem(asml,endp,endp.next,hp);
-      end;
-{$endif replaceregdebug}
-end;
-
-
-function FindRegWithConst(p: tai; size: topsize; l: aint; var Res: TRegister): Boolean;
-{Finds a register which contains the constant l}
-var
-  Counter: tsuperregister;
-{$ifdef testing}
-    hp: tai;
-{$endif testing}
-begin
-  Result:=false;
-  Counter := RS_EAX;
-  repeat
-{$ifdef testing}
-     if (ptaiprop(p.optinfo)^.regs[counter].typ in [con_const,con_noRemoveConst]) then
-       begin
-         hp := tai_comment.Create(strpnew(
-           'checking const load of '+tostr(l)+' here...'));
-         hp.next := ptaiprop(p.optinfo)^.Regs[Counter].StartMod;
-         hp.previous := ptaiprop(p.optinfo)^.Regs[Counter].StartMod^.previous;
-         ptaiprop(p.optinfo)^.Regs[Counter].StartMod^.previous := hp;
-         if assigned(hp.previous) then
-           hp.previous.next := hp;
-       end;
-{$endif testing}
-     if (ptaiprop(p.optinfo)^.regs[counter].typ in [con_const,con_noRemoveConst]) and
-        (taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).opsize = size) and
-        (taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).oper[0]^.typ = top_const) and
-        (taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).oper[0]^.val = l) then
-       begin
-         res:=taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).oper[1]^.reg;
-         result:=true;
-         exit;
-       end;
-     inc(counter);
-  until (Counter > RS_EDI);
-end;
-
-
-procedure removePrevNotUsedLoad(asml: TAsmList; p: tai; supreg: tsuperregister; check: boolean);
-{ if check = true, it means the procedure has to check whether it isn't  }
-{ possible that the contents are still used after p (used when removing  }
-{ instructions because of a "call"), otherwise this is not necessary     }
-{ (e.g. when you have a "mov 8(%ebp),%eax", you can be sure the previous }
-{ value of %eax isn't used anymore later on)                             }
-var
-  hp1, next, beforestartmod: tai;
-begin
-  if getLastInstruction(p,hp1) then
-    with ptaiprop(hp1.optinfo)^.regs[supreg] do
-      if (typ in [con_ref,con_invalid,con_const]) and
-         (nrofMods = 1) and
-         (rState = ptaiprop(startmod.optinfo)^.regs[supreg].rState) and
-         (not(check) or
-          (not(regInInstruction(supreg,p)) and
-           (not(supreg in ptaiprop(hp1.optinfo)^.usedRegs) or
-            findRegDealloc(supreg,p)))) then
-        begin
-          ptaiprop(startMod.optinfo)^.canBeRemoved := true;
-          getnextinstruction(p,next);
-          { give the register that was modified by this instruction again }
-          { the contents it had before this instruction                   }
-          if getlastinstruction(startmod,beforestartmod) then
-            RestoreRegContentsTo(asml,supreg,ptaiprop(beforestartmod.optinfo)^.regs[supreg],
-             startmod,hp1)
-          else
-            ClearRegContentsFrom(asml,supreg,startmod,hp1);
-        end;
-end;
-
-
-{$ifdef notused}
-function is_mov_for_div(p: taicpu): boolean;
-begin
-  is_mov_for_div :=
-    (p.opcode = A_MOV) and
-    (p.oper[0]^.typ = top_const) and
-    (p.oper[1]^.typ = top_reg) and
-    (p.oper[1]^.reg = RS_EDX) and
-    getNextInstruction(p,p) and
-    (p.typ = ait_instruction) and
-    ((p.opcode = A_DIV) or
-     (p.opcode = A_IDIV));
-end;
-{$endif notused}
-
-
-function memtoreg(t: taicpu; const ref: treference; var startp: tai): tregister;
-var
-  hp: tai;
-  p: ptaiprop;
-  regcounter: tsuperregister;
-  optimizable: boolean;
-begin
-  memtoreg := NR_NO;
-
-  if not getlastinstruction(t,hp) or
-     not issimplememloc(ref) then
-    exit;
-
-  p := ptaiprop(hp.optinfo);
-  optimizable := false;
-  for regcounter := RS_EAX to RS_EDI do
-    begin
-      if (assigned(p^.regs[regcounter].memwrite) and
-         refsequal(ref,p^.regs[regcounter].memwrite.oper[1]^.ref^)) then
-        begin
-          optimizable := true;
-          hp := p^.regs[regcounter].memwrite;
-        end
-      else if ((p^.regs[regcounter].typ in [CON_REF,CON_NOREMOVEREF]) and
-             (p^.regs[regcounter].nrofmods = 1) and
-             ((taicpu(p^.regs[regcounter].startmod).opcode = A_MOV) or
-              (taicpu(p^.regs[regcounter].startmod).opcode = A_MOVZX) or
-              (taicpu(p^.regs[regcounter].startmod).opcode = A_MOVSX)) and
-             (taicpu(p^.regs[regcounter].startmod).oper[0]^.typ = top_ref) and
-             refsequal(ref,taicpu(p^.regs[regcounter].startmod).oper[0]^.ref^)) then
-        begin
-          optimizable := true;
-          hp := p^.regs[regcounter].startmod;
-        end;
-      if optimizable then
-        if ((t.opsize <> S_B) or
-            not(regcounter in [RS_ESI,RS_EDI])) and
-            sizescompatible(taicpu(hp).opsize,t.opsize) then
-          begin
-            case t.opsize of
-              S_B:
-                begin
-                  memtoreg := newreg(R_INTREGISTER,regcounter,R_SUBL)
-                end;
-              S_W,S_BW:
-                begin
-                  memtoreg := newreg(R_INTREGISTER,regcounter,R_SUBW);
-                  if (t.opsize = S_BW) then
-                      begin
-                        t.opcode := A_MOV;
-                        t.opsize := S_W;
-                      end;
-                end;
-              S_L,S_BL,S_WL:
-                begin
-                  memtoreg := newreg(R_INTREGISTER,regcounter,R_SUBWHOLE);
-                  if (t.opsize <> S_L) then
-                    begin
-                      t.opcode := A_MOV;
-                      t.opsize := S_L;
-                    end;
-                end;
-            end;
-            startp := hp;
-            exit;
-          end;
-    end;
-  memtoreg := NR_NO;
-end;
-
-
-procedure removeLocalStores(const t1: tai);
-{var
-  p: tai;
-  regcount: tregister; }
-begin
-{
-  for regcount := LoGPReg to HiGPReg do
-    if assigned(pTaiProp(t1.optinfo)^.regs[regcount].memwrite) and
-       (taicpu(pTaiProp(t1.optinfo)^.regs[regcount].memwrite).oper[1]^.ref^.base
-         = current_procinfo.framepointer) then
-      begin
-        pTaiProp(pTaiProp(t1.optinfo)^.regs[regcount].memwrite.optinfo)^.canberemoved := true;
-        clearmemwrites(pTaiProp(t1.optinfo)^.regs[regcount].memwrite,regcount);
-      end;
-}
-end;
-
-
-procedure loadcseregs(asml: TAsmList; const reginfo: toptreginfo; curseqend, prevseqstart, curseqstart, curprev: tai; cnt: longint);
-var
-  regsloaded: tregset;
-  regloads, reguses: array[RS_EAX..RS_EDI] of tai;
-  regcounter: tsuperregister;
-  hp, hp2: tai;
-  insertpos, insertoptinfo, prevseq_next: tai;
-  i: longint;
-  opc: tasmop;
-begin
-  regsloaded := [];
-  fillchar(regloads,sizeof(regloads),0);
-  fillchar(reguses,sizeof(reguses),0);
-  getnextinstruction(prevseqstart,prevseq_next);
-  for regcounter := RS_EAX To RS_EDI do
-    if (reginfo.new2oldreg[regcounter] <> RS_INVALID) Then
-      begin
-        include(regsloaded,regcounter);
-        if assigned(ptaiprop(prevseqstart.optinfo)^.Regs[reginfo.new2oldreg[regcounter]].StartMod) then
-          AllocRegBetween(asml,newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBWHOLE),
-            ptaiprop(prevseqstart.optinfo)^.Regs[reginfo.new2oldreg[regcounter]].StartMod,curseqstart,
-            ptaiprop(ptaiprop(prevseqstart.optinfo)^.Regs[reginfo.new2oldreg[regcounter]].StartMod.optinfo)^.usedregs)
-        else
-          AllocRegBetween(asml,newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBWHOLE),
-            prevseqstart,curseqstart,ptaiprop(prevseqstart.optinfo)^.usedregs);
-
-        if curprev <> prevseqstart then
-          begin
-            if assigned(reginfo.lastReload[regCounter]) then
-              getLastInstruction(reginfo.lastReload[regCounter],hp)
-            else if assigned(reginfo.lastReload[reginfo.new2oldreg[regCounter]]) then
-              getLastInstruction(reginfo.lastReload[reginfo.new2OldReg[regCounter]],hp)
-            else
-              hp := curprev;
-            clearRegContentsFrom(asml,regCounter,prevSeq_next,hp);
-            getnextInstruction(hp,hp);
-            allocRegBetween(asml,newreg(R_INTREGISTER,regCounter,R_SUBWHOLE),prevseqstart,hp,
-              ptaiprop(prevseqstart.optinfo)^.usedregs);
-          end;
-        if not(regcounter in reginfo.RegsLoadedforRef) and
-                      {old reg                new reg}
-            (reginfo.new2oldreg[regcounter] <> regcounter) then
-          begin
-            getLastInstruction(curseqend,hp);
-            opc := A_MOV;
-            insertpos := prevseq_next;
-            insertoptinfo := prevseqstart;
-            if assigned(reguses[regcounter]) then
-              if assigned(regloads[reginfo.new2oldreg[regcounter]]) then
-                opc := A_XCHG
-              else
-                begin
-                  insertoptinfo := reguses[regcounter];
-                  insertpos := tai(insertoptinfo.next)
-                end
-            else
-              if assigned(regloads[reginfo.new2oldreg[regcounter]]) then
-                 begin
-                   insertpos := regloads[reginfo.new2oldreg[regcounter]];
-                   if not getlastinstruction(insertpos,insertoptinfo) then
-                     internalerror(2006060701);
-                 end;
-            hp := Tai_Marker.Create(mark_NoPropInfoStart);
-            InsertLLItem(asml, insertpos.previous,insertpos, hp);
-            hp2 := taicpu.Op_Reg_Reg(opc, S_L,
-                                            {old reg                                        new reg}
-                     newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBWHOLE), newreg(R_INTREGISTER,regcounter,R_SUBWHOLE));
-            if (opc = A_XCHG) and
-               (taicpu(regloads[reginfo.new2oldreg[regcounter]]).opcode <> A_XCHG) then
-              begin
-                asml.remove(regloads[reginfo.new2oldreg[regcounter]]);
-                regloads[reginfo.new2oldreg[regcounter]].free;
-                regloads[reginfo.new2oldreg[regcounter]] := hp2;
-                reguses[regcounter] := hp2;
-              end;
-            regloads[regcounter] := hp2;
-            reguses[reginfo.new2oldreg[regcounter]] := hp2;
-            new(ptaiprop(hp2.optinfo));
-            ptaiprop(hp2.optinfo)^ := ptaiprop(insertoptinfo.optinfo)^;
-            ptaiprop(hp2.optinfo)^.canBeRemoved := false;
-            InsertLLItem(asml, insertpos.previous, insertpos, hp2);
-            hp := Tai_Marker.Create(mark_NoPropInfoEnd);
-            InsertLLItem(asml, insertpos.previous, insertpos, hp);
-            { adjusts states in previous instruction so that it will  }
-            { definitely be different from the previous or next state }
-            incstate(ptaiprop(hp2.optinfo)^.
-              regs[reginfo.new2oldreg[regcounter]].rstate,20);
-            incstate(ptaiprop(hp2.optinfo)^.
-              regs[regCounter].wstate,20);
-            updateState(reginfo.new2oldreg[regcounter],hp2);
-            updateState(regcounter,hp2);
-          end
-        else
-  {   imagine the following code:                                            }
-  {        normal                    wrong optimized                         }
-  {    movl 8(%ebp), %eax           movl 8(%ebp), %eax                       }
-  {    movl (%eax), %eax            movl (%eax), %eax                        }
-  {    cmpl 8(%ebp), %eax           cmpl 8(%ebp), %eax                       }
-  {    jne l1                       jne l1                                   }
-  {    movl 8(%ebp), %eax                                                    }
-  {    movl (%eax), %edi            movl %eax, %edi                          }
-  {    movl %edi, -4(%ebp)          movl %edi, -4(%ebp)                      }
-  {    movl 8(%ebp), %eax                                                    }
-  {    pushl 70(%eax)               pushl 70(%eax)                           }
-  {                                                                          }
-  {   The error is that at the moment that the last instruction is executed, }
-  {   %eax doesn't contain 8(%ebp) anymore. Solution: the contents of        }
-  {   registers that are completely removed from a sequence (= registers in  }
-  {   RegLoadedforRef), have to be changed to their contents from before the }
-  {   sequence.                                                              }
-        { if regcounter in reginfo.RegsLoadedforRef then }
-          begin
-            hp := curseqstart;
-            { cnt still holds the number of instructions }
-            { of the sequence, so go to the end of it    }
-            for i := 1 to pred(cnt) do
-              getNextInstruction(hp,hp);
-            { curprev = instruction prior to start of sequence }
-            restoreRegContentsTo(asml,regCounter,
-              ptaiprop(curprev.optinfo)^.Regs[regcounter],
-              curseqstart,hp);
-          end;
-      end;
-end;
-
-
-procedure replaceoperandwithreg(asml: TAsmList; p: tai; opnr: byte; reg: tregister);
-var
-  hp: tai;
-begin
-  { new instruction -> it's info block is not in the big one allocated at the start }
-  hp := Tai_Marker.Create(mark_NoPropInfoStart);
-  InsertLLItem(asml, p.previous,p, hp);
-  { duplicate the original instruction and replace it's designated operant with the register }
-  hp := tai(p.getcopy);
-  taicpu(hp).loadreg(opnr,reg);
-  { add optimizer state info }
-  new(ptaiprop(hp.optinfo));
-  ptaiprop(hp.optinfo)^ := ptaiprop(p.optinfo)^;
-  { new instruction can not be removed }
-  ptaiprop(hp.optinfo)^.canBeRemoved := false;
-  { but the old one can }
-  ptaiprop(p.optinfo)^.canBeRemoved := true;
-  { insert end marker }
-  InsertLLItem(asml, p.previous, p, hp);
-  hp := Tai_Marker.Create(mark_NoPropInfoEnd);
-  InsertLLItem(asml, p.previous, p, hp);
-end;
-
-
-procedure doCSE(asml: TAsmList; First, Last: tai; findPrevSeqs, doSubOpts: boolean);
-{marks the instructions that can be removed by RemoveInstructs. They're not
- removed immediately because sometimes an instruction needs to be checked in
- two different sequences}
-var cnt, cnt2, {cnt3,} orgNrofMods: longint;
-    p, hp1, hp2, hp4, hp5, prevSeq: tai;
-    reginfo: toptreginfo;
-    memreg: tregister;
-    regcounter: tsuperregister;
-begin
-  p := First;
-  SkipHead(p);
-  hp1 := nil;
-  hp2 := nil;
-  hp4 := nil;
-  hp5 := nil;
-  cnt := 0;
-  while (p <> Last) do
-    begin
-      case p.typ of
-        ait_align:
-          if not(tai_align(p).use_op) then
-            SetAlignReg(p);
-        ait_instruction:
-          begin
-            case taicpu(p).opcode of
-{
-     Does not work anymore with register calling because the registers are
-     released before the call
-              A_CALL:
-                for regCounter := RS_EAX to RS_EBX do
-                  removePrevNotUsedLoad(asml,p,regCounter,true);
-}
-              A_CLD: if GetLastInstruction(p, hp1) and
-                        (ptaiprop(hp1.optinfo)^.DirFlag = F_NotSet) then
-                       ptaiprop(tai(p).optinfo)^.CanBeRemoved := True;
-              A_LEA, A_MOV, A_MOVZX, A_MOVSX:
-                begin
-                  hp2 := p;
-                  case taicpu(p).oper[0]^.typ of
-                    top_ref, top_reg:
-                     if (taicpu(p).oper[1]^.typ = top_reg) then
-                       begin
-                        With ptaiprop(p.optinfo)^.Regs[getsupreg(taicpu(p).oper[1]^.reg)] do
-                          begin
-                            if (startmod = p) then
-                              orgNrofMods := nrofMods
-                            else
-                              orgNrofMods := 0;
-                            if (p = StartMod) and
-                               GetLastInstruction (p, hp1) and
-                               not(hp1.typ in [ait_marker,ait_label]) then
-{so we don't try to check a sequence when p is the first instruction of the block}
-                              begin
-{$ifdef csdebug}
-                               hp5 := tai_comment.Create(strpnew(
-                                 'cse checking '+std_regname(taicpu(p).oper[1]^.reg)));
-                               insertLLItem(asml,p,p.next,hp5);
-{$endif csdebug}
-                               if CheckSequence(p,prevSeq,getsupreg(taicpu(p).oper[1]^.reg), Cnt, reginfo, findPrevSeqs) and
-                                  (Cnt > 0) then
-                                 begin
-(*
-                                   hp1 := nil;
-{ although it's perfectly ok to remove an instruction which doesn't contain }
-{ the register that we've just checked (CheckSequence takes care of that),  }
-{ the sequence containing this other register should also be completely     }
-{ checked and removed, otherwise we may get situations like this:           }
-{                                                                           }
-{   movl 12(%ebp), %edx                       movl 12(%ebp), %edx           }
-{   movl 16(%ebp), %eax                       movl 16(%ebp), %eax           }
-{   movl 8(%edx), %edx                        movl 8(%edx), %edx            }
-{   movl (%eax), eax                          movl (%eax), eax              }
-{   cmpl %eax, %edx                           cmpl %eax, %edx               }
-{   jnz  l123           getting converted to  jnz  l123                     }
-{   movl 12(%ebp), %edx                       movl 4(%eax), eax             }
-{   movl 16(%ebp), %eax                                                     }
-{   movl 8(%edx), %edx                                                      }
-{   movl 4(%eax), eax                                                       }
-*)
-
-{ not anymore: if the start of a new sequence is found while checking (e.g. }
-{ above that of eax while checking edx, this new sequence is automatically  }
-{ also checked                                                              }
-                                   Cnt2 := 1;
-                                   while Cnt2 <= Cnt do
-                                     begin
-{$ifndef noremove}
-                                         ptaiprop(p.optinfo)^.CanBeRemoved := True
-{$endif noremove}
-                                       ; inc(Cnt2);
-                                       GetNextInstruction(p, p);
-                                     end;
- {hp4 is used to get the contents of the registers before the sequence}
-                                   GetLastInstruction(hp2, hp4);
-
-{$IfDef CSDebug}
-                                   for regcounter := RS_EAX To RS_EDI do
-                                     if (regcounter in reginfo.RegsLoadedforRef) then
-                                       begin
-                                         hp5 := tai_comment.Create(strpnew('New: '+std_regname(newreg(R_INTREGISTER,regcounter,R_SUBNONE))+', Old: '+
-                                           std_regname(newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBNONE))));
-                                         InsertLLItem(asml, tai(hp2.previous), hp2, hp5);
-                                       end;
-{$EndIf CSDebug}
- { if some registers were different in the old and the new sequence, move }
- { the contents of those old registers to the new ones                    }
-                                   loadcseregs(asml,reginfo,p,prevseq,hp2,hp4,cnt);
-                                   continue;
-                                 end
-                              end;
-                          end;
-                      { try to replace the new reg with the old reg }
-                      if not(ptaiprop(p.optinfo)^.canBeRemoved) then
-                        if (taicpu(p).oper[0]^.typ = top_reg) and
-                           (taicpu(p).oper[1]^.typ = top_reg) and
-                           { only remove if we're not storing something in a regvar }
-                           (getsupreg(taicpu(p).oper[1]^.reg) in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]) and
-{                           (taicpu(p).oper[1]^.reg in (rg.usableregsint+[RS_EDI])) and}
-                           (taicpu(p).opcode = A_MOV) and
-                           getLastInstruction(p,hp4) and
-                          { we only have to start replacing from the instruction after the mov, }
-                          { but replacereg only starts with getnextinstruction(p,p)             }
-                            replaceReg(asml,getsupreg(taicpu(p).oper[0]^.reg),
-                              getsupreg(taicpu(p).oper[1]^.reg),p,p,
-                              ptaiprop(hp4.optinfo)^.regs[getsupreg(taicpu(p).oper[1]^.reg)],false,hp1) then
-                          begin
-                            ptaiprop(p.optinfo)^.canBeRemoved := true;
-                            { this is just a regular move that was here, so the source register should be }
-                            { allocated already at this point -> only allocate from here onwards          }
-                            if not(getsupreg(taicpu(p).oper[0]^.reg) in pTaiProp(p.optinfo)^.usedregs) then
-                              internalerror(2004101011);
-                            allocRegBetween(asml,taicpu(p).oper[0]^.reg,
-                              p,hp1,pTaiProp(p.optinfo)^.usedregs)
-                          end
-                        else
-                          begin
-                             if (taicpu(p).oper[1]^.typ = top_reg) and
-                                not regInOp(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^) then
-                               removePrevNotUsedLoad(asml,p,getsupreg(taicpu(p).oper[1]^.reg),false);
-                             if doSubOpts and
-                                (taicpu(p).opcode <> A_LEA) and
-                                (taicpu(p).oper[0]^.typ = top_ref) then
-                              begin
-                                memreg :=
-                                  memtoreg(taicpu(p),
-                                  taicpu(p).oper[0]^.ref^,hp5);
-                                if memreg <> NR_NO then
-                                  if (taicpu(p).opcode = A_MOV) and
-                                     (taicpu(p).oper[1]^.typ = top_reg) and
-                                     (taicpu(p).oper[1]^.reg = memreg) then
-                                    begin
-                                      pTaiProp(p.optinfo)^.canberemoved := true;
-                                      allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs);
-                                    end
-                                  else
-                                    begin
-                                      replaceoperandwithreg(asml,p,0,memreg);
-                                      allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs);
-                                      regcounter := getsupreg(memreg);
-                                      incstate(pTaiProp(p.optinfo)^.regs[regcounter].rstate,1);
-                                      updatestate(regcounter,p);
-                                    end;
-                              end;
-                          end;
-                        { at first, only try optimizations of large blocks, because doing }
-                        { doing smaller ones may prevent bigger ones from completing in   }
-                        { in the next pass                                                }
-                        if not doSubOpts and (orgNrofMods <> 0) then
-                          begin
-                            p := hp2;
-                            for cnt := 1 to pred(orgNrofMods) do
-                              getNextInstruction(p,p);
-                          end;
-                      end;
-                    top_Const:
-                      begin
-                        case taicpu(p).oper[1]^.typ of
-                          Top_Reg:
-                            begin
-                              regCounter := getsupreg(taicpu(p).oper[1]^.reg);
-                              if GetLastInstruction(p, hp1) then
-                                With ptaiprop(hp1.optinfo)^.Regs[regCounter] do
-                                  if (typ in [con_const,con_noRemoveConst]) and
-                                     (taicpu(startMod).opsize >= taicpu(p).opsize) and
-                                     opsequal(taicpu(StartMod).oper[0]^,taicpu(p).oper[0]^) then
-                                    begin
-                                      ptaiprop(p.optinfo)^.CanBeRemoved := True;
-                                      allocRegBetween(asml,taicpu(p).oper[1]^.reg,startmod,p,
-                                        ptaiprop(startmod.optinfo)^.usedregs);
-                                    end
-                                  else
-                                    removePrevNotUsedLoad(asml,p,getsupreg(taicpu(p).oper[1]^.reg),false);
-
-                            end;
-                          Top_Ref:
-                            if (taicpu(p).oper[0]^.typ = top_const) and
-                               getLastInstruction(p,hp1) and
-                               findRegWithConst(hp1,taicpu(p).opsize,taicpu(p).oper[0]^.val,memreg) then
-                              begin
-                                taicpu(p).loadreg(0,memreg);
-                                { mark the used register as read }
-                                incstate(ptaiprop(p.optinfo)^.
-                                   regs[getsupreg(memreg)].rstate,20);
-                                updateState(getsupreg(memreg),p);
-                                allocRegBetween(asml,memreg,
-                                  ptaiprop(hp1.optinfo)^.regs[getsupreg(memreg)].startMod,p,
-                                  ptaiprop(ptaiprop(hp1.optinfo)^.regs[getsupreg(memreg)].startMod.optinfo)^.usedregs);
-                              end;
-                        end;
-                      end;
-                  end;
-
-                end;
-              A_LEAVE:
-                begin
-                  if getlastinstruction(p,hp1) then
-                    removeLocalStores(hp1);
-                end;
-              A_STD: if GetLastInstruction(p, hp1) and
-                        (ptaiprop(hp1.optinfo)^.DirFlag = F_Set) then
-                        ptaiprop(tai(p).optinfo)^.CanBeRemoved := True;
-              else
-                begin
-                  for cnt := 1 to maxinschanges do
-                    begin
-                      case InsProp[taicpu(p).opcode].Ch[cnt] of
-                        Ch_ROp1:
-                          if (taicpu(p).oper[0]^.typ = top_ref) and
-                             ((taicpu(p).opcode < A_F2XM1) or
-                              ((taicpu(p).opcode > A_IN) and
-                               (taicpu(p).opcode < A_OUT)) or
-                              (taicpu(p).opcode = A_PUSH) or
-                              ((taicpu(p).opcode >= A_RCL) and
-                               (taicpu(p).opcode <= A_XOR))) then
-                            begin
-                              memreg :=
-                                memtoreg(taicpu(p),
-                                taicpu(p).oper[0]^.ref^,hp5);
-                              if memreg <> NR_NO then
-                                begin
-                                  replaceoperandwithreg(asml,p,0,memreg);
-                                  allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs);
-                                  regcounter := getsupreg(memreg);
-                                  incstate(pTaiProp(p.optinfo)^.regs[regcounter].rstate,1);
-                                  updatestate(regcounter,p);
-                                end;
-                            end;
-                        Ch_MOp1:
-                          if not(cs_opt_size in current_settings.optimizerswitches) and
-                             (taicpu(p).oper[0]^.typ = top_ref) then
-                            begin
-                              memreg :=
-                                memtoreg(taicpu(p),
-                                taicpu(p).oper[0]^.ref^,hp5);
-                              if (memreg <> NR_NO) and
-                                 (not getNextInstruction(p,hp1) or
-                                  (RegLoadedWithNewValue(getsupreg(memreg),false,hp1) or
-                                   FindRegDealloc(getsupreg(memreg),hp1))) then
-                                begin
-                                  hp1 := Tai_Marker.Create(mark_NoPropInfoEnd);
-                                  insertllitem(asml,p,p.next,hp1);
-                                  hp1 := taicpu.op_reg_ref(A_MOV,reg2opsize(memreg),
-                                     memreg,taicpu(p).oper[0]^.ref^);
-                                  new(ptaiprop(hp1.optinfo));
-                                  pTaiProp(hp1.optinfo)^ := pTaiProp(p.optinfo)^;
-                                  insertllitem(asml,p,p.next,hp1);
-                                  regcounter := getsupreg(memreg);
-                                  incstate(pTaiProp(hp1.optinfo)^.regs[regcounter].rstate,1);
-                                  updatestate(regcounter,hp1);
-                                  hp1 := Tai_Marker.Create(mark_NoPropInfoStart);
-                                  insertllitem(asml,p,p.next,hp1);
-                                  replaceoperandwithreg(asml,p,0,memreg);
-                                  allocregbetween(asml,memreg,hp5,
-                                    tai(p.next.next),ptaiprop(hp5.optinfo)^.usedregs);
-                                  ClearRegContentsFrom(asml,regcounter,hp5,p);
-                                end;
-                            end;
-                        Ch_ROp2:
-                          if ((taicpu(p).opcode = A_CMP) or
-                              (taicpu(p).opcode = A_TEST)) and
-                             (taicpu(p).oper[1]^.typ = top_ref) then
-                            begin
-                              memreg :=
-                                memtoreg(taicpu(p),
-                                taicpu(p).oper[1]^.ref^,hp5);
-                              if memreg <> NR_NO then
-                                begin
-                                  replaceoperandwithreg(asml,p,1,memreg);
-                                  allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs);
-                                  regcounter := getsupreg(memreg);
-                                  incstate(pTaiProp(p.optinfo)^.regs[regcounter].rstate,1);
-                                  updatestate(regcounter,p);
-                                end;
-                            end;
-                        Ch_MOp2:
-                          if not(cs_opt_size in current_settings.optimizerswitches) and
-                             (taicpu(p).oper[1]^.typ = top_ref) and
-                             ((taicpu(p).opcode < A_BT) or
-                              ((taicpu(p).opcode > A_IN) and
-                               (taicpu(p).opcode < A_OUT)) or
-                              (taicpu(p).opcode = A_PUSH) or
-                              ((taicpu(p).opcode >= A_RCL) and
-                               (taicpu(p).opcode <= A_XOR))) then
-                            begin
-                              memreg :=
-                                memtoreg(taicpu(p),
-                                taicpu(p).oper[1]^.ref^,hp5);
-                              if (memreg <> NR_NO) and
-                                 (not getNextInstruction(p,hp1) or
-                                  (RegLoadedWithNewValue(getsupreg(memreg),false,hp1) or
-                                   FindRegDealloc(getsupreg(memreg),hp1))) then
-                                begin
-                                  hp1 := Tai_Marker.Create(mark_NoPropInfoEnd);
-                                  insertllitem(asml,p,p.next,hp1);
-                                  hp1 := taicpu.op_reg_ref(A_MOV,reg2opsize(memreg),
-                                    memreg,taicpu(p).oper[1]^.ref^);
-                                  new(ptaiprop(hp1.optinfo));
-                                  pTaiProp(hp1.optinfo)^ := pTaiProp(p.optinfo)^;
-                                  insertllitem(asml,p,p.next,hp1);
-                                  regcounter := getsupreg(memreg);
-                                  incstate(pTaiProp(hp1.optinfo)^.regs[regcounter].rstate,1);
-                                  updatestate(regcounter,hp1);
-                                  hp1 := Tai_Marker.Create(mark_NoPropInfoStart);
-                                  insertllitem(asml,p,p.next,hp1);
-                                  replaceoperandwithreg(asml,p,1,memreg);
-                                  allocregbetween(asml,memreg,hp5,
-                                    tai(p.next.next),ptaiprop(hp5.optinfo)^.usedregs);
-                                  ClearRegContentsFrom(asml,regcounter,hp5,p);
-                                end;
-                            end;
-                      end;
-                    end;
-                end;
-            end
-          end;
-      end;
-      GetNextInstruction(p, p);
-    end;
-end;
-
-function removeInstructs(asml: TAsmList; first, last: tai): boolean;
-{ Removes the marked instructions and disposes the PTaiProps of the other }
-{ instructions                                                            }
-var
-  p, hp1: tai;
-  nopropinfolevel: longint;
-begin
-  removeInstructs := false;
-  p := First;
-  nopropinfolevel := 0;
-  while (p <> Last) do
-    begin
-      if (p.typ = ait_marker) and
-         (Tai_marker(p).kind = mark_NoPropInfoStart) then
-        begin
-          hp1 := tai(p.next);
-          asml.remove(p);
-          p.free;
-          nopropinfolevel := 1;
-          while (nopropinfolevel <> 0) do
-            begin
-              p := tai(hp1.next);
-{$ifndef noinstremove}
-              { allocregbetween can insert new ait_regalloc objects }
-              { without optinfo                                     }
-              if (hp1.typ = ait_marker) then
-                begin
-                  case Tai_marker(hp1).kind of
-                    { they can be nested! }
-                    mark_NoPropInfoStart: inc(nopropinfolevel);
-                    mark_NoPropInfoEnd: dec(nopropinfolevel);
-                    else
-                      begin
-                        hp1 := p;
-                        continue;
-                      end;
-                  end;
-                  asml.remove(hp1);
-                  hp1.free;
-                end
-              else if assigned(hp1.optinfo) then
-                if ptaiprop(hp1.optinfo)^.canBeRemoved then
-                  begin
-                    dispose(ptaiprop(hp1.optinfo));
-                    hp1.optinfo := nil;
-                    asml.remove(hp1);
-                    hp1.free;
-                  end
-                else
-{$endif noinstremove}
-                  begin
-                    dispose(ptaiprop(hp1.optinfo));
-                    hp1.optinfo := nil;
-                  end;
-              hp1 := p;
-            end;
-        end
-      else
-{$ifndef noinstremove}
-        if assigned(p.optinfo) and
-              ptaiprop(p.optinfo)^.canBeRemoved then
-          begin
-            hp1 := tai(p.next);
-            asml.Remove(p);
-            p.free;
-            p := hp1;
-            removeInstructs := true;
-          end
-        else
-{$endif noinstremove}
-          begin
-            p.optinfo := nil;
-            p := tai(p.next);
-          end;
-    end;
-end;
-
-function CSE(asml: TAsmList; First, Last: tai; pass: longint): boolean;
-begin
-  doCSE(asml, First, Last, not(cs_opt_level3 in current_settings.optimizerswitches) or (pass >= 2),
-        not(cs_opt_level3 in current_settings.optimizerswitches) or (pass >= 1));
- { register renaming }
-  if not(cs_opt_level3 in current_settings.optimizerswitches) or (pass > 0) then
-    doRenaming(asml, first, last);
-  cse := removeInstructs(asml, first, last);
-end;
-
-end.

compiler/i386/popt386.pas

@@ -58,7 +58,7 @@ begin
           (taicpu(hp1).oper[0]^.reg <> reg))) and
         (taicpu(hp1).oper[1]^.typ = top_reg) and
         (taicpu(hp1).oper[1]^.reg = reg);
-    A_INC,A_DEC:
+    A_INC,A_DEC,A_NEG,A_NOT:
       isFoldableArithOp :=
         (taicpu(hp1).oper[0]^.typ = top_reg) and
         (taicpu(hp1).oper[0]^.reg = reg);
@@ -2282,7 +2282,7 @@ begin
   { to       add/sub/or/... reg2/$const, (ref)    }
                         begin
                           case taicpu(hp1).opcode of
-                            A_INC,A_DEC:
+                            A_INC,A_DEC,A_NOT,A_NEG:
                               taicpu(hp1).loadRef(0,taicpu(p).oper[0]^.ref^);
                             A_LEA:
                               begin

compiler/i386/rropt386.pas

@@ -1,372 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
-      development team
-
-    This unit contains register renaming functionality
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit rropt386;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses aasmbase,aasmtai,aasmdata,aasmcpu;
-
-procedure doRenaming(asml: TAsmList; first, last: tai);
-
-implementation
-
-uses
-  {$ifdef replaceregdebug}cutils,{$endif}
-  verbose,globals,cpubase,daopt386,csopt386,rgobj,
-  cgbase,cgutils,cgobj;
-
-function canBeFirstSwitch(p: taicpu; supreg: tsuperregister): boolean;
-{ checks whether an operation on reg can be switched to another reg without an }
-{ additional mov, e.g. "addl $4,%reg1" can be changed to "leal 4(%reg1),%reg2" }
-begin
-  canBeFirstSwitch := false;
-  case p.opcode of
-    A_MOV,A_MOVZX,A_MOVSX,A_LEA:
-      canBeFirstSwitch :=
-        (p.oper[1]^.typ = top_reg) and
-        (getsupreg(p.oper[1]^.reg) = supreg);
-    A_IMUL:
-      canBeFirstSwitch :=
-        (p.ops >= 2) and
-        (p.oper[0]^.typ = top_const) and
-        (getsupreg(p.oper[p.ops-1]^.reg) = supreg) and
-        (not pTaiprop(p.optinfo)^.FlagsUsed);
-    A_INC,A_DEC:
-      canBeFirstSwitch :=
-        (p.oper[0]^.typ = top_reg) and
-        (p.opsize = S_L) and
-        (not pTaiprop(p.optinfo)^.FlagsUsed);
-    A_SUB,A_ADD:
-      canBeFirstSwitch :=
-        (p.oper[1]^.typ = top_reg) and
-        (p.opsize = S_L) and
-        (getsupreg(p.oper[1]^.reg) = supreg) and
-        (p.oper[0]^.typ <> top_ref) and
-        ((p.opcode <> A_SUB) or
-         (p.oper[0]^.typ = top_const)) and
-        (not pTaiprop(p.optinfo)^.FlagsUsed);
-    A_SHL:
-      canBeFirstSwitch :=
-        (p.opsize = S_L) and
-        (p.oper[1]^.typ = top_reg) and
-        (getsupreg(p.oper[1]^.reg) = supreg) and
-        (p.oper[0]^.typ = top_const) and
-        (p.oper[0]^.val in [1,2,3]) and
-        (not pTaiprop(p.optinfo)^.FlagsUsed);
-  end;
-end;
-
-
-procedure switchReg(var reg: tregister; reg1, reg2: tsuperregister);
-var
-  supreg: tsuperregister;
-begin
-  if (reg = NR_NO) or
-     (getregtype(reg) <> R_INTREGISTER) then
-    exit;
-  supreg := getsupreg(reg);
-  if (supreg = reg1) then
-    setsupreg(reg,reg2)
-  else if (supreg = reg2) then
-    setsupreg(reg,reg1);
-end;
-
-
-procedure switchOp(var op: toper; reg1, reg2: tsuperregister);
-begin
-  case op.typ of
-    top_reg:
-      switchReg(op.reg,reg1,reg2);
-    top_ref:
-      begin
-        switchReg(op.ref^.base,reg1,reg2);
-        switchReg(op.ref^.index,reg1,reg2);
-      end;
-  end;
-end;
-
-
-procedure doSwitchReg(hp: taicpu; reg1,reg2: tsuperregister);
-var
-  opCount: longint;
-begin
-  for opCount := 0 to hp.ops-1 do
-    switchOp(hp.oper[opCount]^,reg1,reg2);
-end;
-
-
-procedure doFirstSwitch(p: taicpu; reg1, reg2: tsuperregister);
-var
-  tmpRef: treference;
-begin
-  case p.opcode of
-    A_MOV,A_MOVZX,A_MOVSX,A_LEA:
-       begin
-         changeOp(p.oper[1]^,reg1,reg2);
-         changeOp(p.oper[0]^,reg2,reg1);
-       end;
-    A_IMUL:
-      begin
-        p.ops := 3;
-        p.loadreg(2,newreg(R_INTREGISTER,reg2,R_SUBWHOLE));
-        changeOp(p.oper[1]^,reg2,reg1);
-      end;
-    A_INC,A_DEC:
-      begin
-        reference_reset(tmpref,1);
-        tmpref.base := newreg(R_INTREGISTER,reg1,R_SUBWHOLE);
-        case p.opcode of
-          A_INC:
-            tmpref.offset := 1;
-          A_DEC:
-            tmpref.offset := -1;
-        end;
-        p.ops := 2;
-        p.opcode := A_LEA;
-        p.loadreg(1,newreg(R_INTREGISTER,reg2,R_SUBWHOLE));
-        p.loadref(0,tmpref);
-      end;
-    A_SUB,A_ADD:
-      begin
-        reference_reset(tmpref,1);
-        tmpref.base := newreg(R_INTREGISTER,reg1,R_SUBWHOLE);
-        case p.oper[0]^.typ of
-          top_const:
-            begin
-              tmpref.offset := longint(p.oper[0]^.val);
-              if p.opcode = A_SUB then
-                tmpref.offset := - tmpRef.offset;
-            end;
-          top_ref:
-            if (p.oper[0]^.ref^.refaddr=addr_full) then
-              tmpref.symbol := p.oper[0]^.ref^.symbol
-            else
-              internalerror(200402263);
-          top_reg:
-            begin
-              { "addl %reg2,%reg1" must become "leal (%reg1,%reg1),%reg2" }
-              { since at this point reg1 holds the value that reg2 would  }
-              { otherwise contain                                         }
-              tmpref.index := p.oper[0]^.reg;
-              if (getsupreg(tmpref.index)=reg2) then
-                setsupreg(tmpref.index,reg1);
-              tmpref.scalefactor := 1;
-            end;
-          else internalerror(200010031);
-        end;
-        p.opcode := A_LEA;
-        p.loadref(0,tmpref);
-        p.loadreg(1,newreg(R_INTREGISTER,reg2,R_SUBWHOLE));
-      end;
-    A_SHL:
-      begin
-        reference_reset(tmpref,2);
-        tmpref.index := newreg(R_INTREGISTER,reg1,R_SUBWHOLE);
-        tmpref.scalefactor := 1 shl p.oper[0]^.val;
-        p.opcode := A_LEA;
-        p.loadref(0,tmpref);
-        p.loadreg(1,newreg(R_INTREGISTER,reg2,R_SUBWHOLE));
-      end;
-    else internalerror(200010032);
-  end;
-end;
-
-
-function switchRegs(asml: TAsmList; reg1, reg2: tsuperregister; start: tai): Boolean;
-{ change movl  %reg1,%reg2 ... bla ... to ... bla with reg1 and reg2 switched }
-var
-  endP, hp, lastreg1,lastreg2: tai;
-  switchDone, switchLast, tmpResult, sequenceEnd, reg1Modified, reg2Modified: boolean;
-  reg1StillUsed, reg2StillUsed, isInstruction: boolean;
-begin
-  switchRegs := false;
-  tmpResult := true;
-  sequenceEnd := false;
-  reg1Modified := false;
-  reg2Modified := false;
-  switchLast := false;
-  endP := start;
-  while tmpResult and not sequenceEnd do
-    begin
-      tmpResult :=
-        getNextInstruction(endP,endP);
-      If tmpResult and
-         not pTaiprop(endp.optinfo)^.canBeRemoved then
-        begin
-          { if the newReg gets stored back to the oldReg, we can change }
-          { "mov %oldReg,%newReg; <operations on %newReg>; mov %newReg, }
-          { %oldReg" to "<operations on %oldReg>"                       }
-          switchLast := storeBack(start,endP,reg1,reg2);
-          reg1StillUsed := reg1 in pTaiprop(endp.optinfo)^.usedregs;
-          reg2StillUsed := reg2 in pTaiprop(endp.optinfo)^.usedregs;
-          isInstruction := endp.typ = ait_instruction;
-          sequenceEnd :=
-            switchLast or
-            { if both registers are released right before an instruction }
-            { that contains hardcoded regs, it's ok too                  }
-            (not reg1StillUsed and not reg2StillUsed) or
-            { no support for (i)div, mul and imul with hardcoded operands }
-            (((not isInstruction) or
-              noHardCodedRegs(taicpu(endP),reg1,reg2)) and
-             (not reg1StillUsed or
-              (isInstruction and findRegDealloc(reg1,endP) and
-               regLoadedWithNewValue(reg1,false,taicpu(endP)))) and
-             (not reg2StillUsed or
-              (isInstruction and findRegDealloc(reg2,endP) and
-               regLoadedWithNewValue(reg2,false,taicpu(endP)))));
-
-          { we can't switch reg1 and reg2 in something like }
-          {   movl  %reg1,%reg2                             }
-          {   movl  (%reg2),%reg2                           }
-          {   movl  4(%reg1),%reg1                          }
-          if reg2Modified and not(reg1Modified) and
-             regReadByInstruction(reg1,endP) then
-            begin
-              tmpResult := false;
-              break
-            end;
-
-          if not reg1Modified then
-            begin
-              reg1Modified := regModifiedByInstruction(reg1,endP);
-              if reg1Modified and not canBeFirstSwitch(taicpu(endP),reg1) then
-                begin
-                  tmpResult := false;
-                  break;
-                end;
-            end;
-          if not reg2Modified then
-            reg2Modified := regModifiedByInstruction(reg2,endP);
-
-          tmpResult :=
-            ((not isInstruction) or
-             (NoHardCodedRegs(taicpu(endP),reg1,reg2) and
-              RegSizesOk(reg1,reg2,taicpu(endP))));
-
-          if sequenceEnd then
-            break;
-
-          tmpResult :=
-            tmpresult and
-            (endp.typ <> ait_label) and
-            ((not isInstruction) or
-             (not taicpu(endp).is_jmp));
-        end;
-    end;
-
-  if tmpResult and sequenceEnd then
-    begin
-      switchRegs := true;
-      reg1Modified := false;
-      reg2Modified := false;
-      lastreg1 := start;
-      lastreg2 := start;
-      getNextInstruction(start,hp);
-      while hp <> endP do
-        begin
-          if (not pTaiprop(hp.optinfo)^.canberemoved) and
-             (hp.typ = ait_instruction) then
-            begin
-              switchDone := false;
-              if not reg1Modified then
-                begin
-                  reg1Modified := regModifiedByInstruction(reg1,hp);
-                  if reg1Modified then
-                    begin
-                      doFirstSwitch(taicpu(hp),reg1,reg2);
-                      switchDone := true;
-                    end;
-                end;
-              if not switchDone then
-                if reg1Modified then
-                  doSwitchReg(taicpu(hp),reg1,reg2)
-                else
-                  doReplaceReg(taicpu(hp),reg2,reg1);
-            end;
-          if regininstruction(reg1,hp) then
-             lastreg1 := hp;
-          if regininstruction(reg2,hp) then
-             lastreg2 := hp;
-          getNextInstruction(hp,hp);
-        end;
-      if switchLast then
-        begin
-          lastreg1 := hp;
-          lastreg2 := hp;
-          { this is in case of a storeback, make sure the same size of register }
-          { contents as the initial move is transfered                          }
-          doSwitchReg(taicpu(hp),reg1,reg2);
-          if taicpu(hp).opsize <> taicpu(start).opsize then
-            begin
-              taicpu(hp).opsize := taicpu(start).opsize;
-              taicpu(hp).oper[0]^.reg := taicpu(start).oper[0]^.reg;
-              taicpu(hp).oper[1]^.reg := taicpu(start).oper[1]^.reg;
-            end;
-        end
-      else
-        getLastInstruction(hp,hp);
-      allocRegBetween(asmL,newreg(R_INTREGISTER,reg1,R_SUBWHOLE),start,lastreg1,
-        ptaiprop(start.optinfo)^.usedregs);
-      allocRegBetween(asmL,newreg(R_INTREGISTER,reg2,R_SUBWHOLE),start,lastreg2,
-        ptaiprop(start.optinfo)^.usedregs);
-    end;
-end;
-
-
-procedure doRenaming(asml: TAsmList; first, last: tai);
-var
-  p: tai;
-begin
-  p := First;
-  SkipHead(p);
-  while p <> last do
-    begin
-      case p.typ of
-        ait_instruction:
-          begin
-            case taicpu(p).opcode of
-              A_MOV:
-                begin
-                  if not(pTaiprop(p.optinfo)^.canBeRemoved) and
-                     (taicpu(p).oper[0]^.typ = top_reg) and
-                     (taicpu(p).oper[1]^.typ = top_reg) and
-                     (taicpu(p).opsize = S_L) and
-                     (getsupreg(taicpu(p).oper[0]^.reg) in ([RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI])) and
-                     (getsupreg(taicpu(p).oper[1]^.reg) in ([RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI])) then
-                    if switchRegs(asml,getsupreg(taicpu(p).oper[0]^.reg),
-                         getsupreg(taicpu(p).oper[1]^.reg),p) then
-                      begin
-                        pTaiprop(p.optinfo)^.canBeRemoved := true;
-                      end;
-                end;
-            end;
-          end;
-      end;
-      getNextInstruction(p,p);
-    end;
-end;
-
-
-End.

compiler/i386/symcpu.pas

@@ -124,6 +124,10 @@ type
   end;
   tcpuunitsymclass = class of tcpuunitsym;
 
+  tcpuprogramparasym = class(tprogramparasym)
+  end;
+  tcpuprogramparasymclass = class(tprogramparasym);
+
   tcpunamespacesym = class(tnamespacesym)
   end;
   tcpunamespacesymclass = class of tcpunamespacesym;
@@ -250,6 +254,7 @@ begin
   { used tsym classes }
   clabelsym:=tcpulabelsym;
   cunitsym:=tcpuunitsym;
+  cprogramparasym:=tcpuprogramparasym;
   cnamespacesym:=tcpunamespacesym;
   cprocsym:=tcpuprocsym;
   ctypesym:=tcputypesym;
@@ -262,7 +267,5 @@ begin
   cconstsym:=tcpuconstsym;
   cenumsym:=tcpuenumsym;
   csyssym:=tcpusyssym;
-
-  cPtrDefHashSet:=tx86PtrDefHashSet;
 end.
 

compiler/i8086/cpuinfo.pas

@@ -139,7 +139,7 @@ Const
                                  { no need to write info about those }
                                  [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
                                  [cs_opt_peephole,cs_opt_regvar,cs_opt_stackframe,
-                                  cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain,
+                                  cs_opt_loopunroll,cs_opt_uncertain,
                                   cs_opt_tailrecursion,cs_opt_nodecse,cs_useebp,
 				  cs_opt_reorder_fields,cs_opt_fastmath];
 

compiler/i8086/cpupara.pas

@@ -236,7 +236,7 @@ unit cpupara;
         psym:=tparavarsym(pd.paras[nr-1]);
         pdef:=psym.vardef;
         if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
-          pdef:=getpointerdef(pdef);
+          pdef:=cpointerdef.getreusable(pdef);
         cgpara.reset;
         cgpara.size:=def_cgsize(pdef);
         cgpara.intsize:=tcgsize2size[cgpara.size];
@@ -442,7 +442,7 @@ unit cpupara;
               begin
                 paralen:=voidpointertype.size;
                 paracgsize:=int_cgsize(voidpointertype.size);
-                paradef:=getpointerdef(paradef);
+                paradef:=cpointerdef.getreusable(paradef);
               end
             else
               begin
@@ -602,7 +602,7 @@ unit cpupara;
                       begin
                         paralen:=voidpointertype.size;
                         paracgsize:=int_cgsize(voidpointertype.size);
-                        paradef:=getpointerdef(paradef);
+                        paradef:=cpointerdef.getreusable(paradef);
                       end
                     else
                       begin
@@ -629,7 +629,8 @@ unit cpupara;
                     if (parareg<=high(parasupregs)) and
                        (paralen<=sizeof(aint)) and
                        (not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
-                        pushaddr) and
+                        pushaddr or
+                        is_dynamic_array(hp.vardef)) and
                        (not(vo_is_parentfp in hp.varoptions) or
                         not(po_delphi_nested_cc in p.procoptions)) then
                       begin

compiler/i8086/cpupi.pas

@@ -32,10 +32,14 @@ unit cpupi;
 
     type
        ti8086procinfo = class(tcgprocinfo)
+       private
+         procedure insert_8087_fwaits(list : TAsmList);
+       public
          constructor create(aparent:tprocinfo);override;
          procedure set_first_temp_offset;override;
          function calc_stackframe_size:longint;override;
          procedure generate_parameter_info;override;
+         procedure postprocess_code;override;
        end;
 
 
@@ -44,8 +48,9 @@ unit cpupi;
     uses
       cutils,
       systems,globals,globtype,
+      aasmtai,aasmcpu,
       cgobj,tgobj,paramgr,
-      cpubase,
+      cpubase,cpuinfo,
       cgutils,
       symconst;
 
@@ -95,6 +100,31 @@ unit cpupi;
           para_stack_size := 0;
       end;
 
+
+    procedure ti8086procinfo.insert_8087_fwaits(list : TAsmList);
+      var
+        curtai: tai;
+      begin
+        curtai:=tai(list.First);
+        while assigned(curtai) do
+          begin
+            if (curtai.typ=ait_instruction)
+               and requires_fwait_on_8087(taicpu(curtai).opcode) then
+              list.InsertBefore(taicpu.op_none(A_FWAIT),curtai);
+
+            curtai:=tai(curtai.Next);
+          end;
+      end;
+
+
+    procedure ti8086procinfo.postprocess_code;
+      begin
+        { nickysn note: I don't know if the 187 requires FWAIT before
+          every instruction like the 8087, so I'm including it just in case }
+        if current_settings.cputype<=cpu_186 then
+          insert_8087_fwaits(aktproccode);
+      end;
+
 begin
    cprocinfo:=ti8086procinfo;
 end.

compiler/i8086/hlcgcpu.pas

@@ -353,7 +353,8 @@ implementation
       cg.a_loadaddr_ref_reg(list, tmpref, r);
 
       { step 2: if destination is a far pointer, we have to pass a segment as well }
-      if is_farpointer(tosize) or is_hugepointer(tosize) or is_farprocvar(tosize) then
+      if is_farpointer(tosize) or is_hugepointer(tosize) or is_farprocvar(tosize) or
+         ((tosize.typ=classrefdef) and (tosize.size=4)) then
         begin
           { if a segment register is specified in ref, we use that }
           if ref.segment<>NR_NO then

compiler/i8086/i8086nop.inc

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

compiler/i8086/i8086tab.inc

@@ -5950,6 +5950,13 @@
     code    : #208#1#15#11#128#52;
     flags   : if_386 or if_pass2
   ),
+  (
+    opcode  : A_Jcc;
+    ops     : 1;
+    optypes : (ot_immediate or ot_bits16,ot_none,ot_none,ot_none);
+    code    : #19#112#1#3#1#233#48;
+    flags   : if_8086 or if_pass2 or if_16bitonly
+  ),
   (
     opcode  : A_Jcc;
     ops     : 1;
@@ -5964,6 +5971,13 @@
     code    : #208#1#15#11#128#52;
     flags   : if_386 or if_pass2
   ),
+  (
+    opcode  : A_Jcc;
+    ops     : 1;
+    optypes : (ot_immediate or ot_bits16 or ot_near,ot_none,ot_none,ot_none);
+    code    : #19#112#1#3#1#233#48;
+    flags   : if_8086 or if_pass2 or if_16bitonly
+  ),
   (
     opcode  : A_SETcc;
     ops     : 1;

compiler/i8086/n8086mem.pas

@@ -199,7 +199,7 @@ implementation
             result:=ccallnode.createintern(procname,
               ccallparanode.create(right,
               ccallparanode.create(ttypeconvnode(left).left,nil)));
-            inserttypeconv_internal(result,getx86pointerdef(arraydef.elementdef,x86pt_huge));
+            inserttypeconv_internal(result,tx86pointerdef(cpointerdef).getreusablex86(arraydef.elementdef,x86pt_huge));
             result:=cderefnode.create(result);
 
             ttypeconvnode(left).left:=nil;

compiler/i8086/symcpu.pas

@@ -57,6 +57,7 @@ type
 
   tcpupointerdef = class(tx86pointerdef)
     class function default_x86_data_pointer_type: tx86pointertyp; override;
+    function alignment:shortint;override;
     function pointer_arithmetic_int_type:tdef; override;
     function pointer_subtraction_result_type:tdef; override;
   end;
@@ -75,6 +76,7 @@ type
   tcpuobjectdefclass = class of tcpuobjectdef;
 
   tcpuclassrefdef = class(tclassrefdef)
+    function alignment:shortint;override;
   end;
   tcpuclassrefdefclass = class of tcpuclassrefdef;
 
@@ -151,6 +153,10 @@ type
   end;
   tcpuunitsymclass = class of tcpuunitsym;
 
+  tcpuprogramparasym = class(tprogramparasym)
+  end;
+  tcpuprogramparasymclass = class(tprogramparasym);
+
   tcpunamespacesym = class(tnamespacesym)
   end;
   tcpunamespacesymclass = class of tcpunamespacesym;
@@ -254,6 +260,15 @@ implementation
       result:=(p.typ=pointerdef) and (tcpupointerdef(p).x86pointertyp=x86pt_huge);
     end;
 
+{****************************************************************************
+                               tcpuclassrefdef
+****************************************************************************}
+
+  function tcpuclassrefdef.alignment:shortint;
+    begin
+      Result:=2;
+    end;
+
 {****************************************************************************
                                tcpuarraydef
 ****************************************************************************}
@@ -408,6 +423,14 @@ implementation
       end;
 
 
+    function tcpupointerdef.alignment:shortint;
+      begin
+        { on i8086, we use 16-bit alignment for all pointer types, even far and
+          huge (which are 4 bytes long) }
+        result:=2;
+      end;
+
+
     function tcpupointerdef.pointer_arithmetic_int_type:tdef;
       begin
         if x86pointertyp=x86pt_huge then
@@ -474,6 +497,7 @@ begin
   { used tsym classes }
   clabelsym:=tcpulabelsym;
   cunitsym:=tcpuunitsym;
+  cprogramparasym:=tcpuprogramparasym;
   cnamespacesym:=tcpunamespacesym;
   cprocsym:=tcpuprocsym;
   ctypesym:=tcputypesym;
@@ -486,7 +510,5 @@ begin
   cconstsym:=tcpuconstsym;
   cenumsym:=tcpuenumsym;
   csyssym:=tcpusyssym;
-
-  cPtrDefHashSet:=tx86PtrDefHashSet;
 end.
 

compiler/ia64/aasmcpu.pas

@@ -1,287 +0,0 @@
-{
-    Copyright (c) 2000-2006 by Florian Klaempfl
-
-    Contains the assembler object for the ia64
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit aasmcpu;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  globals,verbose,
-  aasmbase,aasmtai,
-  cpubase,
-  cgutils;
-
-
-type
-  pairegalloc = ^tairegalloc;
-  tairegalloc = class(tai)
-     allocation : boolean;
-     reg        : tregister;
-     constructor alloc(r : tregister);
-     constructor dealloc(r : tregister);
-  end;
-
-  { Types of operand }
-  toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_qp);
-
-  paicpu = ^taicpu;
-  taicpu = class(tai)
-     is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
-     opcode    : tasmop;
-     ops       : array[0..4] of longint;
-     oper      : longint;
-     qp        : tqp;
-     ldsttype  : tldsttype;
-     hint      : thint;
-     { ALU instructions }
-     { A1,A9: integer ALU }
-     constructor op_reg_reg_reg(op : tasmop;const r1,r2,r3 : tregister);
-     { A2,A10: shift left and add }
-     constructor op_reg_reg_const_reg(_qp : tqp;op : tasmop;
-       const r1,r2 : tregister;i : byte;const r3 : tregister);
-     { A3,A4,A5: integer ALU - imm.,register }
-     constructor op_reg_const_reg(_qp : tqp;op : tasmop;
-       const r1 : tregister;i : longint;const r3 : tregister);
-     { A6,A7: integer compare - register,register }
-     constructor op_preg_preg_reg_reg(_qp : tqp;op : tasmop;
-       cond : tasmcond;p1,p2 : tqp;const r2,r3 : tregister);
-     { A8: integer compare - imm.,register }
-     constructor op_preg_preg_const_reg(_qp : tqp;op : tasmop;
-       cond : tasmcond;p1,p2 : tqp;i : longint;const r3 : tregister);
-(*!!!!!!!
-     { multimedia shift and multiply }
-     constructor op_reg_reg_reg_const(_qp : tqp;
-     { multimedia mux }
-     constructor op_reg_reg_mbtype(_qp : tqp;
-     { multimedia shift fixed }
-     constructor op_reg_reg_const(_qp : tqp;
-     { div. }
-     constructor op_reg_reg(_qp : tqp;
-     { mm extract }
-     constructor op_reg_reg_const_const(_qp : tqp;
-     { zero and deposit imm }
-     constructor op_reg_const_const_const(_qp : tqp;
-     { deposit imm }
-     constructor op_reg_const_reg_const_const(_qp : tqp;
-     { deposit }
-     constructor op_reg_reg_reg_const_const(_qp : tqp;
-     { test bit }
-     { !!!! here we need also to take care of the postfix }
-     constructor op_preg_preg_reg_const(_qp : tqp;
-     { test NaT }
-     { !!!! here we need also to take care of the postfix }
-     constructor op_preg_preg_reg(_qp : tqp;
-
-     { -------- here are some missed ----------- }
- *)
-
-     { M1: integer load }
-     { M4: integer store }
-     { M6: floating-point load }
-     { M9: floating-point store }
-     constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
-       _hint : thint;const r1 : tregister;ref : treference);
-
-     { M2: integer load incremented by register }
-     { M7: floating-point load incremented by register }
-     constructor op_reg_ref_reg(_qp : tqp;op : tasmop;postfix : tldsttype;
-       _hint : thint;const r1 : tregister;const ref : treference;
-       const r2 : tregister);
-
-     { M3: integer load increment by imm. }
-     { M5: integer store increment by imm. }
-     { M8: floating-point load increment by imm. }
-     { M10: floating-point store increment by imm. }
-     constructor op_reg_ref_const(_qp : tqp;op : tasmop;postfix : tldsttype;
-       _hint : thint;const r1 : tregister;ref : treference;i : longint);
-
-     { M11: floating-point load pair}
-     constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
-       _hint : thint;const r1,r2 : tregister;ref : treference);
-
-     { M12: floating-point load pair increment by imm. }
-     constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
-       _hint : thint;const r1,r2 : tregister;ref : treference;i : longint);
-
-     { X1: break/nop }
-     constructor op_const62(_qp : tqp;op : tasmop;i : int64);
-     { X2: move imm64 }
-     constructor op_reg_const64(_qp : tqp;op : tasmop;const r1 : tregister;
-       i : int64);
-  end;
-
-  { the following objects are special for the ia64 }
-  { they decribe a stop and the bundles            }
-  paistop = ^taistop;
-  taistop = class(tai)
-    constructor init;
-  end;
-
-  { a second underscro indicates a stop }
-  tbundletemplate = (but_none,but_mii,but_mii_,
-    but_mi_i,but_mi_i_,but_mlx,but_mlx_,
-    but_mmi,but_mmi_,but_m_mi,but_m_mi_,
-    but_mfi,but_mfi_,but_mmf,but_mmf_,
-    but_mif,but_mib_,but_mbb,but_mbb_,
-    but_bbb,but_bbb_,but_mmb,but_mmb_,
-    but_mfb,but_mfb_);
-
-  paibundle = ^taibundle;
-  taibundle = class(tai)
-     template : tbundletemplate;
-     instructions : array[0..1] of paicpu;
-  end;
-
-implementation
-
-
-{*****************************************************************************
-                                 TaiStop
-*****************************************************************************}
-
-    constructor taistop.init;
-
-      begin
-         inherited create;
-         typ:=ait_stop;
-      end;
-
-
-{*****************************************************************************
-                                 TaiRegAlloc
-*****************************************************************************}
-
-    constructor tairegalloc.alloc(r : tregister);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        allocation:=true;
-        reg:=r;
-      end;
-
-
-    constructor tairegalloc.dealloc(r : tregister);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        allocation:=false;
-        reg:=r;
-      end;
-
-
-{*****************************************************************************
-                                 Taicpu
-*****************************************************************************}
-
-    { ALU instructions }
-    { A1,A9: integer ALU }
-    constructor taicpu.op_reg_reg_reg(op : tasmop;const r1,r2,r3 : tregister);
-
-      begin
-      end;
-
-    { A2,A10: shift left and add }
-    constructor taicpu.op_reg_reg_const_reg(_qp : tqp;op : tasmop;
-      const r1,r2 : tregister;i : byte;const r3 : tregister);
-
-      begin
-      end;
-
-    { A3,A4,A5: integer ALU - imm.,register }
-    constructor taicpu.op_reg_const_reg(_qp : tqp;op : tasmop;
-      const r1 : tregister;i : longint;const r3 : tregister);
-
-      begin
-      end;
-
-    { A6,A7: integer compare - register,register }
-    constructor taicpu.op_preg_preg_reg_reg(_qp : tqp;op : tasmop;
-      cond : tasmcond;p1,p2 : tqp;const r2,r3 : tregister);
-
-      begin
-      end;
-
-    { A8: integer compare - imm.,register }
-    constructor taicpu.op_preg_preg_const_reg(_qp : tqp;op : tasmop;
-      cond : tasmcond;p1,p2 : tqp;i : longint;const r3 : tregister);
-
-      begin
-      end;
-
-    { M1: integer load }
-    { M4: integer store }
-    { M6: floating-point load }
-    { M9: floating-point store }
-    constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
-      _hint : thint;const r1 : tregister;ref : treference);
-
-      begin
-      end;
-
-    { M2: integer load incremented by register }
-    { M7: floating-point load incremented by register }
-    constructor taicpu.op_reg_ref_reg(_qp : tqp;op : tasmop;postfix : tldsttype;
-      _hint : thint;const r1 : tregister;const ref : treference;
-      const r2 : tregister);
-
-      begin
-      end;
-
-    { M3: integer load increment by imm. }
-    { M5: integer store increment by imm. }
-    { M8: floating-point load increment by imm. }
-    { M10: floating-point store increment by imm. }
-    constructor taicpu.op_reg_ref_const(_qp : tqp;op : tasmop;postfix : tldsttype;
-      _hint : thint;const r1 : tregister;ref : treference;i : longint);
-
-      begin
-      end;
-
-    { M11: floating-point load pair}
-    constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
-      _hint : thint;const r1,r2 : tregister;ref : treference);
-
-      begin
-      end;
-
-    { M12: floating-point load pair increment by imm. }
-    constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype;
-      _hint : thint;const r1,r2 : tregister;ref : treference;i : longint);
-
-      begin
-      end;
-
-    { X1: break/nop }
-    constructor taicpu.op_const62(_qp : tqp;op : tasmop;i : int64);
-    { X2: move imm64 }
-
-      begin
-      end;
-
-    constructor taicpu.op_reg_const64(_qp : tqp;op : tasmop;const r1 : tregister;
-      i : int64);
-
-      begin
-      end;
-
-end.

compiler/ia64/cpubase.pas

@@ -1,150 +0,0 @@
-{
-    Copyright (C) 2000-2006 by Florian Klaempfl
-
-    this unit implements the base types for the iA-64 architecture
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit cpubase;
-
-  interface
-
-    uses
-       cutils,
-       globals,
-       systems,
-       cpuinfo,
-       cgbase;
-
-type
-  tasmop = (A_ADD,A_SUB,A_ADDP4,A_AND,A_ANDCM,A_OR,A_XOR,A_SHLADD,
-            A_SHLADDP4,A_ADDS,A_ADDL,A_CMP,A_CMP4,A_PADD1,A_PADD2,
-            A_PADD4,A_PSUB1,A_PSUB2,A_PSUB4,A_PAVG1,A_PAVG2,A_PAVGSUB1,
-            A_PAVGSUB2,A_PCMP1,A_PCMP2,A_PCMP4,A_PSHLADD2,A_PSHRADD2,
-            A_PMPY2,A_MIX1,A_MIX2,A_MIX4,A_PACK2,A_PACK4,A_UNPACK2,
-            A_UNPACK4,A_PMIN1,A_PMAX1,A_PMIN2,A_PMAX2,A_PSAD1,A_MUX1,
-            A_MUX2,A_PSHR2,A_PSHR4,A_SHR,A_PSHL2,A_SHL4,A_SHL,
-            A_POPCNT,A_SHRP,A_EXTR,A_DEP,A_TBIT,A_TNAT,A_BREAK,
-            A_NOP,A_CHK,A_MOV,A_ZX1,A_ZX2,A_ZXT4,A_SXT1,A_SXT2,A_SXT4,
-            A_CXZ1,A_CZX2,A_LD1,A_LD2,A_LD4,A_LD8,A_ST1,A_ST2,A_ST4,
-            A_ST8,A_LDFS,A_LDFD,A_LDF8,A_LDFE,A_LDF,A_STFS,A_STFD,A_STF8,
-            A_STFE,A_STF,A_LDFPS,A_LDFPD,A_LDFP8,A_LFETCH,A_CMPXCHG1,
-            A_CMPXCHG2,A_CMPXHG4,A_CMPXCHG8,A_XCHG1,A_XCHG2,A_XCHG4,
-            A_XCHG8,A_FETCHADD4,A_FETCHADD8,A_SETF,A_GETF,
-            A_INVALA,A_MF,A_SRLZ,A_SYNC,A_FLUSHRS,A_FC,A_ALLOC,A_SUM,
-            A_RUM,A_BR,A_CLRRRB,A_FMA,A_FPMA,A_FMS,A_FPMS,A_FNMA,A_FPNMA,
-            A_XMA,A_FSELECT,A_FCLASS,A_FRCPA,A_FPRCPA,A_FRSQRTA,
-            A_FPRSQRTA,A_FMIN,A_FMAX,A_FAMIN,A_FAMAX,A_FPMIN,A_FPMAX,
-            A_FPAMIN,A_FPAMAX,A_FPCMP,A_FMERGE,A_FMIX,A_FSXT,A_FPACK,
-            A_FSWAP,A_FAND,A_FANDCM,A_FOR,A_FXOR,A_FPMERGE,A_FCVT,
-            A_FPCVT,A_FSETC,A_FCLRT,A_FCHKF,A_MOVL);
-
-Const
-  firstop = low(tasmop);
-  lastop  = high(tasmop);
-
-type
-  TAsmCond = (C_NONE,C_LT,C_LTU,C_EQ,C_LT_UNC,C_LTU_UNC,C_EQ_UNC,
-              C_EQ_AND,C_EQ_OR,C_EQ_OR_ANDCM,C_NE_AND,C_NE_OR);
-
-  THint = (H_NONE,H_NT1,H_NT2,H_NTA);
-  TLdStType = (LST_NONE,LST_S,LST_A,LSR_SA,LST_BIAS,LST_ACQ,LST_C_CLR,
-               LST_FILL,LST_C_NC,LST_C_CLR_ACQ,LST_REL,
-               LST_SPILL);
-
-{*****************************************************************************
-                                   Flags
-*****************************************************************************}
-
-    type
-      TResFlags = (F_NONE,F_LT,F_LTU,F_EQ,F_LT_UNC,F_LTU_UNC,F_EQ_UNC,
-              F_EQ_AND,F_EQ_OR,F_EQ_OR_ANDCM,F_NE_AND,F_NE_OR);
-
-Type
- TRegister = (R_NO,  { R_NO is Mandatory, signifies no register }
-              R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,
-              R_10,R_11,R_12,R_13,R_14,R_15,R_16,R_17,R_18,R_19,
-              R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,
-              R_30,R_31,
-              R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,
-              R_F10,R_F11,R_F12,R_F13,R_F14,R_F15,R_F16,R_F17,R_F18,R_F19,
-              R_F20,R_F21,R_F22,R_F23,R_F24,R_F25,R_F26,R_F27,R_F28,R_F29,
-              R_F30,R_F31);
-
-  TRegisterset = Set of TRegister;
-
-  { -1 indicates no qualifying prediction }
-  tqp = -1..63;
-
-const
-  qp_none : tqp = -1;
-
-{ Constants describing the registers }
-
-Const
-  intregs = [R_0..R_31];
-  fpuregs = [R_F0..R_F31];
-  mmregs = [];
-
-  maxvarregs = 128;
-  maxfpuvarregs = 128;
-
-  max_operands = 4;
-
-{*****************************************************************************
-                          Default generic sizes
-*****************************************************************************}
-
-      { Defines the default address size for a processor, }
-      OS_ADDR = OS_64;
-      { the natural int size for a processor,
-        has to match osuinttype/ossinttype as initialized in psystem }
-      OS_INT = OS_64;
-      OS_SINT = OS_S64;
-      { the maximum float size for a processor,           }
-      OS_FLOAT = OS_F80;
-      { the size of a vector register for a processor     }
-      OS_VECTOR = OS_M128;
-      
-{*****************************************************************************
-                       GCC /ABI linking information
-*****************************************************************************}
-
-  {# Registers which must be saved when calling a routine declared as
-     cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers
-     saved should be the ones as defined in the target ABI and / or GCC.
-
-     This value can be deduced from CALLED_USED_REGISTERS array in the
-     GCC source.
-  }
-  std_saved_registers = [R_9..R_14,R_F2..R_F9];
-  {# Required parameter alignment when calling a routine declared as
-     stdcall and cdecl. The alignment value should be the one defined
-     by GCC or the target ABI.
-
-     The value of this constant is equal to the constant
-     PARM_BOUNDARY / BITS_PER_UNIT in the GCC source.
-  }
-  std_param_align = 8;
-
-{*****************************************************************************
-                   Opcode propeties (needed for optimizer)
-*****************************************************************************}
-
-implementation
-
-end.

compiler/ia64/cpuinfo.pas

@@ -1,105 +0,0 @@
-{
-    Copyright (c) 1998-2006 by Florian Klaempfl
-
-    Basic Processor information
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-Unit cpuinfo;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
-  globtype;
-
-Type
-   bestreal = extended;
-{$if FPC_FULLVERSION>20700}
-   bestrealrec = TExtended80Rec;
-{$endif FPC_FULLVERSION>20700}
-   ts32real = single;
-   ts64real = double;
-   ts80real = extended;
-   ts128real = type extended;
-   ts64comp = type extended;
-
-   pbestreal=^bestreal;
-
-   { possible supported processors for this target }
-   tcputype =
-      (cpu_none,
-       cpu_itanium
-      );
-
-   tfputype =
-     (fpu_none,
-      fpu_itanium
-     );
-     
-   tcontrollertype =
-     (ct_none
-     );
-
-
-Const
-   { Is there support for dealing with multiple microcontrollers available }
-   { for this platform? }
-   ControllerSupport = false;
-
-   { We know that there are fields after sramsize
-     but we don't care about this warning }
-   {$PUSH}
-    {$WARN 3177 OFF}
-   embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
-   (
-      (controllertypestr:''; controllerunitstr:''; flashbase:0; flashsize:0; srambase:0; sramsize:0));
-   {$POP}
-
-   { calling conventions supported by the code generator }
-   supported_calling_conventions : tproccalloptions = [
-     pocall_internproc,
-     pocall_stdcall,
-     pocall_cdecl,
-     pocall_cppdecl
-   ];
-
-
-   cputypestr : array[tcputype] of string[10] = ('',
-     'ITANIUM'
-   );
-
-   fputypestr : array[tfputype] of string[6] = ('',
-     'ITANIUM'
-   );
-
-   { Supported optimizations, only used for information }
-   supported_optimizerswitches = [cs_opt_peephole,cs_opt_regvar,cs_opt_stackframe,
-								  cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain,
-								  cs_opt_nodecse];
-
-   level1optimizerswitches = [cs_opt_level1,cs_opt_peephole];
-   level2optimizerswitches = level1optimizerswitches + 
-     [cs_opt_level2,cs_opt_regvar,cs_opt_stackframe,cs_opt_asmcse,cs_opt_nodecse];
-   level3optimizerswitches = level2optimizerswitches + [cs_opt_level3{,cs_opt_loopunroll}];
-   level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [];
-
-Implementation
-
-end.
-

compiler/ia64/ia64reg.dat

@@ -1,268 +0,0 @@
-;
-; iA-64 registers
-; This file is generate with help of fpc/compiler/utils/gia64reg,
-; please try to use this generator before you do error prone and tedious
-; editing by hand
-;
-; layout
-; <name>,<type>,<value>,<stdname>,<gasname>
-;
-NO,$00,$00,INVALID,INVALID
-
-R0,$01,0,r0,r0
-R1,$01,1,r1,r1
-R2,$01,2,r2,r2
-R3,$01,3,r3,r3
-R4,$01,4,r4,r4
-R5,$01,5,r5,r5
-R6,$01,6,r6,r6
-R7,$01,7,r7,r7
-R8,$01,8,r8,r8
-R9,$01,9,r9,r9
-R10,$01,10,r10,r10
-R11,$01,11,r11,r11
-R12,$01,12,r12,r12
-R13,$01,13,r13,r13
-R14,$01,14,r14,r14
-R15,$01,15,r15,r15
-R16,$01,16,r16,r16
-R17,$01,17,r17,r17
-R18,$01,18,r18,r18
-R19,$01,19,r19,r19
-R20,$01,20,r20,r20
-R21,$01,21,r21,r21
-R22,$01,22,r22,r22
-R23,$01,23,r23,r23
-R24,$01,24,r24,r24
-R25,$01,25,r25,r25
-R26,$01,26,r26,r26
-R27,$01,27,r27,r27
-R28,$01,28,r28,r28
-R29,$01,29,r29,r29
-R30,$01,30,r30,r30
-R31,$01,31,r31,r31
-R32,$01,32,r32,r32
-R33,$01,33,r33,r33
-R34,$01,34,r34,r34
-R35,$01,35,r35,r35
-R36,$01,36,r36,r36
-R37,$01,37,r37,r37
-R38,$01,38,r38,r38
-R39,$01,39,r39,r39
-R40,$01,40,r40,r40
-R41,$01,41,r41,r41
-R42,$01,42,r42,r42
-R43,$01,43,r43,r43
-R44,$01,44,r44,r44
-R45,$01,45,r45,r45
-R46,$01,46,r46,r46
-R47,$01,47,r47,r47
-R48,$01,48,r48,r48
-R49,$01,49,r49,r49
-R50,$01,50,r50,r50
-R51,$01,51,r51,r51
-R52,$01,52,r52,r52
-R53,$01,53,r53,r53
-R54,$01,54,r54,r54
-R55,$01,55,r55,r55
-R56,$01,56,r56,r56
-R57,$01,57,r57,r57
-R58,$01,58,r58,r58
-R59,$01,59,r59,r59
-R60,$01,60,r60,r60
-R61,$01,61,r61,r61
-R62,$01,62,r62,r62
-R63,$01,63,r63,r63
-R64,$01,64,r64,r64
-R65,$01,65,r65,r65
-R66,$01,66,r66,r66
-R67,$01,67,r67,r67
-R68,$01,68,r68,r68
-R69,$01,69,r69,r69
-R70,$01,70,r70,r70
-R71,$01,71,r71,r71
-R72,$01,72,r72,r72
-R73,$01,73,r73,r73
-R74,$01,74,r74,r74
-R75,$01,75,r75,r75
-R76,$01,76,r76,r76
-R77,$01,77,r77,r77
-R78,$01,78,r78,r78
-R79,$01,79,r79,r79
-R80,$01,80,r80,r80
-R81,$01,81,r81,r81
-R82,$01,82,r82,r82
-R83,$01,83,r83,r83
-R84,$01,84,r84,r84
-R85,$01,85,r85,r85
-R86,$01,86,r86,r86
-R87,$01,87,r87,r87
-R88,$01,88,r88,r88
-R89,$01,89,r89,r89
-R90,$01,90,r90,r90
-R91,$01,91,r91,r91
-R92,$01,92,r92,r92
-R93,$01,93,r93,r93
-R94,$01,94,r94,r94
-R95,$01,95,r95,r95
-R96,$01,96,r96,r96
-R97,$01,97,r97,r97
-R98,$01,98,r98,r98
-R99,$01,99,r99,r99
-R100,$01,100,r100,r100
-R101,$01,101,r101,r101
-R102,$01,102,r102,r102
-R103,$01,103,r103,r103
-R104,$01,104,r104,r104
-R105,$01,105,r105,r105
-R106,$01,106,r106,r106
-R107,$01,107,r107,r107
-R108,$01,108,r108,r108
-R109,$01,109,r109,r109
-R110,$01,110,r110,r110
-R111,$01,111,r111,r111
-R112,$01,112,r112,r112
-R113,$01,113,r113,r113
-R114,$01,114,r114,r114
-R115,$01,115,r115,r115
-R116,$01,116,r116,r116
-R117,$01,117,r117,r117
-R118,$01,118,r118,r118
-R119,$01,119,r119,r119
-R120,$01,120,r120,r120
-R121,$01,121,r121,r121
-R122,$01,122,r122,r122
-R123,$01,123,r123,r123
-R124,$01,124,r124,r124
-R125,$01,125,r125,r125
-R126,$01,126,r126,r126
-R127,$01,127,r127,r127
-
-F0,$02,0,r0,r0
-F1,$02,1,r1,r1
-F2,$02,2,r2,r2
-F3,$02,3,r3,r3
-F4,$02,4,r4,r4
-F5,$02,5,r5,r5
-F6,$02,6,r6,r6
-F7,$02,7,r7,r7
-F8,$02,8,r8,r8
-F9,$02,9,r9,r9
-F10,$02,10,r10,r10
-F11,$02,11,r11,r11
-F12,$02,12,r12,r12
-F13,$02,13,r13,r13
-F14,$02,14,r14,r14
-F15,$02,15,r15,r15
-F16,$02,16,r16,r16
-F17,$02,17,r17,r17
-F18,$02,18,r18,r18
-F19,$02,19,r19,r19
-F20,$02,20,r20,r20
-F21,$02,21,r21,r21
-F22,$02,22,r22,r22
-F23,$02,23,r23,r23
-F24,$02,24,r24,r24
-F25,$02,25,r25,r25
-F26,$02,26,r26,r26
-F27,$02,27,r27,r27
-F28,$02,28,r28,r28
-F29,$02,29,r29,r29
-F30,$02,30,r30,r30
-F31,$02,31,r31,r31
-F32,$02,32,r32,r32
-F33,$02,33,r33,r33
-F34,$02,34,r34,r34
-F35,$02,35,r35,r35
-F36,$02,36,r36,r36
-F37,$02,37,r37,r37
-F38,$02,38,r38,r38
-F39,$02,39,r39,r39
-F40,$02,40,r40,r40
-F41,$02,41,r41,r41
-F42,$02,42,r42,r42
-F43,$02,43,r43,r43
-F44,$02,44,r44,r44
-F45,$02,45,r45,r45
-F46,$02,46,r46,r46
-F47,$02,47,r47,r47
-F48,$02,48,r48,r48
-F49,$02,49,r49,r49
-F50,$02,50,r50,r50
-F51,$02,51,r51,r51
-F52,$02,52,r52,r52
-F53,$02,53,r53,r53
-F54,$02,54,r54,r54
-F55,$02,55,r55,r55
-F56,$02,56,r56,r56
-F57,$02,57,r57,r57
-F58,$02,58,r58,r58
-F59,$02,59,r59,r59
-F60,$02,60,r60,r60
-F61,$02,61,r61,r61
-F62,$02,62,r62,r62
-F63,$02,63,r63,r63
-F64,$02,64,r64,r64
-F65,$02,65,r65,r65
-F66,$02,66,r66,r66
-F67,$02,67,r67,r67
-F68,$02,68,r68,r68
-F69,$02,69,r69,r69
-F70,$02,70,r70,r70
-F71,$02,71,r71,r71
-F72,$02,72,r72,r72
-F73,$02,73,r73,r73
-F74,$02,74,r74,r74
-F75,$02,75,r75,r75
-F76,$02,76,r76,r76
-F77,$02,77,r77,r77
-F78,$02,78,r78,r78
-F79,$02,79,r79,r79
-F80,$02,80,r80,r80
-F81,$02,81,r81,r81
-F82,$02,82,r82,r82
-F83,$02,83,r83,r83
-F84,$02,84,r84,r84
-F85,$02,85,r85,r85
-F86,$02,86,r86,r86
-F87,$02,87,r87,r87
-F88,$02,88,r88,r88
-F89,$02,89,r89,r89
-F90,$02,90,r90,r90
-F91,$02,91,r91,r91
-F92,$02,92,r92,r92
-F93,$02,93,r93,r93
-F94,$02,94,r94,r94
-F95,$02,95,r95,r95
-F96,$02,96,r96,r96
-F97,$02,97,r97,r97
-F98,$02,98,r98,r98
-F99,$02,99,r99,r99
-F100,$02,100,r100,r100
-F101,$02,101,r101,r101
-F102,$02,102,r102,r102
-F103,$02,103,r103,r103
-F104,$02,104,r104,r104
-F105,$02,105,r105,r105
-F106,$02,106,r106,r106
-F107,$02,107,r107,r107
-F108,$02,108,r108,r108
-F109,$02,109,r109,r109
-F110,$02,110,r110,r110
-F111,$02,111,r111,r111
-F112,$02,112,r112,r112
-F113,$02,113,r113,r113
-F114,$02,114,r114,r114
-F115,$02,115,r115,r115
-F116,$02,116,r116,r116
-F117,$02,117,r117,r117
-F118,$02,118,r118,r118
-F119,$02,119,r119,r119
-F120,$02,120,r120,r120
-F121,$02,121,r121,r121
-F122,$02,122,r122,r122
-F123,$02,123,r123,r123
-F124,$02,124,r124,r124
-F125,$02,125,r125,r125
-F126,$02,126,r126,r126
-F127,$02,127,r127,r127

compiler/ia64/symcpu.pas

@@ -1,211 +0,0 @@
-{
-    Copyright (c) 2014 by Florian Klaempfl
-
-    Symbol table overrides for IA64
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit symcpu;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  symtype,symdef,symsym;
-
-type
-  { defs }
-  tcpufiledef = class(tfiledef)
-  end;
-  tcpufiledefclass = class of tcpufiledef;
-
-  tcpuvariantdef = class(tvariantdef)
-  end;
-  tcpuvariantdefclass = class of tcpuvariantdef;
-
-  tcpuformaldef = class(tformaldef)
-  end;
-  tcpuformaldefclass = class of tcpuformaldef;
-
-  tcpuforwarddef = class(tforwarddef)
-  end;
-  tcpuforwarddefclass = class of tcpuforwarddef;
-
-  tcpuundefineddef = class(tundefineddef)
-  end;
-  tcpuundefineddefclass = class of tcpuundefineddef;
-
-  tcpuerrordef = class(terrordef)
-  end;
-  tcpuerrordefclass = class of tcpuerrordef;
-
-  tcpupointerdef = class(tpointerdef)
-  end;
-  tcpupointerdefclass = class of tcpupointerdef;
-
-  tcpurecorddef = class(trecorddef)
-  end;
-  tcpurecorddefclass = class of tcpurecorddef;
-
-  tcpuimplementedinterface = class(timplementedinterface)
-  end;
-  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
-
-  tcpuobjectdef = class(tobjectdef)
-  end;
-  tcpuobjectdefclass = class of tcpuobjectdef;
-
-  tcpuclassrefdef = class(tclassrefdef)
-  end;
-  tcpuclassrefdefclass = class of tcpuclassrefdef;
-
-  tcpuarraydef = class(tarraydef)
-  end;
-  tcpuarraydefclass = class of tcpuarraydef;
-
-  tcpuorddef = class(torddef)
-  end;
-  tcpuorddefclass = class of tcpuorddef;
-
-  tcpufloatdef = class(tfloatdef)
-  end;
-  tcpufloatdefclass = class of tcpufloatdef;
-
-  tcpuprocvardef = class(tprocvardef)
-  end;
-  tcpuprocvardefclass = class of tcpuprocvardef;
-
-  tcpuprocdef = class(tprocdef)
-  end;
-  tcpuprocdefclass = class of tcpuprocdef;
-
-  tcpustringdef = class(tstringdef)
-  end;
-  tcpustringdefclass = class of tcpustringdef;
-
-  tcpuenumdef = class(tenumdef)
-  end;
-  tcpuenumdefclass = class of tcpuenumdef;
-
-  tcpusetdef = class(tsetdef)
-  end;
-  tcpusetdefclass = class of tcpusetdef;
-
-  { syms }
-  tcpulabelsym = class(tlabelsym)
-  end;
-  tcpulabelsymclass = class of tcpulabelsym;
-
-  tcpuunitsym = class(tunitsym)
-  end;
-  tcpuunitsymclass = class of tcpuunitsym;
-
-  tcpunamespacesym = class(tnamespacesym)
-  end;
-  tcpunamespacesymclass = class of tcpunamespacesym;
-
-  tcpuprocsym = class(tprocsym)
-  end;
-  tcpuprocsymclass = class of tcpuprocsym;
-
-  tcputypesym = class(ttypesym)
-  end;
-  tcpuypesymclass = class of tcputypesym;
-
-  tcpufieldvarsym = class(tfieldvarsym)
-  end;
-  tcpufieldvarsymclass = class of tcpufieldvarsym;
-
-  tcpulocalvarsym = class(tlocalvarsym)
-  end;
-  tcpulocalvarsymclass = class of tcpulocalvarsym;
-
-  tcpuparavarsym = class(tparavarsym)
-  end;
-  tcpuparavarsymclass = class of tcpuparavarsym;
-
-  tcpustaticvarsym = class(tstaticvarsym)
-  end;
-  tcpustaticvarsymclass = class of tcpustaticvarsym;
-
-  tcpuabsolutevarsym = class(tabsolutevarsym)
-  end;
-  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
-
-  tcpupropertysym = class(tpropertysym)
-  end;
-  tcpupropertysymclass = class of tcpupropertysym;
-
-  tcpuconstsym = class(tconstsym)
-  end;
-  tcpuconstsymclass = class of tcpuconstsym;
-
-  tcpuenumsym = class(tenumsym)
-  end;
-  tcpuenumsymclass = class of tcpuenumsym;
-
-  tcpusyssym = class(tsyssym)
-  end;
-  tcpusyssymclass = class of tcpusyssym;
-
-
-const
-  pbestrealtype : ^tdef = @s64floattype;
-
-
-implementation
-
-begin
-  { used tdef classes }
-  cfiledef:=tcpufiledef;
-  cvariantdef:=tcpuvariantdef;
-  cformaldef:=tcpuformaldef;
-  cforwarddef:=tcpuforwarddef;
-  cundefineddef:=tcpuundefineddef;
-  cerrordef:=tcpuerrordef;
-  cpointerdef:=tcpupointerdef;
-  crecorddef:=tcpurecorddef;
-  cimplementedinterface:=tcpuimplementedinterface;
-  cobjectdef:=tcpuobjectdef;
-  cclassrefdef:=tcpuclassrefdef;
-  carraydef:=tcpuarraydef;
-  corddef:=tcpuorddef;
-  cfloatdef:=tcpufloatdef;
-  cprocvardef:=tcpuprocvardef;
-  cprocdef:=tcpuprocdef;
-  cstringdef:=tcpustringdef;
-  cenumdef:=tcpuenumdef;
-  csetdef:=tcpusetdef;
-
-  { used tsym classes }
-  clabelsym:=tcpulabelsym;
-  cunitsym:=tcpuunitsym;
-  cnamespacesym:=tcpunamespacesym;
-  cprocsym:=tcpuprocsym;
-  ctypesym:=tcputypesym;
-  cfieldvarsym:=tcpufieldvarsym;
-  clocalvarsym:=tcpulocalvarsym;
-  cparavarsym:=tcpuparavarsym;
-  cstaticvarsym:=tcpustaticvarsym;
-  cabsolutevarsym:=tcpuabsolutevarsym;
-  cpropertysym:=tcpupropertysym;
-  cconstsym:=tcpuconstsym;
-  cenumsym:=tcpuenumsym;
-  csyssym:=tcpusyssym;
-end.
-

compiler/jvm/cpupara.pas

@@ -160,7 +160,7 @@ implementation
         else if jvmimplicitpointertype(result.def) then
           begin
             retcgsize:=OS_ADDR;
-            result.def:=getpointerdef(result.def);
+            result.def:=cpointerdef.getreusable(result.def);
           end
         else
           begin
@@ -237,7 +237,7 @@ implementation
             else if jvmimplicitpointertype(hp.vardef) then
               begin
                 paracgsize:=OS_ADDR;
-                paradef:=getpointerdef(hp.vardef);
+                paradef:=cpointerdef.getreusable(hp.vardef);
               end
             else
               begin

compiler/jvm/hlcgcpu.pas

@@ -2401,6 +2401,7 @@ implementation
         begin
           sym:=tsym(obj.symtable.symlist[i]);
           if (sym.typ=fieldvarsym) and
+             not(sp_static in sym.symoptions) and
              (jvmimplicitpointertype(tfieldvarsym(sym).vardef) or
               ((tfieldvarsym(sym).vardef.typ=enumdef) and
                get_enum_init_val_ref(tfieldvarsym(sym).vardef,ref))) then

compiler/jvm/njvmadd.pas

@@ -324,7 +324,7 @@ interface
           evaluation }
         if not is_boolean(resultdef) then
           begin
-            inserttypeconv_explicit(result,getpointerdef(resultdef));
+            inserttypeconv_explicit(result,cpointerdef.getreusable(resultdef));
             result:=cderefnode.create(result);
           end;
         { left and right are reused as parameters }

compiler/jvm/njvmcal.pas

@@ -50,6 +50,7 @@ interface
          procedure extra_post_call_code; override;
          function dispatch_procvar: tnode;
          procedure remove_hidden_paras;
+         procedure gen_vmt_entry_load; override;
         public
          function pass_typecheck: tnode; override;
          function pass_1: tnode; override;
@@ -170,6 +171,9 @@ implementation
         implicitptrpara,
         verifyout: boolean;
       begin
+        { the original version doesn't do anything for garbage collected
+          platforms, but who knows in the future }
+        inherited;
         { implicit pointer types are already pointers -> no need to stuff them
           in an array to pass them by reference (except in case of a formal
           parameter, in which case everything is passed in an array since the
@@ -224,10 +228,10 @@ implementation
         if parasym.vardef.typ=formaldef then
           arreledef:=java_jlobject
         else if implicitptrpara then
-          arreledef:=getpointerdef(orgparadef)
+          arreledef:=cpointerdef.getreusable(orgparadef)
         else
           arreledef:=parasym.vardef;
-        arrdef:=getarraydef(arreledef,1+ord(cs_check_var_copyout in current_settings.localswitches));
+        arrdef:=carraydef.getreusable(arreledef,1+ord(cs_check_var_copyout in current_settings.localswitches));
         { the -1 means "use the array's element count to determine the number
           of elements" in the JVM temp generator }
         arraytemp:=ctempcreatenode.create(arrdef,-1,tt_persistent,true);
@@ -308,7 +312,7 @@ implementation
                   tempn:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
                     ctypenode.create(orgparadef),ccallparanode.create(tempn,nil)))
                 else if implicitptrpara then
-                  tempn:=ctypeconvnode.create_explicit(tempn,getpointerdef(orgparadef))
+                  tempn:=ctypeconvnode.create_explicit(tempn,cpointerdef.getreusable(orgparadef))
               end;
             if implicitptrpara then
               tempn:=cderefnode.create(tempn)
@@ -492,6 +496,12 @@ implementation
     end;
 
 
+  procedure tjvmcallnode.gen_vmt_entry_load;
+    begin
+      { nothing to do }
+    end;
+
+
   function tjvmcallnode.pass_typecheck: tnode;
     begin
       result:=inherited pass_typecheck;

compiler/jvm/njvmcnv.pas

@@ -368,7 +368,7 @@ implementation
                       genintconstnode(tsetdef(left.resultdef).setbase),
                         ccallparanode.create(left,nil))));
               end;
-            inserttypeconv_explicit(result,getpointerdef(resultdef));
+            inserttypeconv_explicit(result,cpointerdef.getreusable(resultdef));
             result:=cderefnode.create(result);
             { reused }
             left:=nil;
@@ -387,7 +387,7 @@ implementation
         result:=ccallnode.createinternmethod(
           cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',nil);
         { method pointer is an implicit pointer type }
-        result:=ctypeconvnode.create_explicit(result,getpointerdef(resultdef));
+        result:=ctypeconvnode.create_explicit(result,cpointerdef.getreusable(resultdef));
         result:=cderefnode.create(result);
       end;
 
@@ -494,7 +494,7 @@ implementation
           result:=ctypeconvnode.create_explicit(result,resultdef)
         else
           begin
-            result:=ctypeconvnode.create_explicit(result,getpointerdef(resultdef));
+            result:=ctypeconvnode.create_explicit(result,cpointerdef.getreusable(resultdef));
             result:=cderefnode.create(result)
           end;
         { reused }
@@ -1263,7 +1263,7 @@ implementation
                   a proper checkcast is inserted }
                 if not check_only then
                   begin
-                    resnode:=ctypeconvnode.create_explicit(left,getpointerdef(resultdef));
+                    resnode:=ctypeconvnode.create_explicit(left,cpointerdef.getreusable(resultdef));
                     resnode:=cderefnode.create(resnode);
                     left:=nil;
                   end;
@@ -1385,7 +1385,7 @@ implementation
                   begin
                     resnode:=to_set_explicit_typecast;
                     { convert to desired result }
-                    inserttypeconv_explicit(resnode,getpointerdef(resultdef));
+                    inserttypeconv_explicit(resnode,cpointerdef.getreusable(resultdef));
                     resnode:=cderefnode.create(resnode);
                   end;
                 result:=true;